Version 7 of Street-crossing with Traffic-Lights

Updated 2005-06-25 11:54:23

This is a simulation of a streetcrossing with traffic lights for all directions.


 #: Ampel.tcl - HaJo Gurt - 2005-06-25
 #: Street-crossing with traffic-lights
 #
 # See also: [Traffic lights] - http://wiki.tcl.tk/8410
 #
 # Todo:
 # * Lights for pedestrians
 # * Buttons for pedestrians
 # * Night-cycle, Detector/Button for cars
 # * Moving Cars, see:
 # ** "Car Racing in Tcl"    : http://wiki.tcl.tk/4364
 # ** "Braitenberg Vehicles" : http://wiki.tcl.tk/9047

 #########1#########2#########3#########4#########5#########6#########7#####

  package require Tk

  set Debug -1   ;# -1: Off / 0: Status in Window-Title / 1: Console-Log
  set Title "Streetcrossing with trafficlight"

  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
  }

 #########1#########2#########3#########4#########5#########6#########7#####

  proc every {ms body} {
  #: Repeating timer
    eval $body; after $ms [info level 0]
  }

  proc Check {} {
  #: Check if delay for next step is over
   #puts "$::Auto $::Time $::Mode"  ;# Debug

    if {$::Auto == 0} { return }

    incr ::Time -1
    if {$::Debug>=0} { wm title . "$::Mode - Phase: $::Phase  Time: $::Time"
    } else           { wm title . $::Title }

    if {$::Time <= 0} { Step }
  }

  proc Step {} {
  #: Go to next step of currently running TL-cycle
    if {$::Debug>=1} {puts "- $::Mode $::Select" }
    set ::Time 0
    switch -- $::Mode {
      "Slow"  { Mode1; return }
      "Fast"  { Mode2; return }
      default { Blink }
    }
  }

 #########1#########2#########3#########4#########5#########6#########7#####

  proc Cmd { {A A1} {L "-"} } {
  #: Process commands for a single traffic-light
    if {$::Debug>=1} { puts "$::Mode - #$::Phase T$::Time - Cmd: $A $L" }

    foreach C $L {
      set X "$A && $C"
      if {$C eq "-"} { .c itemconfig $A -fill $::Dark   }
      if {$C eq "R"} { .c itemconfig $X -fill $::Red    }
      if {$C eq "Y"} { .c itemconfig $X -fill $::Yellow }
      if {$C eq "G"} { .c itemconfig $X -fill $::Green  }
    }
  }

  proc Blink {} {
  #: "Mode0" : Flashing yellow for all directions
    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
      set ::Time 3
    } else {
      set ::Time 1
      set ::Mode $::Select  ;# safe for switching mode
    }
  }

  proc Mode1 {} {
  #: "Slow" mode: discreet states, same timing for all directions
    global Phase Time  Mode Select
    incr   Phase
    if {$Phase >= 8} { set Phase 0; set Mode $Select }  ;# safe time to switch mode
    set P [ expr {$Phase%8} ]
   #wm title . "$Phase : $P"   ;# Debug
    if {$::Debug>=1} { puts "Mode1: $P" }

    if {$P==1} { set Time  1; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- R"  ; Cmd A4 "- R"   } ;#
    if {$P==2} { set Time  3; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- R Y"; Cmd A4 "- R Y" }
    if {$P==3} { set Time 10; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- G"  ; Cmd A4 "- G"   }
    if {$P==4} { set Time  3; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- Y"  ; Cmd A4 "- Y"   }

    if {$P==5} { set Time  1; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- R"  ; Cmd A4 "- R"   } ;#
    if {$P==6} { set Time  3; Cmd A1 "- R Y"; Cmd A3 "- R Y"; Cmd A2 "- R"  ; Cmd A4 "- R"   }
    if {$P==7} { set Time 10; Cmd A1 "- G"  ; Cmd A3 "- G"  ; Cmd A2 "- R"  ; Cmd A4 "- R"   }
    if {$P==0} { set Time  3; Cmd A1 "- Y"  ; Cmd A3 "- Y"  ; Cmd A2 "- R"  ; Cmd A4 "- R"   }

    if {$::Debug>=0} { wm title . "$::Mode : Phase: $::Phase  Time: $::Time" }
  }

  proc Mode2 {} {  ;#
  #: "Fast" mode: overlapping R/Y-phases, shorter green for minor street
    global Phase Time  Mode Select
    incr Phase
    if {$Phase >= 6} { set Phase 0; set Mode $Select } ;# safe time to switch mode
    set P [ expr {$Phase%6} ]
    if {$::Debug>=1} { puts "Mode2: $P" }

    if {$P==1} { set Time  2; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- R Y"; Cmd A4 "- R Y" }
    if {$P==2} { set Time 10; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- G"  ; Cmd A4 "- G"   } ;# E-W long
    if {$P==3} { set Time  3; Cmd A1 "- R"  ; Cmd A3 "- R"  ; Cmd A2 "- Y"  ; Cmd A4 "- Y"   }

    if {$P==4} { set Time  2; Cmd A1 "- R Y"; Cmd A3 "- R Y"; Cmd A2 "- R"  ; Cmd A4 "- R"   }
    if {$P==5} { set Time  6; Cmd A1 "- G"  ; Cmd A3 "- G"  ; Cmd A2 "- R"  ; Cmd A4 "- R"   } ;# N-S short
    if {$P==0} { set Time  3; Cmd A1 "- Y"  ; Cmd A3 "- Y"  ; Cmd A2 "- R"  ; Cmd A4 "- R"   }

    if {$::Debug>=0} { wm title . "$::Mode : Phase: $::Phase  Time: $::Time" }
  }

 #########1#########2#########3#########4#########5#########6#########7#####

  wm title . $Title
  if {$::Debug>=1} { catch {console show} }

  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"

  set Auto  0
  set Phase 0
  set Time  0
  set Mode  "Blink"

  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

  frame .f
  pack  .c .f
  tk_optionMenu .opt Select "Blink" "Slow" "Fast"
  checkbutton   .cA -text "Automatic" -command {Step} -variable Auto
  button        .bS -text "Step"      -command {Step}
  pack          .opt .cA .bS  -in .f  -side left

  every 500 Check

Now that I added the timer for automatic operation, there are three modes: a flashing yellow for all directions (e.g. out-of-order or nighttime), and two different red/red+yellow/green/yellow (e.g. german style) modes named "slow" and "fast". Switching between these modes only happens after a complete cycle, e.g. when all lights are red. The "slow" mode has even timing for all directions, the "fast" mode has shorter green for the minor street (north-south on this crossing).

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