From: ian <ian>
Date: Sun, 1 Jun 2008 22:25:59 +0000 (+0000)
Subject: restructure the program
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=66f845a7bd7eaf974d74c632cd4363e919def392;p=trains.git

restructure the program
---

diff --git a/hostside/gui b/hostside/gui
index c52a98d..7435607 100755
--- a/hostside/gui
+++ b/hostside/gui
@@ -1,5 +1,7 @@
 #!/usr/bin/wishx
 
+#---------- general utilities ----------
+
 source lib.tcl
 
 proc pagew {page} { return ".picture-$page" }
@@ -23,6 +25,42 @@ proc widgets-dgram {} {
     pack $w
 }
 
+proc bgerror {emsg} {
+    global errorCode errorInfo
+    catch {
+	puts stderr "UNEXPECTED BACKGROUND ERROR\n"
+	puts stderr "$errorCode\n$errorInfo\n$emsg"
+    }
+    exit 16
+}
+
+#---------- train set event registraton ----------
+
+set event_dispatch_body {}
+
+proc register-event {re args body} {
+    global event_dispatch_body
+    regsub -all {\W+} $re - proc
+    set proc "event/$proc/[join $args -]"
+    set suffix {}
+    set number 0
+    while {![catch { info args $proc$suffix }]} { set suffix [incr number] }
+    append proc $suffix
+	
+    proc $proc [concat l $args] $body
+    set al ""
+    foreach a $args { append al " \$$a" }
+
+    append event_dispatch_body \
+	    "    if {\[regexp [list $re] \$l dummy $args]} {\n" \
+	    "        debug \"$proc$al\"\n" \
+	    "        eval [list $proc] \[list \$l$al]\n" \
+	    "        return\n" \
+	    "    }\n"
+}
+
+#---------- movpos (overlay buttons, keybindings, execution) ----------
+
 proc movpos-button-gvars {mid} {
     upvar #0 mp_details($mid) details
     if {![info exists details]} { return 0 }
@@ -69,26 +107,6 @@ proc movpos-button-setdisplay {mid} {
     place $w -anchor center -x $x -y $y
 }
 
-proc bgerror {emsg} {
-    global errorCode errorInfo
-    catch {
-	puts stderr "UNEXPECTED BACKGROUND ERROR\n"
-	puts stderr "$errorCode\n$errorInfo\n$emsg"
-    }
-    exit 16
-}
-
-proc gui-pipe-readable {args} {
-    global gui_pipe
-    while {[gets $gui_pipe l] >= 0} {
-	debug "<gui-plan $l"
-    }
-    if {[eof $gui_pipe]} {
-	close $gui_pipe
-	error "gui-plan crashed"
-    }
-}
-
 proc movpos-invoked {mid} {
     global movfeatcommand
     movpos-button-gvars $mid
@@ -99,33 +117,6 @@ proc movpos-invoked {mid} {
     sconn "$movfeatcommand $seg $feat $new_posn"
 }
 
-proc train-event-eof {} {
-    error "lost connection to train set"
-}
-
-set event_dispatch_body {}
-
-proc register-event {re args body} {
-    global event_dispatch_body
-    regsub -all {\W+} $re - proc
-    set proc "event/$proc/[join $args -]"
-    set suffix {}
-    set number 0
-    while {![catch { info args $proc$suffix }]} { set suffix [incr number] }
-    append proc $suffix
-	
-    proc $proc [concat l $args] $body
-    set al ""
-    foreach a $args { append al " \$$a" }
-
-    append event_dispatch_body \
-	    "    if {\[regexp [list $re] \$l dummy $args]} {\n" \
-	    "        debug \"$proc$al\"\n" \
-	    "        eval [list $proc] \[list \$l$al]\n" \
-	    "        return\n" \
-	    "    }\n"
-}
-
 register-event {^.movpos (\w+) feat (\w+) ([01]|\?) } {seg feat posn_new} {
     set mid $seg/$feat
     if {![movpos-button-gvars $mid]} return
@@ -134,44 +125,27 @@ register-event {^.movpos (\w+) feat (\w+) ([01]|\?) } {seg feat posn_new} {
     movpos-button-setdisplay $mid
 }
 
-register-event {^=connected} {} {
-    global pages gui_pipe server port
-
-    sconn "select-replay ?movpos_*_feat"
-
-    foreach page $pages {
-	set w [pagew $page]
-	tkwait visibility $w
-
-	set cmdl [list ./gui-plan-$page [winfo id $w] @$server,$port]
-	lappend cmdl 2>@ stderr
-	set gui_pipe [open |$cmdl r]
-
-	puts stderr "running $cmdl"
-	fconfigure $gui_pipe -blocking no
-	fileevent $gui_pipe readable gui-pipe-readable
+proc movpos-bindkey-1 {cpage key seg feat} {
+    global posdeviation
+    manyset [subseg-end-get-centroid $cpage $seg $feat {}] mx my
+    set mid $seg/$feat
+    foreach posn {0 1} {
+	manyset [subseg-end-get-centroid $cpage $seg $feat $posn] x y
+	set dx [expr {$x-$mx}]; set dy [expr {$y-$my}]
+	set d [expr {sqrt($dx*$dx + $dy*$dy)}]
+	set mul [expr {$posdeviation / ($d + 1e-6)}]
+	set x [expr {$mx + $mul*$dx}]
+	set y [expr {$my + $mul*$dy}]
+	lappend poslocs [list $x $y]
     }
-}
-
-register-event {^=failed} {} { error "multiplexer failed: $l" }
-register-event {^=denied} {} { error "multiplexer denied us: $l" }
-# register-event {^\+nack} {} { error "multiplexer does not understand" }
+    lappend poslocs [list $mx $my]
+    upvar #0 mp_details($mid) details
+    set details [list $cpage $key $seg $feat $poslocs]
 
-append event_dispatch_body {
-    debug "ignored $l"
+    bind . <Key-[string tolower $key]> [list movpos-invoked $mid]
 }
 
-proc train-event-inputline {sconn l} $event_dispatch_body
-
-proc engage {} {
-    global server port sconn
-
-    set sconn [socket $server $port]
-    fconfig-trainproto $sconn
-    fileevent $sconn readable {readable train-event $sconn}
-
-    start_commandloop
-}
+#---------- computation of movpos button locations
 
 proc layout-subseg-end {seg feat posn x y} {
     global cpage
@@ -195,26 +169,6 @@ proc subseg-end-get-centroid {cpage seg feat posn} {
     return [list [expr {$sx * 1.0 / $n}] [expr {$sy * 1.0 / $n}]]
 }
 
-proc movpos-bindkey-1 {cpage key seg feat} {
-    global posdeviation
-    manyset [subseg-end-get-centroid $cpage $seg $feat {}] mx my
-    set mid $seg/$feat
-    foreach posn {0 1} {
-	manyset [subseg-end-get-centroid $cpage $seg $feat $posn] x y
-	set dx [expr {$x-$mx}]; set dy [expr {$y-$my}]
-	set d [expr {sqrt($dx*$dx + $dy*$dy)}]
-	set mul [expr {$posdeviation / ($d + 1e-6)}]
-	set x [expr {$mx + $mul*$dx}]
-	set y [expr {$my + $mul*$dy}]
-	lappend poslocs [list $x $y]
-    }
-    lappend poslocs [list $mx $my]
-    upvar #0 mp_details($mid) details
-    set details [list $cpage $key $seg $feat $poslocs]
-
-    bind . <Key-[string tolower $key]> [list movpos-invoked $mid]
-}
-
 proc layout-data {} {
     global cpage
     upvar #0 ld_sse/$cpage sse
@@ -237,6 +191,66 @@ proc layout-data {} {
     }
 }
 
+#---------- plan background (gui-plan subprocess) ----------
+
+proc gui-pipe-readable {args} {
+    global gui_pipe
+    while {[gets $gui_pipe l] >= 0} {
+	debug "<gui-plan $l"
+    }
+    if {[eof $gui_pipe]} {
+	close $gui_pipe
+	error "gui-plan crashed"
+    }
+}
+
+#---------- train set events of general interest, and setup ----------
+
+proc train-event-eof {} {
+    error "lost connection to train set"
+}
+
+register-event {^=connected} {} {
+    global pages gui_pipe server port
+
+    sconn "select-replay ?movpos_*_feat"
+
+    foreach page $pages {
+	set w [pagew $page]
+	tkwait visibility $w
+
+	set cmdl [list ./gui-plan-$page [winfo id $w] @$server,$port]
+	lappend cmdl 2>@ stderr
+	set gui_pipe [open |$cmdl r]
+
+	puts stderr "running $cmdl"
+	fconfigure $gui_pipe -blocking no
+	fileevent $gui_pipe readable gui-pipe-readable
+    }
+}
+
+register-event {^=failed} {} { error "multiplexer failed: $l" }
+register-event {^=denied} {} { error "multiplexer denied us: $l" }
+register-event {^\+nack} {} { error "multiplexer does not understand" }
+
+#---------- main program ----------
+
+append event_dispatch_body {
+    debug "ignored $l"
+}
+proc train-event-inputline {sconn l} $event_dispatch_body
+proc register-event {args} { error "too late!" }
+
+proc engage {} {
+    global server port sconn
+
+    set sconn [socket $server $port]
+    fconfig-trainproto $sconn
+    fileevent $sconn readable {readable train-event $sconn}
+
+    start_commandloop
+}
+
 proc main {} {
     global pages cpage
     setting server railway {[[0-9a-z:].*}