source: branches/nanovis2/p2p/test.tcl @ 3305

Last change on this file since 3305 was 3305, checked in by ldelgass, 11 years ago

sync with trunk
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) 2004-2012  HUBzero Foundation, LLC
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.