--- /dev/null
+#!/usr/bin/wish
+
+proc widgets {} {
+ global image
+ set image [image create photo]
+ button .foo -image image1
+ pack .foo
+}
+
+# id chars:
+# .. unspecified (is error by us)
+# 0. background
+# u uknown/unbuilt
+# f/F forward > caps means
+# r/R reverse > train detected
+# z no power
+# x moveable not in this configuration
+
+set constants {
+ u 0 75 75 75
+ 0. 0 100 100 100
+ z 0 300 300 300
+ x 100 0 0 0
+ f 600 0 0 0
+ r -600 0 0 0
+ F 330 1000 1000 1000
+ R -330 1000 1000 1000
+ .. 0 999 999 999
+ u0
+}
+
+for {set i 0x20} {$i <= 0x3f} {incr i} {
+ lappend constants [format u0.0x%02x $i]
+}
+
+proc update_image {} {
+ global image settings_o constants
+ set l [concat ui-plan-bot.ppm \
+ $constants [array names settings_o] >tmp.ui.ppm]
+#puts stderr $l
+ eval exec ./subseg2display $l
+ $image read tmp.ui.ppm -format ppm
+}
+
+proc setsegbynum {num idchar} {
+ # $settings($num) = ${idchar}${num}
+ # $settings_o(${idchar}{$num}) = 1
+#puts stderr "setsegbynum $num $idchar"
+ global settings settings_o
+ if {[info exists settings($num)]} {
+ unset settings_o($settings($num))
+ }
+ set newsetting ${idchar}${num}
+ set settings($num) $newsetting
+ set settings_o($newsetting) 1
+}
+
+# variables:
+# from map file
+# $segnum($segname) = $num
+# $segmovs($segname) = [list $segname/$movfeat ...]
+# $movbase($segname/$movfeat) = $movbase (ie, prefix)
+# $movconfs($segname/$movfeat) = no. of configurations
+# state we are showing
+# $power = 0 or 1
+# $segrev($segname) = 0 or 1
+# $segdet($segname) = 0 or 1
+# $movpos($segname/$movfeat) = $pos (number) or -1 meaning unknown
+
+proc P {onoff} { # power
+ global power
+ set power $onoff
+ update_allsegs
+ update_image
+}
+
+proc R {args} { # reverse segnames
+ foreach segname $args {
+ upvar #0 segrev($segname) r
+ set r [expr {!$r}]
+ update_seg $segname
+ }
+ update_image
+}
+
+proc D0 {args} { train_presence 0 $args }
+proc D1 {args} { train_presence 1 $args }
+
+proc train_presence {yn l} {
+ foreach segname $l {
+ upvar #0 segdet($segname) d
+ set d $yn
+ update_seg $segname
+ }
+ update_image
+}
+
+proc M {segname mp {movfeat P}} { # mp==x is unknown
+ upvar #0 movpos($segname/$movfeat) p
+ if {![string compare -nocase x $mp]} { set mp -1 }
+ set p $mp
+ update_seg $segname
+ update_image
+}
+
+proc update_allsegs {} {
+ global segnum
+ foreach segname [array names segnum] {
+ update_seg $segname
+ }
+}
+
+proc update_seg {segname} {
+ upvar #0 segnum($segname) num
+ upvar #0 segrev($segname) r
+ upvar #0 segdet($segname) d
+ upvar #0 segmovs($segname) movs
+ global power
+
+#puts stderr "update_seg $segname"
+
+ if {!$power} {
+ set idchar z
+ } else {
+ set idchar [expr {$r ? "r" : "f"}]
+ if {$d} { set idchar [string toupper $idchar] }
+ }
+ setsegbynum $num $idchar
+
+ foreach mov $movs {
+#puts stderr "update_seg $segname mov $mov"
+ upvar #0 movpos($mov) mp
+ upvar #0 movbase($mov) mb
+ upvar #0 movconfs($mov) mc
+ for {set pos 0} {$pos < (1<<$mc)} {incr pos} {
+#puts stderr "update_seg $segname mov $mov pos $pos $mc"
+ set idchar_mov x
+ if {$mp!=-1 && ($pos & (1<<$mp))} { set idchar_mov $idchar }
+ setsegbynum $num.[expr {$pos|$mb}] $idchar_mov
+ }
+ }
+}
+
+proc setup {} {
+ global segnum segmovs movbase movconfs
+ global power segrev segdet movpos
+ set power 0
+ set f [open ours.dgram-bot.segcmap]
+ while {[gets $f l] >= 0} {
+ if {[regexp {^S (\w+) (\w+)$} $l dummy segname num]} {
+ set segnum($segname) $num
+ set segmovs($segname) {}
+ set segrev($segname) 0
+ set segdet($segname) 0
+ } elseif {[regexp {^F (\w+) (\w+) (\w+) (\w+) (\w+)$} \
+ $l dummy segname num movfeat mb mc]} {
+ set segnum($segname)
+ set mov $segname/$movfeat
+ lappend segmovs($segname) $mov
+ set movbase($mov) $mb
+ set movconfs($mov) $mc
+ set movpos($mov) -1
+ }
+ }
+}
+
+proc main {} {
+ widgets
+ setup
+ update_allsegs
+ update_image
+}
+
+main