Version 4 of Traffic lights

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

Arts and crafts of Tcl-Tk programming - Category Toys