[http://mini.net/files/traffic.jpg]

if 0 {[Richard Suchenwirth] 2003-02-19 - More than a month after we discussed it in the [Tcl chatroom], here comes a little traffic light simulator, which might interest children: both to play with a bit, and see how it was done, especially the "states" section below (state machines are child´s play!) - which models the behavior of German traffic lights.
    
Change phase by clicking on the button, or <Return>. Turning on the timer makes lights automatically change every second. Feel free to modify it! (In Austria I think they have a yellow+green phase between green and yellow ...)
    
As I wrote this on the [iPAQ], please pardon the [Regular Polygons] workaround.
On fully functional Tk, one may replace poly [[rp ..]] with oval .., and discard the rp proc.
    
[AM] A few remarks:
   * There are several Wiki pages that use traffic lights as an example.
   * If you combine this graphics with any of the other techniques, like the one in [Playing CLIPS] to add support for specific countries, this might be an amusing little subject for an educational project
}
----
 package require Tk
 proc rp {x0 y0 x1 y1 {n 0}} {
     set xm [expr {($x0+$x1)/2.}]
     set ym [expr {($y0+$y1)/2.}]
     set rx [expr {$xm-$x0}]
     set ry [expr {$ym-$y0}]
     if {$n==0} {set n [expr {round(($rx+$ry)*0.4)}] }
     set step [expr {atan(1)*8/$n}]
     set res ""
     set th [expr {atan(1)*6}] ;#top
     for {set i 0} {$i<$n} {incr i} {
         lappend res \
                 [expr {$xm+$rx*cos($th)}] \
                 [expr {$ym+$ry*sin($th)}]
         set th [expr {$th+$step}]
     }
     set res
 }
 proc light args {
     .c itemconfig light -fill black
     foreach i $args {.c itemconfig $i -fill $i}
 }
 proc next what {
     if $::timer {
         after 1000 $what
     } else {set ::next $what}
 }
 #------------------- the states:
 proc red {} {
     light red; next red+yellow
 }
 proc red+yellow {} {
     light red yellow; next green
 }
 proc green {} {
     light green; next yellow
 }
 proc yellow {} {
     light yellow; next red
 }
 #----------- Graphical User Interface:
 pack [canvas .c -width 120 -height 100]
 .c create rect 5 5 35 85 -fill gray20
 .c create poly [rp 10 10 30 30] -tags {red light}
 .c create poly [rp 10 35 30 55] -tags {yellow light}
 .c create poly [rp 10 60 30 80] -tags {green light}
 checkbutton .c.t -text Timer -variable timer
 set timer 0
 .c create window 50 50 -window .c.t -anchor w
 button .c.b -text Next -command {eval $next}
 .c create window 50 70 -window .c.b -anchor w
 bind . <Return> {eval $next}
 red ;# initial state
----
See also: [Street-crossing with Traffic-Lights]

----
[Arts and crafts of Tcl-Tk programming] - [Category Toys]