From aeff8867070531f13cff92185654e520f4961f89 Mon Sep 17 00:00:00 2001 From: ian Date: Sat, 7 Jun 2008 23:21:06 +0000 Subject: [PATCH] gui wip coming along nicely --- hostside/gui | 53 ++++++++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 24 deletions(-) diff --git a/hostside/gui b/hostside/gui index 6ab84e6..279aa9c 100755 --- a/hostside/gui +++ b/hostside/gui @@ -97,7 +97,11 @@ proc scmd_result {oknakerr message reporterrmsg} { if {[string length $reporterrmsg]} { report-problem "$ctrlr: $reporterrmsg" } - eval [list "$onresult-$oknakerr" $message] $args + set proc "$onresult-$oknakerr" + if {![string compare $oknakerr nak] && [catch { info args $proc }]} { + set proc "$onresult-err" + } + eval [list $proc $message] $args } register-event {} {} {^\+ack \S+ ok } { scmd_result ok $l "" } @@ -112,7 +116,6 @@ proc routinecmd-nak {m args} { error "got nak to routine command: $m" } proc routinecmd-err {m args} { } proc routinecmd-ok {m args} { } -proc mustsucceed-nak {m args} { error "unexpected nak: $m" } proc mustsucceed-err {m args} { error "unexpected error: $m" } proc mustsucceed-ok {m args} { } @@ -304,7 +307,7 @@ proc speedw-new {w ctrlr} { upvar #0 speed/$w s global speedws - lappend $speedws $w + lappend speedws $w set s(ctrlr) $ctrlr set s(inhibit) 0 set s(commanding) 0 @@ -327,7 +330,7 @@ proc speedw-notrains {w whystr} { proc speedw-train-noneselected {w whystr} { upvar #0 speed/$w s set s(train) {} - $w.train configure -text "($whystr)" + $w.train configure -text $whystr $w.speed configure -textvariable {} -text - speedw-inhibit $w } @@ -358,7 +361,7 @@ proc speedw-train-selected {w t} { proc speedw-trains-available {w l} { upvar #0 speed/$w s - if {![llength $l]} { speedw-set-disabled $w "no trains"; return } + if {![llength $l]} { speedw-train-noneselected $w "(no trains)"; return } $s(optionmenu) delete 0 end $s(optionmenu) add radiobutton -label "(none)" -value {} \ -command [list speedw-train-noneselected $w "(no train selected)"] @@ -370,7 +373,7 @@ proc speedw-trains-available {w l} { $w.train configure -state normal if {[llength $l]==1} { $s(optionmenu) invoke 1 - } elseif {[set ix [lsearch -exact $l $s(train)] >= 0]} { + } elseif {[set ix [lsearch -exact $l $s(train)]] >= 0} { $s(optionmenu) invoke [expr {$ix+1}] } elseif {![string length $s(train)]} { $s(optionmenu) invoke 0 @@ -439,14 +442,18 @@ register-event ?train_*_speed_commanded {train speed} \ set cmd $speed } -proc speedws-stastate-run {} { - global train_commanded - speedws-forall speedw-trains-available [array names train_commanded] -} -proc speedws-stastate-not-run {} { - global train_commanded - catch { unset train_commanded } - speedws-forall speedw-notrains "($stastate)" +proc speedws-stastate-hook {} { + global train_commanded stastate + switch -exact $stastate { + Run { + set trains [array names train_commanded] + speedws-forall speedw-trains-available $trains + } + default { + catch { unset train_commanded } + speedws-forall speedw-notrains "($stastate)" + } + } } register-event &train_*_signalling-problem {train problem} \ @@ -631,22 +638,16 @@ proc train-event-eof {args} { error "lost connection to train set" } -register-event ?stastate {state} \ - {^.stastate (\w+|\-) } { - global ctrain trains statstate - +register-event ?stastate {ctxch state} {^(.)stastate (\w+|\-) } { + global ctrain trains stastate set stastate $state - - switch -exact $stastate { - Run { speedws-stastate-run } - default { speedws-stastate-not-run } - } + if {[string compare ctxch |]} speedws-stastate-hook } register-event {} {} {^=connected } { global pages gui_pipe server port event_selections - scmd mustsucceed {} "select-replay [concat $event_selections]" + scmd replayed {} "select-replay [concat $event_selections]" foreach page $pages { set w [pagew $page] @@ -661,6 +662,10 @@ register-event {} {} {^=connected } { fileevent $gui_pipe readable gui-pipe-readable } } +proc replayed-err {m args} { error "replay failed: $m" } +proc replayed-ok {m args} { + speedws-stastate-hook +} register-event {} {} {^=failed } { error "multiplexer failed: $l" } register-event {} {} {^=denied } { error "multiplexer denied us: $l" } -- 2.30.2