hostside/gui-displayer

   1 #!/usr/bin/wish8.2
   2
   3 proc widgets {} {
   4     global widg_pipe
   5     set sizes [exec ./gui-plan-bot --sizes]
   6     frame .picture -background {} \
   7             -width [lindex $sizes 0] \
   8             -height [lindex $sizes 1]
   9     pack .picture
  10     tkwait visibility .picture
  11     set widg_pipe [open |[list ./gui-plan-bot \
  12             [winfo id .picture] >&@ stderr] w]
  13 }
  14
  15 proc setsegbyname {segfeatname command {posnum {}}} {
  16     global widg_pipe
  17 #puts stderr "setsegbynum $num $idchar"
  18     set s "$command $segfeatname"
  19     if {[string length $posnum]} { append s " $posnum" }
  20     puts $widg_pipe $s
  21     puts ">> $s"
  22 }
  23
  24 proc update_push {} {
  25     global widg_pipe
  26     flush $widg_pipe
  27 }
  28
  29 # variables:
  30 #   from map file
  31 #        $segmovs($segname)        = [list $segname/$movfeat ...]
  32 #        $movconfs($segname/$movfeat) = no. of configurations
  33 #   state we are showing
  34 #        $power                    = 0 or 1
  35 #        $segrev($segname)         = 0 or 1
  36 #        $segdet($segname)         = 0 or 1
  37 #        $segown($segname)         = {} or t or f
  38 #        $movpos($segname/$movfeat) = $pos (number) or {} meaning unknown
  39
  40 proc P {onoff} { # power
  41     global power
  42     set power $onoff
  43     update_allsegs
  44     update_push
  45 }
  46
  47 proc R {now args} { # reverse segnames
  48     foreach segname $args {
  49         upvar #0 segrev($segname) r
  50         set r $now
  51         update_seg $segname
  52     }
  53     update_push
  54 }
  55
  56 proc setsegs {segfoo value l} {
  57     foreach segname $l {
  58         upvar #0 ${segfoo}($segname) d
  59         set d $value
  60         update_seg $segname
  61     }
  62     update_push
  63 }
  64
  65 proc D0 {args} { setsegs segdet 0 $args }
  66 proc D1 {args} { setsegs segdet 1 $args }
  67 proc OT {args} { setsegs segown t $args }
  68 proc OF {args} { setsegs segown f $args }
  69 proc ON {args} { setsegs segown {} $args }
  70
  71 proc M {segname mp {movfeat P}} { # mp==x is unknown
  72     upvar #0 movpos($segname/$movfeat) p
  73     upvar #0 movconfs($segname/$movfeat) n
  74     if {![string compare -nocase x $mp]} { set mp {} }
  75     if {$mp >= $n} { error "out of range $segname $movfeat $mp $n ?" }
  76     set p $mp
  77     update_seg $segname
  78     update_push
  79 }
  80
  81 proc update_allsegs {} {
  82     global segmovs
  83     foreach segname [array names segmovs] { update_seg $segname }
  84 }
  85
  86 proc update_seg {segname} {
  87     upvar #0 segrev($segname) r
  88     upvar #0 segdet($segname) d
  89     upvar #0 segown($segname) o
  90     upvar #0 segmovs($segname) movs
  91     global power
  92
  93 #puts stderr "update_seg $segname"
  94
  95     if {!$power} {
  96         set command off
  97     } else {
  98         set command [expr {$d ? "det" : "on"}]
  99         if {$r} { set command "i$command" }
 100         set command $o$command
 101     }
 102     setsegbyname $segname $command
 103
 104     foreach mov $movs {
 105 #puts stderr "update_seg $segname mov $mov"
 106         upvar #0 movpos($mov) mp
 107         if {[string length $mp] && [string compare off $command]} {
 108             setsegbyname $mov $command $mp
 109         } else {
 110             setsegbyname $mov $command
 111         }
 112     }
 113 }
 114
 115 proc setup {} {
 116     global segnum segmovs movconfs
 117     global power segrev segdet segown movpos
 118     set power 0
 119     set f [open ../layout/ours.dgram-bot.segcmap]
 120     fconfigure stdout -buffering none
 121     while {[gets $f l] >= 0} {
 122         if {[regexp {^S (\w+) (\w+)$} $l dummy segname num]} {
 123             set segnum($segname) $num
 124             set segmovs($segname) {}
 125             set segrev($segname) 0
 126             set segdet($segname) 0
 127             set segown($segname) {}
 128         } elseif {[regexp {^F (\w+) \w+ (\w+) \w+ (\w+)$} \
 129                 $l dummy  segname movfeat mc]} {
 130             set segnum($segname)
 131             set mov $segname/$movfeat
 132             lappend segmovs($segname) $mov
 133             set movconfs($mov) $mc
 134             set movpos($mov) {}
 135         }
 136     }
 137 }
 138
 139 proc main {} {
 140     setup
 141     widgets
 142     update_allsegs
 143     update_push
 144 }
 145
 146 proc EOE {} { global exitoneof; set exitoneof 1}
 147
 148 main
 149
 150 while {[gets stdin l]>=0} {
 151     if {[regexp {^GUI ([A-Z][0-9a-zA-Z ]*)$} $l dummy cmd]} {
 152         puts "GUI $cmd"
 153         eval $cmd
 154     } else {
 155         puts $l
 156     }
 157 }
 158
 159 if {[info exists exitoneof]} { exit 0 }