MG Sep 3rd 2005 - This is a small script which encodes strings as PNG images. (It uses PNG because GIF and JPEG both garbled the string when it was decoded, I guess b/c of lack of colors or something.) It's very barely tested, on Tcl/Tk 8.4.9 with Img 1.3. It's very simple to use:
strToPic $text
will encode the text, and save it as a PNG image (you'll be prompted to give a file name). Then you can use
picToStr ?$file?
to decode a file (if no
file is given, you'll be prompted to give one). This decodes the contents of the file, and prints the string it represents to stdout.
It works by simply converting each character to a numerical value, with
scan $char %c
and using that as a color value (where three characters make up a pixel; the first is the red value, the second the green, the third the blue). If there aren't enough characters, it will pad the end of the string with randomly generated ones until there are (and will strip them off again automatically when you decode). This means that if you use any character outside the range of 0-255, the script will break. Not exactly graceful. If someone has a good way to change/fix that, feel free to do so :) -
RS: By converting the text to explicit utf-8, you are guaranteed to have all bytes in 0..255.
The images created are always square - again, if it lacks the number of characters for that, it will pad the string until there are enough.
Here's an example of the output - this image is the first two paragraphs of
Harry Potter and the Half-Blood Prince, as that happened to the be first "real" text file I could find for testing.
And here's the code to produce it (and decode it back):
package require Img
proc randChar {} {
return [format %c [expr {int(rand()*77)+45}]];
};# randChar
proc charToColComp {char} {
return [expr {255*[scan $char %c]}];
};# charToColComp
proc strToPic {string} {
set len [string length $string]
set string "${len}:$string"
while { [expr {[string length $string] % 3}] != "0" } {
append string [randChar]
}
while { [expr {floor(sqrt(([string length $string]/3)))}] != [expr {ceil(sqrt(([string length $string]/3)))}] } {
append string [randChar][randChar][randChar]
}
set len [string length $string]
set pixels [expr {$len/3}]
set size [expr {int(sqrt($pixels))}]
set image [image create photo -width $size -height $size]
set x 0
set y 0
foreach {r g b} [split $string ""] {
set col [format "#%04x%04x%04x" [charToColComp $r] [charToColComp $g] [charToColComp $b]]
$image put $col -to $x $y
incr x
if { $x == $size } {
set x 0
incr y
}
}
set path [tk_getSaveFile -filetypes {{{PNG Files} {*.png}} {{All Files} {*.*}}} -defaultextension .png]
if { $path != "" } {
$image write $path -format png
tk_messageBox -message "Image created."
}
image delete $image
};# strToPic
proc picToStr {{pic ""}} {
if { $pic == "" } {
set pic [tk_getOpenFile -filetypes {{{PNG Files} {*.png}} {{All Files} {*.*}}}]
if { $pic == "" } {return}
}
set string ""
set image [image create photo -file $pic]
for {set y 0} "\$y < [image height $image]" {incr y} {
for {set x 0} "\$x < [image width $image]" {incr x} {
scan [$image get $x $y] "%d %d %d" r g b
set r [format %c [incr r]]
set g [format %c [incr g]]
set b [format %c [incr b]]
append string "$r$g$b"
}
}
image delete $image
set colon [string first : $string]
set size [string range $string 0 [incr colon -1]]
set string [string range $string [incr colon 2] end]
set string [string range $string 0 [incr size -1]]
puts "\n\nDone! Image file [file tail $pic] says:"
puts $string
};# picToStr
catch {console show} ;# for us poor Windows users
picToStr
See also edit