Updated 2016-02-23 22:28:05 by escargo

by Theo Verelst

The image above shows it clearly: traffic lights as bwise blocks, which can be done by adding this proc to bwise:
 proc newtrafficl1 { {f {}} {name {}} {x {10}} {y {10}} } {
   if {$name == {}} {
       uplevel #0 {if {[info exists trafficlcount] == "0"} {set trafficlcount 0} ;}
      global trafficlcount
      incr trafficlcount
      set name Traffic$trafficlcount
   }
   set t [blockfunc $name]
   global mc $t;
   set $t {}

   newblock $name $x $y 30 82 in out
   blockclear $name

   set tr [$mc create oval [expr $x+3] [expr $y+3] [expr $x+30-3] [expr $y+3+24] -outline red -fill red -tags "$name newblock red"]
   set to [$mc create oval [expr $x+3] [expr $y+26+3] [expr $x+30-3] [expr $y+26+3+24] -outline orange -fill orange -tags "$name newblock orange"]
   set tg [$mc create oval [expr $x+3] [expr $y+52+3] [expr $x+30-3] [expr $y+52+3+24] -outline green -fill green -tags "$name newblock green"]

   eval "set f \{$mc itemco $tg -fill black ; $mc itemco $to -fill black ; $mc itemco $tr -fill black ;\}"
   eval "append f \{  switch \$\{$name.in\} orange {$mc itemco $to -fill orange} green {$mc itemco $tg -fill green} default {$mc itemco $tr -fill red} \} "
   if {$f == {}} {
      eval  "set f \{ set $name.out \$\{$name.in\} \}"
   }
   set $t $f

   return $name
 }

It generates a new block like most other new* routines, in this case a bit high, and with three colored rounds in it, and a block function which responds to the input pin of the block containing yellow, green or anything else to produce corresponding colors.

