strimj to XBM

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