This is a simulation of a streetcrossing with traffic lights for all directions. ---- #: Ampel.tcl - HaJo Gurt - 2005-06-24 #: Street-crossing with traffic-lights # # See also: [Traffic lights] - http://wiki.tcl.tk/8410 # # Todo: # * Timer # * Lights for pedestrians # * Buttons for pedestrians # * Night-cycle, Detector/Button for cars # * Moving Cars #########1#########2#########3#########4#########5#########6#########7##### package require Tk proc Ampel {x y r id} { #: Draw a traffic-light #: Width 20 , Height 60, Center at yellow switch -- $r { "S" { set x1 [expr {$x-10}]; set x2 [expr {$x+10}] set y1 [expr {$y-30}]; set y2 [expr {$y+30}] } "N" { set x1 [expr {$x+10}]; set x2 [expr {$x-10}] set y1 [expr {$y+30}]; set y2 [expr {$y-30}] } "E" { set x1 [expr {$x-30}]; set x2 [expr {$x+30}] set y1 [expr {$y-10}]; set y2 [expr {$y+10}] } "W" { set x1 [expr {$x+30}]; set x2 [expr {$x-30}] set y1 [expr {$y+10}]; set y2 [expr {$y-10}] } } .c create rect $x1 $y1 $x2 $y2 -fill $::Box set x1 [expr {$x-9}]; set x2 [expr {$x+9}] set y1 [expr {$y-9}]; set y2 [expr {$y+9}] .c create oval $x1 $y1 $x2 $y2 -tags [list $id "Y" ] -fill $::Dark switch -- $r { "S" { set x1 [expr {$x- 9}]; set x2 [expr {$x+ 9}] set y1 [expr {$y-11}]; set y2 [expr {$y-29}] set x3 [expr {$x- 9}]; set x4 [expr {$x+ 9}] set y3 [expr {$y+11}]; set y4 [expr {$y+29}] } "N" { set x1 [expr {$x- 9}]; set x2 [expr {$x+ 9}] set y1 [expr {$y+11}]; set y2 [expr {$y+29}] set x3 [expr {$x- 9}]; set x4 [expr {$x+ 9}] set y3 [expr {$y-11}]; set y4 [expr {$y-29}] } "E" { set x1 [expr {$x-29}]; set x2 [expr {$x-11}] set y1 [expr {$y- 9}]; set y2 [expr {$y+ 9}] set x3 [expr {$x+29}]; set x4 [expr {$x+11}] set y3 [expr {$y+ 9}]; set y4 [expr {$y- 9}] } "W" { set x1 [expr {$x+29}]; set x2 [expr {$x+11}] set y1 [expr {$y+ 9}]; set y2 [expr {$y- 9}] set x3 [expr {$x-29}]; set x4 [expr {$x-11}] set y3 [expr {$y+ 9}]; set y4 [expr {$y- 9}] } } .c create oval $x1 $y1 $x2 $y2 -tags [list $id "R" ] -fill $::Dark .c create oval $x3 $y3 $x4 $y4 -tags [list $id "G" ] -fill $::Dark } proc Blink {} { #: Flashing yellow for every direction incr ::Phase if {$::Phase > 0} {set ::Phase -1 } .c itemconfig { A1 || A2 || A3 || A4 } -fill $::Dark if {$::Phase < 0 } { .c itemconfig "Y" -fill $::Yellow ;# all yellow lights on } } proc Cmd { {A A1} {S "-"} } { #: Process commands for a single traffic-light foreach C $S { set X "$A && $C" if { $C=="-" } { .c itemconfig $A -fill $::Dark } if { $C=="R" } { .c itemconfig $X -fill $::Red } if { $C=="Y" } { .c itemconfig $X -fill $::Yellow } if { $C=="G" } { .c itemconfig $X -fill $::Green } } } proc Next {} { #: Next step in daytime-cycle global Phase incr Phase set P [expr {$Phase%8}] #wm title . "$Phase : $P" ;# Debug if {$P==1 } { Cmd A1 "- R" ; Cmd A3 "- R" ; } if {$P==2 } { Cmd A1 "R" ; Cmd A3 "R"; Cmd A2 "- R Y"; Cmd A4 "- R Y"; } if {$P==3 } { Cmd A1 "R" ; Cmd A3 "R"; Cmd A2 "- G" ; Cmd A4 "- G" ; } if {$P==4 } { Cmd A1 "R" ; Cmd A3 "R"; Cmd A2 "- Y" ; Cmd A4 "- Y" ; } if {$P==5 } { Cmd A1 "R" ; Cmd A3 "R"; Cmd A2 "- R" ; Cmd A4 "- R" ; } if {$P==6 } { Cmd A1 "- R Y"; Cmd A3 "- R Y"; Cmd A2 "R" ; Cmd A4 "R" ; } if {$P==7 } { Cmd A1 "- G" ; Cmd A3 "- G" ; Cmd A2 "R" ; Cmd A4 "R" ; } if {$P==0 } { Cmd A1 "- Y" ; Cmd A3 "- Y" ; Cmd A2 "R" ; Cmd A4 "R" ; } if {$Phase >= 8} { set Phase 0 } } #########1#########2#########3#########4#########5#########6#########7##### #wm title . "Ampel" wm title . "Street-crossing with traffic-light" set canvas_width 400 set canvas_height 400 set a 0 set b 100 set c 300 set d 400 set Street grey66 set Paint grey99 set Corner grey88 set Box black set Dark grey33 set Red red set Yellow yellow ;# yellow2 gold set Green green3 ;# green3 "lime green" canvas .c -width $canvas_width -height $canvas_height -bg $Street # Corners: .c create rect $a $a $b $b -fill $Corner .c create rect $c $a $d $b -fill $Corner .c create rect $a $c $b $d -fill $Corner .c create rect $c $c $d $d -fill $Corner # Decorations: .c create line $b $b [expr {$b+100}] $b -fill $Paint ;# N .c create line [expr {$c-100}] $c $c $c -fill $Paint ;# S #.c create line $c $b $c [expr {$b+100}] -fill $Paint ;# E #.c create line $b [expr {$c-100}] $b $c -fill $Paint ;# W # Traffic-lights: Ampel [expr {$c+15}] [expr {$c+35}] S A1 ;# South Ampel [expr {$c+35}] [expr {$b-15}] E A2 ;# East Ampel [expr {$b-15}] [expr {$b-35}] N A3 ;# North Ampel [expr {$b-35}] [expr {$c+15}] W A4 ;# West set Phase 0 frame .f pack .c .f button .b0 -text "Blink" -command {Blink} button .b1 -text "Next" -command {Next} pack .b0 .b1 -in .f -side left ---- There are two cycles: the normal red/red+yellow/green/yellow (e.g. german style), and flashing yellow for all directions (e.g. out-of-order or nighttime). I had some trouble processing multiple tags, so this is likely not the most elegant solution. Same for the way of rotating the picture of the trafficlight... ---- [Category Toys]