Richard Suchenwirth 2006-01-24 - In strimj - string image routines there was a converter from "string image" (intuitive ASCII graphics) to XBM format, which then can be used to create a Tk bitmap. As I needed it, but didn't want to create a package requirement, here it is rewritten to be standalone, together with a wrapper for image creation, and a little demo:
package req Tk proc strimj2xbm strimj { set width [string length [lindex $strimj 0]] set height [llength $strimj] set bytes {} foreach line [string map {. 0} $strimj] { regsub -all {[^0]} $line 1 line ;# black pixel foreach bin [split [binary format b* $line] ""] { lappend bytes [scan $bin %c] } } set res "#define i_width $width\n#define i_height $height\n" append res "static char i_bits\[\] = {\n[join $bytes ,]\n}" } proc strimj2image {strimj {fg black}} { image create bitmap -data [strimj2xbm $strimj] -foreground $fg }
#-- Just for the fun of it, here's also the inverse operation:
proc xbm2strimj xbm { regexp {width +(\d+).+\{(.+)\}} $xbm -> width data set res "" set line "" foreach byte [string map {, " "} $data] { if {[string length $line] > $width-7} { append res [string range $line 0 [expr {$width-1}]]\n set line "" } binary scan [format %c $byte] b* bits append line $bits } if {$line ne ""} { append res [string range $line 0 [expr {$width-1}]]\n } string map {0 . 1 @} $res }
#-- .. and a tiny alternative to make photo images (with another use case for K):
proc strimj2photo {strimj {fg #000000} {bg #FFFFFF}} { set data {} foreach line $strimj { lappend data [lrange [string map [list @ "$fg " . "$bg "] $line] 0 end] } K [set im [image create photo]] [$im put $data -to 0 0] } proc K {a b} {set a}
#--------------------------- Usage demo, and test:
set test { @@...... @@@@.... @@@@@@.. @@@@@@@@ @@@@@@.. @@@@.... @@...... } set pause { @@@..@@@ @@@..@@@ @@@..@@@ @@@..@@@ @@@..@@@ @@@..@@@ @@@..@@@ } pack [button .1 -image [strimj2image $test red]] \ [button .2 -image [strimj2photo $pause]] -padx 5 -pady 5 -side left
See Arts and crafts of Tcl-Tk programming