wip fixes to show-thing for reorg

[ypp-sc-tools.db-test.git] / pctb / show-thing.tcl

diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl
index f2055f44aca83b55c64aefafd1906aa493e90e5a..19912cbb47aab980855ea38e441fb577ddd27e5b 100755 (executable)
--- a/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -17,9 +17,14 @@ proc manyset {list args} {
 
 set mul 6
 set inter 1
-set rhsmost_max -1
+
+set gotsh 20
+set csrh 20
 
 proc read_xpm {f} {
+    global foolist mul inter rhsmost_max unk_l unk_r gotsh csrh
+    global cols rows wordmap
+    
     set o {}
     set y -3
     while 1 {
@@ -93,28 +98,38 @@ proc read_xpm {f} {
        incr y
     }
     set data [exec xpmtoppm << $o]
-    image create photo main_image -data $xpm
+    image create photo main_image -data $data
+    
+    foreach w {.d .d.csr .d.got} {
+       $w configure -width $mulcols
+    }
+    .d configure -height [expr {$csrh+$mulrows+$gotsh}]
+    foreach w {0 1} {
+       .d.csr_$w configure -height $mulrows
+    }
+    place .d.got -x 0 -y [expr {$csrh+$mulrows}]
 }
 
 #puts $o
 
-set gotsh 20
-set csrh 20
-
-frame .d -width $mulcols -height [expr {$csrh+$mulrows+$gotsh}]
+frame .d
 
 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
-frame .d.got -bg black -width $mulcols -height $gotsh
-
-foreach {min max context got} $foolist {
-    frame .d.got.m$min -bd 0 -background \#888
-    label .d.got.m$min.l -text "$got" -fg white -bg black -bd 0
-    pack .d.got.m$min.l -padx 1 -pady 1
-    place .d.got.m$min -x [expr {$min*$mul+$inter}] -y 0
+frame .d.csr -bg black -height $csrh
+frame .d.got -bg black -height $gotsh
+
+proc draw_foolist {} {
+    global foolist mul inter
+    eval destroy [winfo children .d.got]
+    foreach {min max context got} $foolist {
+       frame .d.got.m$min -bd 0 -background \#888
+       label .d.got.m$min.l -text "$got" -fg white -bg black -bd 0
+       pack .d.got.m$min.l -padx 1 -pady 1
+       place .d.got.m$min -x [expr {$min*$mul+$inter}] -y 0
+    }
 }
 
 set imcsr [image create bitmap -data \
@@ -130,23 +145,27 @@ label .d.csr.csr.l -image $imcsr -compound left
 entry .d.csr.csr.e -bd 0
 pack .d.csr.csr.l -side left
 
-frame .d.csr_0 -bg white -height $mulrows -width 1
-frame .d.csr_1 -bg white -height $mulrows -width 1
+frame .d.csr_0 -bg white -width 1
+frame .d.csr_1 -bg white -width 1
 
 place .d.csr -x 0 -y 0
 place .d.mi -x 0 -y $csrh
-place .d.got -x 0 -y [expr {$csrh+$mulrows}]
 pack .d
 
 frame .help
 pack .help
 
-set cur_already [expr {[llength $foolist]/4-1}]
-set cur_mode 1 ;# one of:   0 1 already text
+proc startup_cursor {} {
+    global cur_already cur_mode cur_0 cur_1 last_ht
+    global foolist unk_l unk_r
+    
+    set cur_already [expr {[llength $foolist]/4-1}]
+    set cur_mode 1 ;# one of:   0 1 already text
 
-set cur_0 $unk_l
-set cur_1 [expr {$unk_r+1}]
-set last_ht {}
+    set cur_0 $unk_l
+    set cur_1 [expr {$unk_r+1}]
+    set last_ht {}
+}
 
 proc helptext {t} {
     global last_ht
@@ -359,7 +378,7 @@ proc RETURN_RESULT {how what} {
 #    bind . <Key-space> {}
 
 proc test_main {} {
-    global foolist
+    global foolist unk_l unk_r unk_context
     
     set foolist {
        7 11 1 M
@@ -374,6 +393,11 @@ proc test_main {} {
     read_xpm $f
     close $f
 
+    draw_foolist
+    startup_cursor
+    
     read_database
     recursor
 }
+
+test_main