From 1971b4961a061d32a86a5e08a64f1b960f666802 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Wed, 3 Jun 2009 23:39:55 +0100
Subject: [PATCH] wip show-thing rework

---
 pctb/stuff/show-thing.tcl | 150 ++++++++++++++++++++------------------
 1 file changed, 79 insertions(+), 71 deletions(-)

diff --git a/pctb/stuff/show-thing.tcl b/pctb/stuff/show-thing.tcl
index 4537e6a..c1e8cb9 100755
--- a/pctb/stuff/show-thing.tcl
+++ b/pctb/stuff/show-thing.tcl
@@ -7,39 +7,28 @@ 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 {[gets $f l] >= 0} {
-    if {![regexp {^"(.*)",$} $l dummy l]} {
-	append o "$l\n"
-	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 {[gets $f l] >= 0} {
+	if {![regexp {^"(.*)",$} $l dummy l]} {
+	    append o "$l\n"
+	    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\",
@@ -49,61 +38,63 @@ while {[gets $f l] >= 0} {
 \"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
@@ -354,5 +345,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
+}
-- 
2.30.2