XPM to photo image

Richard Suchenwirth 2001-11-12 - XPM (X Pixmap) is a text file format in X11 to specify color images like icons with one or more characters per pixel, which are resolved in a color map at beginning of file. Here's some old code of mine which scans an XPM file into a photo image - might need some tuning before it joins the strimj - string image routines family, but as it was requested on c.l.t., here you go...

 proc image:fromXpm {fn} {
    set f [open $fn r]
    set stage 0; # 0:dimensions 1:colors 2:data
    set ncol 0; set y 0
    set bg white ;# or whatever
    while {![eof $f]} {
        gets $f line
        if {[regexp {\"([^\"]+)\"} $line -> cont]} {
            switch $stage {
                0 {
                    foreach {w h ncols nbytes} $cont break
                    set im [image create photo]
                    $im put #FFF -to 0 0 $w $h
                    $im configure -width $w -height $h ;# store read width & height, [MSW]
                    incr stage; continue
                } 1 {
                    set c [string range $cont 0 [expr $nbytes-1]]
                    regexp "\[ \t\]c (.+)" $cont -> col
                    if {[regexp {[Nn]one} $col]} {set col $bg}
                    if [catch {winfo rgb . $col}] {
                        set col [lindex $col 0]
                    set color($c) $col
                    incr ncol
                    if {$ncol>=$ncols} {incr stage}
                } 2 {
                    set t {}
                    foreach i [string:split $cont $nbytes] {
                        lappend t $color($i)
                    catch {
                        $im put [list $t] -to 0 $y [expr $w] [expr $y+1]
                    incr y
    close $f
    return $im

The following should rather be called "string:stride"... it breaks a string into substrings of length n

 proc string:split {s n} {
    if {$n==1} {
        return [split $s ""]
    } elseif {$n==2} {
        set t {}
        foreach {i j} [split $s ""] {lappend t $i$j}
        return $t
    } else {error "string:split -- bad splitter $n (must be 1 or 2)"}

See Also: Tk_Xpm, XPM.