chiark / gitweb /
test ui seems to work
authorian <ian>
Sat, 23 Oct 2004 19:27:13 +0000 (19:27 +0000)
committerian <ian>
Sat, 23 Oct 2004 19:27:13 +0000 (19:27 +0000)
layout/.cvsignore
layout/Makefile
layout/test-ui [new file with mode: 0644]

index 733ed454345d86e159a1cb40f65473a8d5b86690..77e5bbb5844a7b4c554a1830446fcd3a7075b2ea 100644 (file)
@@ -10,3 +10,5 @@ ours-*.ps
 t.*
 subseg2display
 compose-segenco
+tmp.*
+ui-plan-*.ppm
index e1903fcc51330a4129f359e5c03dea36fcfbe50e..c59e6f48b532a0e6ef13dfa5c0de950fc92584d1 100644 (file)
@@ -86,6 +86,11 @@ parts.ps:    showlib.d4 layout
 t.ppm:         ours.dgram-bot.pa.segenco.ppm x.gdb subseg2display
                gdb -x x.gdb
 
+ui-plan-%.ppm: ours.dgram-%.pa.segenco.ppm Makefile
+               pnmcrop <$< >$@.1.new
+               pnmflip <$@.1.new -ccw >$@.2.new
+               pnmpad <$@.2.new -white -l5 -r5 -t5 -b5 $o
+
 subseg2display.o compose-segenco.o: segcmap.h
 
 clean:
diff --git a/layout/test-ui b/layout/test-ui
new file mode 100644 (file)
index 0000000..a6a398e
--- /dev/null
@@ -0,0 +1,174 @@
+#!/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