merge changes made accidentally to wrong copy

diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl
index 9a5b1d253c91a0d43093551ad4889df95b30f02c..f2055f44aca83b55c64aefafd1906aa493e90e5a 100755 (executable)
--- a/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -15,41 +15,30 @@ proc manyset {list args} {
     }
 }
 
-set foolist {
-    7 11 1 M
-    13 17 0 a
-    19 23 0 n
-}
-set unk_l 25
-set unk_r 29
-set unk_context 0
-
-
-
 set mul 6
 set inter 1
 set rhsmost_max -1
 
-set f [open text.xpm]
-set o {}
-set y -3
-while 1 {
-    if {[gets $f l] < 0} { error "huh? "}
-    if {![regexp {^"(.*)",$} $l dummy l]} {
-       append o "$l\n"
-       if {[regexp {^\}\;$} $l]} break
-       continue
-    }
-    if {$y==-3} {
-       manyset $l cols rows colours cpp
-       #assert {$colours==2}
-       #assert {$cpp==1}
-       set mulcols [expr {$cols*$mul+$inter}]
-       set mulrows [expr {$rows*$mul+$inter}]
-       append o "\"$mulcols $mulrows 9 1\",\n"
-       for {set x 0} {$x<$cols} {incr x} { set wordmap($x) 0 }
-    } elseif {$y==-2} { # first pixel
-       append o \
+proc read_xpm {f} {
+    set o {}
+    set y -3
+    while 1 {
+       if {[gets $f l] < 0} { error "huh? "}
+       if {![regexp {^"(.*)",$} $l dummy l]} {
+           append o "$l\n"
+           if {[regexp {^\}\;$} $l]} break
+           continue
+       }
+       if {$y==-3} {
+           manyset $l cols rows colours cpp
+           #assert {$colours==2}
+           #assert {$cpp==1}
+           set mulcols [expr {$cols*$mul+$inter}]
+           set mulrows [expr {$rows*$mul+$inter}]
+           append o "\"$mulcols $mulrows 9 1\",\n"
+           for {set x 0} {$x<$cols} {incr x} { set wordmap($x) 0 }
+       } elseif {$y==-2} { # first pixel
+           append o \
 "\"+ c #111\",
 \"a c #800\",
 \"A c #fcc\",
@@ -59,61 +48,63 @@ while 1 {
 \"U c #ff0\",
 \"q c #000\",
 \"Q c #ff0\",\n"
-    } elseif {$y==-1} { # 2nd pixel but we've already printed ours
-    } else {
-       set ybit [expr {1<<$y}]
-       set x 0
-        set ol "\"+"
-        set olh $ol
-       foreach c [split $l ""] {
-           set how "u"
-           if {$x >= $unk_l && $x <= $unk_r} {
-               set how q
-           } else {
-               set ab 0
-               foreach {min max context got} $foolist {
-                   set rhsmost_max $max
-                   if {$x >= $min && $x <= $max} {
-                       set how [lindex {a b} $ab]
-                       break
+       } elseif {$y==-1} { # 2nd pixel but we've already printed ours
+       } else {
+           set ybit [expr {1<<$y}]
+           set x 0
+           set ol "\"+"
+           set olh $ol
+           foreach c [split $l ""] {
+               set how "u"
+               if {$x >= $unk_l && $x <= $unk_r} {
+                   set how q
+               } else {
+                   set ab 0
+                   foreach {min max context got} $foolist {
+                       set rhsmost_max $max
+                       if {$x >= $min && $x <= $max} {
+                           set how [lindex {a b} $ab]
+                           break
+                       }
+                       set ab [expr {!$ab}]
                    }
-                   set ab [expr {!$ab}]
                }
-           }
-           switch -exact $c {
-               " " { set p $how }
-               "o" {
-                   set p [string toupper $how]
-                   incr wordmap($x) $ybit
+               switch -exact $c {
+                   " " { set p $how }
+                   "o" {
+                       set p [string toupper $how]
+                       incr wordmap($x) $ybit
+                   }
+                   default { error "$c ?" }
                }
-               default { error "$c ?" }
-           }
-           append ol "[string repeat $p [expr {$mul-$inter}]][
+               append ol "[string repeat $p [expr {$mul-$inter}]][
                          string repeat + $inter]"
-           append olh [string repeat + $mul]
-           incr x
+               append olh [string repeat + $mul]
+               incr x
+           }
+           set ole "\",\n"
+           append ol $ole
+           append olh $ole
+           set olhn [string repeat $olh $inter]
+           if {!$y} { append o $olhn }
+           append o [string repeat $ol [expr {$mul-1}]]
+           append o $olhn
        }
-        set ole "\",\n"
-       append ol $ole
-       append olh $ole
-       set olhn [string repeat $olh $inter]
-        if {!$y} { append o $olhn }
-        append o [string repeat $ol [expr {$mul-1}]]
-       append o $olhn
+       incr y
     }
-    incr y
+    set data [exec xpmtoppm << $o]
+    image create photo main_image -data $xpm
 }
 
 #puts $o
 
-set xpm [exec xpmtoppm << $o]
-
 set gotsh 20
 set csrh 20
 
 frame .d -width $mulcols -height [expr {$csrh+$mulrows+$gotsh}]
 
-set mi [image create photo -data $xpm]
+set mi main_image
+image create bitmap main_image
 label .d.mi -image $mi -borderwidth 0
 
 frame .d.csr -bg black -width $mulcols -height $csrh
@@ -367,5 +358,22 @@ proc RETURN_RESULT {how what} {
 
 #    bind . <Key-space> {}
 
-read_database
-recursor
+proc test_main {} {
+    global foolist
+    
+    set foolist {
+       7 11 1 M
+       13 17 0 a
+       19 23 0 n
+    }
+    set unk_l 25
+    set unk_r 29
+    set unk_context 0
+
+    set f [open text.xpm]
+    read_xpm $f
+    close $f
+
+    read_database
+    recursor
+}