source: trunk/p2p/test.tcl @ 2080

Last change on this file since 2080 was 2080, checked in by mmc, 11 years ago

Part 1 of a major reorganization of content. Moving "instant" to "builder"
and setting up "builder" more like the "gui" part as a package. Moving the
Rappture::object stuff from the builder into the main installation, so it
can be shared by the tester as well. Moving "driver" into gui/scripts
where it belongs. Creating a new "launcher.tcl" script that decides
which of the three parts to launch based on command line options. Still
need to sort out the Makefiles to get this all right...

File size: 24.7 KB
Line 
1# ----------------------------------------------------------------------
2#  TEST HARNESS for the P2P infrastructure
3#
4#  This script drives the test setup and visualization for the P2P
5#  infrastructure.  It launches the authority server(s) and various
6#  workers, and helps to visualize their interactions.
7# ----------------------------------------------------------------------
8#  Michael McLennan (mmclennan@purdue.edu)
9# ======================================================================
10#  Copyright (c) 2008  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itcl
16
17# recognize other library files in this same directory
18set dir [file dirname [info script]]
19lappend auto_path $dir
20
21set time0 [clock seconds]
22set processes ""
23set nodes(all) ""
24set nodeRadius 15
25
26option add *highlightBackground [. cget -background]
27option add *client*background gray
28option add *client*highlightBackground gray
29option add *client*troughColor darkGray
30
31# ======================================================================
32#  SHAPES
33# ======================================================================
34itcl::class Shape {
35    private variable _canvas ""      ;# shape sits on this canvas
36    private variable _ranges ""      ;# list of time ranges for shape
37    private common _shapesOnCanvas   ;# maps canvas => list of shapes
38
39    public variable command ""  ;# command template used to create shape
40
41    constructor {canvas args} {
42        # add this shape to the list of shapes on this canvas
43        lappend _shapesOnCanvas($canvas) $this
44        set _canvas $canvas
45        eval configure $args
46    }
47    destructor {
48        # remove this shape from the list of shapes on the canvas
49        set i [lsearch $_shapesOnCanvas($_canvas) $this]
50        if {$i >= 0} {
51            set _shapesOnCanvas($_canvas) \
52                [lreplace $_shapesOnCanvas($_canvas) $i $i]
53        }
54    }
55
56    # ------------------------------------------------------------------
57    #  METHOD: addRange <time0> <time1>
58    #  Declares that this shape exists during the given time range
59    #  between <time0> and <time1>.
60    # ------------------------------------------------------------------
61    public method addRange {t0 t1} {
62        # see if there's any overlap with existing ranges
63        set ri0 -1
64        set ri1 -1
65        for {set i 0} {$i < [llength $_ranges]} {incr i} {
66            set pair [lindex $_ranges $i]
67            foreach {r0 r1} $pair break
68            if {$r0 >= $t0 && $r0 <= $t1} {
69                set ri0 $i
70            }
71            if {$r1 >= $t0 && $r1 <= $t1} {
72                set ri1 $i
73            }
74            incr i
75        }
76
77        if {$ri0 < 0 && $ri1 < 1} {
78            # doesn't overlap with anything -- insert in right place
79            for {set i 0} {$i < [llength $_ranges]} {incr i} {
80                set pair [lindex $_ranges $i]
81                foreach {r0 r1} $pair break
82                if {$t0 < $r0} break
83            }
84            set _ranges [linsert $_ranges $i [list $t0 $t1]]
85        } elseif {$ri0 >= 0 && $ri1 >= 0} {
86            # overlaps on both limits -- bridge the middle part
87            set r0 [lindex [lindex $_ranges $ri0] 0]
88            set r1 [lindex [lindex $_ranges $ri1] 1]
89            set _ranges [lreplace $_ranges $ri0 $ri1 [list $r0 $r1]]
90        } elseif {$ri0 >= 0} {
91            # overlaps on the lower limit
92            for {set i [expr {[llength $_ranges]-1}]} {$i >= 0} {incr i -1} {
93                set pair [lindex $_ranges $i]
94                foreach {r0 r1} $pair break
95                if {$r0 > $t0 && $r1 < $t1} {
96                    # remove any ranges completely contained in this one
97                    set _ranges [lreplace $_ranges $i $i]
98                }
99                set _ranges [lreplace $_ranges $ri0 $ri1 [list $r0 $r1]]
100            }
101            set pair [lindex $_ranges $ri0]
102            foreach {r0 r1} $pair break
103            set _ranges [lreplace $_ranges $ri0 $ri0 [list $r0 $t1]]
104        } else {
105            # overlaps on the upper limit
106            for {set i [expr {[llength $_ranges]-1}]} {$i >= 0} {incr i -1} {
107                set pair [lindex $_ranges $i]
108                foreach {r0 r1} $pair break
109                if {$r0 > $t0 && $r1 < $t1} {
110                    # remove any ranges completely contained in this one
111                    set _ranges [lreplace $_ranges $i $i]
112                }
113                set _ranges [lreplace $_ranges $ri0 $ri1 [list $r0 $r1]]
114            }
115            set pair [lindex $_ranges $ri1]
116            foreach {r0 r1} $pair break
117            set _ranges [lreplace $_ranges $ri1 $ri1 [list $t0 $r1]]
118        }
119    }
120
121    # ------------------------------------------------------------------
122    #  METHOD: exists <time>
123    #  Checks to see if this shape exists at the given <time>.
124    #  Returns 1 if so, and 0 otherwise.
125    # ------------------------------------------------------------------
126    public method exists {t} {
127        for {set i 0} {$i < [llength $_ranges]} {incr i} {
128            set pair [lindex $_ranges $i]
129            foreach {r0 r1} $pair break
130            if {$t >= $r0 && $t <= $r1} {
131                return 1
132            }
133        }
134        return 0
135    }
136
137    # ------------------------------------------------------------------
138    #  PROC: draw <canvas> <time>
139    #  Finds the list of shapes that exist on the given <canvas> at
140    #  the specified time, and executes all of their associated
141    #  -command templates, adding them to the canvas.
142    # ------------------------------------------------------------------
143    public proc draw {canvas time} {
144        global times
145        if {[info exists _shapesOnCanvas($canvas)]} {
146            set y0 5
147            if {[info exists times($time)]} {
148                $canvas create text 5 $y0 -anchor nw -text $times($time)
149                incr y0 15
150            }
151            $canvas create text 5 $y0 -anchor nw -tags entity
152
153            foreach obj $_shapesOnCanvas($canvas) {
154                if {[$obj exists $time]} {
155                    set cmd [$obj cget -command]
156                    regsub -all %c $cmd $canvas cmd
157                    eval $cmd
158                }
159            }
160        }
161    }
162
163    # ------------------------------------------------------------------
164    #  PROC: clear <canvas>
165    #  Removes all shapes associated with the specified <canvas>.
166    # ------------------------------------------------------------------
167    public proc clear {canvas} {
168        if {[info exists _shapesOnCanvas($canvas)]} {
169            eval itcl::delete object $_shapesOnCanvas($canvas)
170        }
171    }
172}
173
174# ======================================================================
175#  Build the main interface
176# ======================================================================
177frame .client -borderwidth 8 -relief flat
178pack .client -side right -fill y
179button .client.getbids -text "Get Bids:" -command test_bids
180pack .client.getbids -side top -anchor w
181frame .client.cntls
182pack .client.cntls -side bottom -fill x
183button .client.cntls.run -text "Spend" -command test_spend
184pack .client.cntls.run -side left
185entry .client.cntls.points -width 8
186pack .client.cntls.points -side left
187label .client.cntls.pointsl -text "points"
188pack .client.cntls.pointsl -side left
189
190frame .client.bids
191pack .client.bids -side bottom -expand yes -fill both
192scrollbar .client.bids.ysbar -orient vertical -command {.client.bids.info yview}
193pack .client.bids.ysbar -side right -fill y
194listbox .client.bids.info -yscrollcommand {.client.bids.ysbar set}
195pack .client.bids.info -side left -expand yes -fill both
196
197frame .cntls
198pack .cntls -fill x
199
200button .cntls.start -text "Start" -command test_start
201pack .cntls.start -side left -padx 4 -pady 2
202
203button .cntls.stop -text "Stop" -command test_stop -state disabled
204pack .cntls.stop -side left -padx 4 -pady 2
205
206button .cntls.reload -text "Reload" -command test_reload
207pack .cntls.reload -side left -padx 4 -pady 2
208
209button .cntls.layout -text "New Layout" -command {
210    foreach key [array names nodes *-\[xy\]] {
211        unset nodes($key)
212    }
213    after idle test_reload
214}
215pack .cntls.layout -side left -padx 4 -pady 2
216
217entry .cntls.workers -width 5
218pack .cntls.workers -side right -padx {0 4} -pady 2
219.cntls.workers insert end "3"
220label .cntls.workersl -text "Workers:"
221pack .cntls.workersl -side right -pady 2
222
223frame .player
224pack .player -side bottom -fill x
225
226button .player.back -text "<" -command {test_frame_go -1 nudge}
227pack .player.back -side left -padx 4 -pady 2
228
229button .player.fwd -text ">" -command {test_frame_go 1 nudge}
230pack .player.fwd -side left -padx 4 -pady 2
231
232button .player.err -text "0 errors" -command {wm deiconify .errors; raise .errors}
233pack .player.err -side right -padx 4 -pady 2
234.player.err configure -state disabled
235
236scale .player.scale -label "Frame" -orient horizontal \
237    -from 0 -to 1 -showvalue 0 -command {test_frame_go 1}
238pack .player.scale -side left -expand yes -fill x -padx 4 -pady 2
239
240frame .view
241pack .view -side bottom -anchor w
242label .view.show -text "Show:"
243grid .view.show -row 0 -column 0 -sticky e
244radiobutton .view.network -text "P2P Network" -variable view -value network -command test_view_change
245grid .view.network -row 0 -column 1 -sticky w
246radiobutton .view.traffic -text "Network traffic" -variable view -value traffic -command test_view_change
247grid .view.traffic -row 1 -column 1 -sticky w
248
249frame .diagram
250pack .diagram -expand yes -fill both
251canvas .diagram.network -width 500 -height 400
252canvas .diagram.traffic -width 500 -height 400
253
254after idle .view.traffic invoke
255
256toplevel .errors
257wm title .errors "Error Messages"
258wm withdraw .errors
259wm protocol .errors WM_DELETE_WINDOW {wm withdraw .errors}
260scrollbar .errors.ysbar -orient vertical -command {.errors.info yview}
261pack .errors.ysbar -side right -fill y
262text .errors.info -yscrollcommand {.errors.ysbar set} -font {Courier 12}
263pack .errors.info -expand yes -fill both
264.errors.info tag configure timecode -foreground gray
265.errors.info tag configure error -foreground red -font {Courier 12 bold}
266
267proc test_stop {} {
268    global processes
269
270    # kill any existing processes
271    foreach job $processes {
272        exec kill $job
273    }
274    set processes ""
275
276    .cntls.stop configure -state disabled
277    .cntls.start configure -state normal
278
279    after idle test_reload
280}
281
282proc test_start {} {
283    global processes
284
285    # clean up existing log files...
286    foreach fname [glob -nocomplain /tmp/log*] {
287        file delete $fname
288    }
289
290    # launch a new authority server
291    lappend processes [exec tclsh authority.tcl &]
292
293    # launch a series of workers
294    for {set i 0} {$i < [.cntls.workers get]} {incr i} {
295        lappend processes [exec tclsh worker.tcl &]
296        after [expr {int(rand()*5000)}]
297    }
298
299    .cntls.start configure -state disabled
300    .cntls.stop configure -state normal
301}
302
303proc test_reload {} {
304    global time0 nodes actions times nodeRadius
305
306    array set colors {
307        authority blue
308        worker gray
309        foreman red
310    }
311
312    Shape::clear .diagram.network
313    Shape::clear .diagram.traffic
314    .errors.info configure -state normal
315    .errors.info delete 1.0 end
316    set tmax 0
317    set errs 0
318
319    #
320    # Scan through all files and generate positions for all nodes.
321    #
322    foreach fname [glob -nocomplain /tmp/log*] {
323        set fid [open $fname r]
324        set info [read $fid]
325        close $fid
326
327        set lasttime ""
328        set t0val ""; set first ""
329        set t1val ""; set last ""
330        set info [split $info \n]
331        foreach line $info {
332            if {[regexp {^([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+:[0-9]+)} $line match tval]} {
333                if {"" == $t0val} {
334                    set first $line
335                    set t0val [expr {([clock scan $tval]-$time0)*100}]
336                } else {
337                    set last $line
338                    set t1val [expr {([clock scan $tval]-$time0)*100 + 99}]
339                }
340            }
341        }
342
343        if {"" == $t0val || "" == $t1val} {
344            # can't find any log statements -- skip this file!
345            continue
346        }
347
348        # get the address for this host
349        if {[regexp {started at port ([0-9]+)} $info match port]} {
350            if {[regexp {options [^\n]+ ip ([^ ]+)} $info match ip]} {
351                set addr $ip:$port
352            } else {
353                set addr 127.0.0.1:$port
354            }
355            set shape oval
356            regexp {^([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+:[0-9]+) +(authority|worker)} $first match t0 type
357        } elseif {[regexp -- {foreman<-} $info]} {
358            set shape rectangle
359            set addr "foreman"
360            set type "foreman"
361        } else {
362            # unknown log file -- skip it
363            continue
364        }
365        set margin 20
366        set r $nodeRadius
367
368        set nodes($fname) $addr
369        set nodes($addr-log) $fname
370        set nodes($addr-type) $type
371        if {![info exists nodes($addr-x)]} {
372            set w [expr {[winfo width .diagram]-2*$margin}]
373            set h [expr {[winfo height .diagram]-2*$margin}]
374            set nodes($addr-x) [expr {int(rand()*$w) + $margin}]
375            set nodes($addr-y) [expr {int(rand()*$h) + $margin}]
376        }
377        set x $nodes($addr-x)
378        set y $nodes($addr-y)
379
380        foreach canv {.diagram.traffic .diagram.network} {
381            set s [Shape ::#auto $canv -command \
382                [list %c create $shape [expr {$x-$r}] [expr {$y-$r}] \
383                [expr {$x+$r}] [expr {$y+$r}] \
384                -outline black -fill $colors($type) \
385                -tags [list $fname $fname-node]]]
386            $s addRange $t0val $t1val
387        }
388
389        append actions($t0val) "$type $addr online\n"
390        append actions($t1val) "$type $addr offline\n"
391
392        if {$t1val > $tmax} { set tmax $t1val }
393    }
394               
395    #
396    # Scan through files again and generate shapes for all messages
397    #
398    foreach fname [glob -nocomplain /tmp/log*] {
399        set fid [open $fname r]
400        set info [read $fid]
401        close $fid
402puts "\nscanning $fname"
403
404        catch {unset started}
405        set peerlist(addrs) ""
406        set peerlist(time) 0
407        set lasttime ""
408        set counter 0
409        foreach line [split $info \n] {
410            if {[regexp {^([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+:[0-9]+) (.+)$} $line match time mesg]} {
411                set tval [expr {([clock scan $time]-$time0)*100}]
412
413                if {$time == $lasttime} {
414                    set tval [expr {$tval + [incr counter]}]
415                }
416                set lasttime $time
417
418                if {$tval > $tmax} { set tmax $tval }
419
420                set cid ""
421                if {[regexp {accepted: +([^ ]+) +\((.+)\)} $mesg match addr cid]} {
422                    append actions($tval) $mesg \n
423                    set started(connect$cid-time) $tval
424                    set started(connect$cid-addr) ?
425
426                } elseif {[regexp {dropped: +([^ ]+) +\((.+)\)} $mesg match addr cid] && [info exists started(connect$cid-time)]} {
427                    incr tval 99  ;# end of this second
428                    append actions($tval) $mesg \n
429                    set from $nodes($fname)
430                    set x0 $nodes($from-x)
431                    set y0 $nodes($from-y)
432                    set x1 $nodes($addr-x)
433                    set y1 $nodes($addr-y)
434                    set s [Shape ::#auto .diagram.traffic -command \
435                        [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
436                    $s addRange $started(connect$cid-time) $tval
437
438                    unset started(connect$cid-time)
439                    unset started(connect$cid-addr)
440
441                } elseif {[regexp {(incoming) message from ([^ ]+) \((sock[0-9]+)\): +(.+) => (.*)} $mesg match which addr cid cmd result]
442                       || [regexp {(outgoing) message to ([^ ]+): +(.+)} $mesg match which addr cmd]} {
443                    switch -- $which {
444                        outgoing {
445                            set from $addr
446                            set to $nodes($fname)
447                        }
448                        incoming {
449                            set from $nodes($fname)
450                            set to $addr
451                            # show incoming messages later in time
452                            incr tval 50
453                        }
454                    }
455                    append actions($tval) $mesg \n
456                    set x0 $nodes($from-x)
457                    set y0 $nodes($from-y)
458                    set x1 $nodes($to-x)
459                    set y1 $nodes($to-y)
460                    set w [expr {[winfo width .diagram]/2}]
461
462                    set s [Shape ::#auto .diagram.traffic -command \
463                        [list %c create line [expr $x0-3] [expr $y0-3] [expr $x1-3] [expr $y1-3] -fill black -arrow first -tags transient]]
464                    $s addRange $tval $tval
465
466                    set s [Shape ::#auto .diagram.traffic -command \
467                        [list %c create text [expr {0.5*($x0+$x1)}] [expr {0.5*($y0+$y1)-1}] -width $w -fill black -anchor s -text $cmd -tags transient]]
468                    $s addRange $tval $tval
469
470                    if {$which == "incoming" && "" != [string trim $result]} {
471                        if {[regexp {^ok:} $result]} {
472                            set color black
473                        } else {
474                            set color red
475                        }
476                        set s [Shape ::#auto .diagram.traffic -command \
477                            [list %c create line [expr $x0+3] [expr $y0+3] [expr $x1+3] [expr $y1+3] -fill $color -arrow last -tags transient]]
478                        $s addRange $tval $tval
479
480                        set s [Shape ::#auto .diagram.traffic -command \
481                            [list %c create text [expr {0.5*($x0+$x1)}] [expr {0.5*($y0+$y1)+1}] -width $w -fill $color -anchor n -text $result -tags transient]]
482                        $s addRange $tval $tval
483                    }
484
485                    # no address for this client yet?  then save this info
486                    if {"" != $cid
487                           && [info exists started(connect$cid-addr)]
488                           && $started(connect$cid-addr) == "?"} {
489                        set started(connect$cid-addr) $addr
490                    }
491
492                } elseif {[regexp {connected to peers: (.*)} $mesg match plist]} {
493                    # draw a highlight ring, indicating that peers have changed
494                    set from $nodes($fname)
495                    set x $nodes($from-x)
496                    set y $nodes($from-y)
497                    foreach canv {.diagram.traffic .diagram.network} {
498                        set s [Shape ::#auto $canv -command \
499                            [list %c create oval [expr {$x-$r-3}] [expr {$y-$r-3}] [expr {$x+$r+3}] [expr {$y+$r+3}] -outline red -fill "" -tags transient]]
500                        $s addRange $tval [expr {$tval+20}]
501                    }
502
503                    # draw lines from the previous peer list, now that
504                    # we know it's time range is done.
505                    foreach addr $peerlist(addrs) {
506                        set from $nodes($fname)
507                        set x0 $nodes($from-x)
508                        set y0 $nodes($from-y)
509                        set x1 $nodes($addr-x)
510                        set y1 $nodes($addr-y)
511                        set s [Shape ::#auto .diagram.network -command \
512                            [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
513                        $s addRange $peerlist(time) $tval
514                    }
515
516                    # save the start of this new peer list
517                    set peerlist(addrs) $plist
518                    set peerlist(time) $tval
519                } elseif {[regexp {ERROR} $mesg match addr]} {
520                    .errors.info insert end $time timecode $mesg error "\n"
521                    incr errs
522                }
523                set times($tval) $time
524            }
525        }
526
527        # any connections hanging out that we haven't drawn?
528        foreach key [array names started connect*-addr] {
529            regexp {connect([^-]+)-addr} $key match cid
530            set from $nodes($fname)
531            set addr $started($key)
532
533            if {![info exists nodes($addr-x)]} {
534                unset started(connect$cid-time)
535                unset started(connect$cid-addr)
536                continue
537            }
538            set x0 $nodes($from-x)
539            set y0 $nodes($from-y)
540            set x1 $nodes($addr-x)
541            set y1 $nodes($addr-y)
542            set s [Shape ::#auto .diagram.traffic -command \
543                [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
544            $s addRange $started(connect$cid-time) $tval
545
546            unset started(connect$cid-time)
547            unset started(connect$cid-addr)
548        }
549
550        .diagram.traffic bind $fname <Enter> "
551            %W itemconfigure $fname-node -outline red
552            %W itemconfigure $fname-cnx -fill red
553            %W raise $fname-cnx
554            %W itemconfigure entity -text {$nodes($fname)}
555        "
556        .diagram.traffic bind $fname <Leave> "
557            %W itemconfigure $fname-node -outline black
558            %W itemconfigure $fname-cnx -fill gray
559            %W raise transient
560            %W itemconfigure entity -text {}
561        "
562
563        foreach canv {.diagram.network .diagram.traffic} {
564            $canv bind $fname-node <ButtonPress-1> \
565                [list worker_node_click %W $fname %x %y]
566            $canv bind $fname-node <B1-Motion> \
567                [list worker_node_drag %W $fname %x %y]
568            $canv bind $fname-node <ButtonRelease-1> \
569                [list worker_node_release %W $fname %x %y]
570        }
571
572        # any peer connections that we haven't drawn?  then do it now
573        foreach addr $peerlist(addrs) {
574            set from $nodes($fname)
575            set x0 $nodes($from-x)
576            set y0 $nodes($from-y)
577            set x1 $nodes($addr-x)
578            set y1 $nodes($addr-y)
579            set s [Shape ::#auto .diagram.network -command \
580                [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
581            $s addRange $peerlist(time) $tmax
582        }
583
584        .diagram.network bind $fname <Enter> "
585            %W itemconfigure $fname-node -outline red
586            %W itemconfigure $fname-cnx -fill red
587            %W raise $fname-cnx
588        "
589        .diagram.network bind $fname <Leave> "
590            %W itemconfigure $fname-node -outline black
591            %W itemconfigure $fname-cnx -fill gray
592            %W raise transient
593        "
594    }
595    .player.scale configure -to $tmax
596    .errors.info configure -state disabled
597    if {$errs == 0} {
598        .player.err configure -state normal -text "0 errors"
599        .player.err configure -state disabled
600    } else {
601        .player.err configure -state normal -text "$errs error[expr {($errs == 1) ? {} : {s}}]"
602    }
603
604    after cancel test_visualize
605    after idle test_visualize
606}
607
608proc worker_node_click {canv fname x y} {
609    $canv itemconfigure $fname-node -stipple gray50
610}
611
612proc worker_node_drag {canv fname x y} {
613    global nodeRadius
614    $canv itemconfigure $fname-node -stipple ""
615    $canv coords $fname-node [expr {$x-$nodeRadius}] [expr {$y-$nodeRadius}] [expr {$x+$nodeRadius}] [expr {$y+$nodeRadius}]
616}
617
618proc worker_node_release {canv fname x y} {
619    global move nodes
620
621    worker_node_drag $canv $fname $x $y
622    $canv itemconfigure $fname-node -stipple ""
623
624    set addr $nodes($fname)
625    set nodes($addr-x) $x
626    set nodes($addr-y) $y
627    after idle test_reload
628}
629
630proc test_frame_go {dir position} {
631    global actions times
632
633    set tmax [.player.scale cget -to]
634    if {"nudge" == $position} {
635        set nframe [.player.scale get]
636        incr nframe $dir
637    } else {
638        set nframe $position
639    }
640
641    while {![info exists actions($nframe)] && $nframe > 0 && $nframe < $tmax} {
642        incr nframe $dir
643    }
644
645    # set the scale to this new position
646    .player.scale configure -command ""
647    .player.scale set $nframe
648    .player.scale configure -command {test_frame_go 1}
649
650    after cancel test_visualize
651    after idle test_visualize
652}
653
654proc test_visualize {} {
655    .diagram.traffic delete all
656    Shape::draw .diagram.traffic [.player.scale get]
657    .diagram.traffic raise transient
658
659    .diagram.network delete all
660    Shape::draw .diagram.network [.player.scale get]
661    .diagram.network raise transient
662}
663
664proc test_view_change {} {
665    global view
666    foreach widget [pack slaves .diagram] {
667        catch {pack forget $widget}
668    }
669    pack .diagram.$view -expand yes -fill both
670}
671
672proc test_bids {} {
673    set info [Rappture::foreman::bids]
674    .client.bids.info delete 0 end
675    eval .client.bids.info insert end $info
676}
Note: See TracBrowser for help on using the repository browser.