The whole above bwise graph can be made by sourcing:
 ### cantraffic1.tcl
 global bcount scopeindex wireindex shellindex drumindex entrycount moncount proccount seqcount stackcount termindex textcount
 set bcount 0
 set scopeindex 0
 set wireindex 4
 set shellindex 0
 set drumindex 0
 set entrycount 1
 set proccount 3
 .mw.c create rectangle 235.0 95.0 265.0 177.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill yellow -offset 0,0 -outline darkblue -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic11 newblock block} -width 1.0
 .mw.c create text 250.0 177.0 -activefill {} -activestipple {} -anchor n -disabledfill {} -disabledstipple {} -fill darkblue -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Traffic11 crb label} -text Traffic11 -width 0
 .mw.c create text 234.0 114.0 -activefill {} -activestipple {} -anchor se -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Traffic11 crb pinname in} -text in -width 0
 .mw.c create line 215.0 115.0 235.0 115.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Traffic11 newblock pin in typein} -width 2.0
 .mw.c create text 266.0 114.0 -activefill {} -activestipple {} -anchor sw -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Traffic11 crb pinname out} -text out -width 0
 .mw.c create line 285.0 115.0 265.0 115.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Traffic11 newblock pin out typeout} -width 2.0
 .mw.c create oval 238.0 98.0 262.0 122.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill red -offset 0,0 -outline red -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic11 newblock red} -width 1.0
 .mw.c create oval 238.0 124.0 262.0 148.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill black -offset 0,0 -outline orange -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic11 newblock orange} -width 1.0
 .mw.c create oval 238.0 150.0 262.0 174.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill black -offset 0,0 -outline green -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic11 newblock green} -width 1.0
 .mw.c create rectangle 333.0 96.0 363.0 178.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill yellow -offset 0,0 -outline darkblue -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic12 newblock block} -width 1.0
 .mw.c create text 348.0 178.0 -activefill {} -activestipple {} -anchor n -disabledfill {} -disabledstipple {} -fill darkblue -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Traffic12 crb label} -text Traffic12 -width 0
 .mw.c create text 332.0 115.0 -activefill {} -activestipple {} -anchor se -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Traffic12 crb pinname in} -text in -width 0
 .mw.c create line 313.0 116.0 333.0 116.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Traffic12 newblock pin in typein} -width 2.0
 .mw.c create text 364.0 115.0 -activefill {} -activestipple {} -anchor sw -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Traffic12 crb pinname out} -text out -width 0
 .mw.c create line 383.0 116.0 363.0 116.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Traffic12 newblock pin out typeout} -width 2.0
 .mw.c create oval 336.0 99.0 360.0 123.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill red -offset 0,0 -outline red -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic12 newblock red} -width 1.0
 .mw.c create oval 336.0 125.0 360.0 149.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill black -offset 0,0 -outline orange -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic12 newblock orange} -width 1.0
 .mw.c create oval 336.0 151.0 360.0 175.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill black -offset 0,0 -outline green -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Traffic12 newblock green} -width 1.0
 .mw.c create rectangle 149.0 25.0 189.0 70.0 -activedash {} -activefill {} -activeoutline {} -activeoutlinestipple {} -activestipple {} -activewidth 0.0 -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledoutline {} -disabledoutlinestipple {} -disabledstipple {} -disabledwidth 0 -fill yellow -offset 0,0 -outline darkblue -outlineoffset 0,0 -outlinestipple {} -state {} -stipple {} -tags {Proc3 newblock block} -width 1.0
 .mw.c create text 169.0 70.0 -activefill {} -activestipple {} -anchor n -disabledfill {} -disabledstipple {} -fill darkblue -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Proc3 crb label} -text Proc3 -width 0
 .mw.c create text 148.0 44.0 -activefill {} -activestipple {} -anchor se -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Proc3 crb pinname in} -text in -width 0
 .mw.c create line 129.0 45.0 149.0 45.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Proc3 newblock pin in typein} -width 2.0
 .mw.c create text 190.0 44.0 -activefill {} -activestipple {} -anchor sw -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Proc3 crb pinname t1} -text t1 -width 0
 .mw.c create line 209.0 45.0 189.0 45.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Proc3 newblock pin t1 typeout} -width 2.0
 .mw.c create text 190.0 59.0 -activefill {} -activestipple {} -anchor sw -disabledfill {} -disabledstipple {} -fill black -font {{MS Sans Serif} 8} -justify left -offset 0,0 -state {} -stipple {} -tags {Proc3 crb pinname t2} -text t2 -width 0
 .mw.c create line 209.0 60.0 189.0 60.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {Proc3 newblock pin t2 typeout} -width 2.0
 .mw.c create line 215.0 115.0 209.0 60.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {wire1 connect wire Traffic11 in Proc3 t2} -width 1.0
 .mw.c create line 313.0 116.0 209.0 45.0 -activedash {} -activefill {} -activestipple {} -activewidth 0.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill darkblue -dash {} -dashoffset 0 -disableddash {} -disabledfill {} -disabledstipple {} -disabledwidth 0.0 -joinstyle round -offset 0,0 -smooth 0 -splinesteps 12 -state {} -stipple {} -tags {wire2 connect wire Traffic12 in Proc3 t1} -width 1.0

 newentry 60 30 {} Entry1 27 25
 connect {} Entry1 out Proc3 in

 # now the block related variables\n
 set Traffic11.bfunc {.mw.c itemco [tag_and {Traffic11 red}] -fill black ; .mw.c itemco [tag_and {Traffic11 green}] -fill black ; .mw.c itemco [tag_and {Traffic11 orange}] -fill black ;  switch ${Traffic11.in} orange {.mw.c itemco [tag_and {Traffic11 orange}] -fill orange} green {.mw.c itemco [tag_and {Traffic11 green}] -fill green} default {.mw.c itemco [tag_and {Traffic11 red}] -fill red} }
 set Traffic11.bfunc_init {}
 set Traffic11.in {red}
 set Traffic11.out {}
 set Traffic12.bfunc {.mw.c itemco [tag_and {Traffic12 red}] -fill black ; .mw.c itemco [tag_and {Traffic12 green}] -fill black ; .mw.c itemco [tag_and {Traffic12 orange}] -fill black ;  switch ${Traffic12.in} orange {.mw.c itemco [tag_and {Traffic12 orange}] -fill orange} green {.mw.c itemco [tag_and {Traffic12 green}] -fill green} default {.mw.c itemco [tag_and {Traffic12 red}] -fill red} }
 set Traffic12.bfunc_init {}
 set Traffic12.in {red}
 set Traffic12.out {}
 set Entry1.bfunc {}
 set Entry1.bfunc_init {}
 set Entry1.out {1}
 set Proc3.bfunc {set Proc3.t1 [lindex $traf(${Proc3.in}) 0] ; set Proc3.t2 [lindex $traf(${Proc3.in}) 1] ;}
 set Proc3.bfunc_init {}
 set Proc3.in {1}
 set Proc3.t1 {red}
 set Proc3.t2 {red}
 array set traf {1 {red red} 2 {green red} 3 {orange red} 4 {red red} 5 {red green} 6 {red orange} }

Sourcing the above bwise file (a normal tcl script after bwise had been loaded) gives the diagram above. enter a number between 1 and 6 in the entry (and press return) to change the state of the system.

The array traf contains indexes 1 through 6 for each of which it contains a 2 element list containing the colors of the lights (see last line in the above source).

Im not sure array set is compatible with early tcl versions, which most of BWise itself should be, but I guess people can figure that out. The big fonts in the image are because I was working with a (cheap but nice) big 19" screen, which holds 1600x1200 pixels, so I got the system font blown up to get normal sized fonts. In bwise itself, this isn't an option at the moment, though it is possible to make I guess: all fonts and blocks bigger.

What's the challenge? Well, first to make and record patterns for the lights, and animate them (that's not hard with this setup: use after to change Entry1.out variable and then call net_funprop Entry and repeat that in the background). A bigger challenge is to sample the state of such a running set of traffic lights (or just one) let us say by taking a picture of the state every 10 seconds, and then estimate from those samples how fast the lights change from a number of those pictures, that's a good basis for understanding some relevant (and non-trivial) properties of sampling theory in practice for a simple example!

Oh, and apart from the 'state number' the whole thing above is sort of a function, which is good for the fosdem 2005 lecture about functional programming, possibly as illustration.