if 0 {[Richard Suchenwirth] 2004-08-24 - Another fun project, which may
be interesting for children: an animated highway, on which cars and
trucks go east or west. Initially, all stand still (so the cars can be inspected)
- you can increase speed with <Up>, or decrease with <Down>. That's all
so far - comments welcome, as always!

[http://mini.net/files/toycars.gif]
}
 array unset g
 set g(#) 0
 set g(dx) 0
#-- convenience wrapper for car definitions: 
 proc define {name code} {set ::g($name) $code}
if 0 {Every vehicle is a set of [canvas] items, with coordinates and
colors. The dummy color "pink" will later be overridden by the color
wanted by the user. Here's a few car types (feel free to make them better):}
 define Sedan {
    poly 1 4 0 -17 34 -22 47 -37 95 -37 105 -22 130 -16 130 4 -fill pink
    poly 34 -22 45 -35 48 -33 40 -22 -fill white
    poly 52 -34 43 -20 70 -20 70 -34 -fill white -outline black
    poly 73 -20 73 -34 91 -33 95 -20 -fill white -outline black
    line 38 3 38 -21 40 -21
    line 71 3 71 -20
    line 94 -10 96 -20
    oval 10 -10 30 10 -fill white -outline black -width 6
    oval 93 -10 113 10 -fill white -outline black -width 6
 }
 define Police {
    poly 1 4 0 -17 34 -22 47 -37 95 -37 105 -22 130 -16 130 4 -fill white
    poly 34 -22 45 -35 48 -33 40 -22 -fill lightblue
    poly 52 -34 43 -20 70 -20 70 -34 -fill lightblue -outline black
    poly 73 -20 73 -34 91 -33 95 -20 -fill lightblue -outline black
    poly 38 3 38 -21 96 -20 90 3 -fill black
    rect 60 -44 66 -37 -fill red
    oval 10 -10 30 10 -fill white -outline black -width 6
    oval 93 -10 113 10 -fill white -outline black -width 6
 }
 define Station {
    poly 1 4 0 -17 34 -22 47 -37 118 -37 130 -16 130 4 -fill pink
    poly 34 -22 45 -35 48 -33 40 -22 -fill white
    poly 52 -34 43 -20 70 -20 70 -34 -fill white -outline black
    poly 73 -20 73 -34 91 -34 95 -20 -fill white -outline black
    poly 98 -20 94 -34 114 -34 120 -20 -fill white -outline black
    line 38 3 38 -21 40 -21
    line 71 3 71 -20
    oval 10 -10 30 10 -fill white -outline black -width 6
    oval 93 -10 113 10 -fill white -outline black -width 6
 }
 define Convertible {
    poly 1 4 0 -17 34 -22 47 -37 50 -37 47 -22 110 -22 130 -16 130 4 -fill pink
    poly 34 -22 45 -35 48 -33 40 -22 -fill white
    poly 80 -20 80 -25 105 -27 105 -20 -fill black
    oval 55 -32 65 -22 -fill orange
    line 38 3 38 -21 40 -21
    line 71 3 71 -20
    oval 10 -10 30 10 -fill white -outline black -width 6
    oval 93 -10 113 10 -fill white -outline black -width 6
 }
 define Truck {
    rect 0 2 120 -8 -fill black
    rect 0 -45 40 -2 -fill pink
    rect 0 -40 5 -25 -fill white
    rect 7 -40 25 -25 -fill white
    rect 50 -60 265 -13 -fill pink
    text 150 -33 -text "Tcl & Tk Deliver!" -font {Helvetica 18}
    oval 10 -10 30 10 -fill darkgrey -outline black -width 6
    oval 65 -10 85 10 -fill darkgrey -outline black -width 6
    oval 95 -10 115 10 -fill darkgrey -outline black -width 6
    rect 180 -11 260 2 -fill black 
    oval 190 -10 210 10 -fill darkgrey -outline black -width 6
    oval 225 -10 245 10 -fill darkgrey -outline black -width 6
 }
if 0 {The ''add'' proc adds, of course, a vehicle to the road. You
specify its position, type, color, and optionally the direction it goes,
east or west (which is the default).}
 proc add {w x y what args} {
    global g
    set tag t[incr g(#)]
    if [info exists g($what)] {
        foreach part [split $g($what) \n] {
            if {[llength $part]==0} continue
            set color [lindex $args 0]
            set id [eval $w create [string map "pink $color" $part] -tag $tag]
            $w move $id $x $y
        }
    } else {
        eval $w create $what $x $y $args -tag $tag
    }
    if [in $args east] {
        lappend g(east) $tag
        $w scale $tag $x $y -1 1
    } else {
        lappend g(west) $tag
    }
 }
if 0 {This procedure is called 20 times a second. It moves the cars by a
random amount, limited by the speed set by the user:}
 proc animate w {
    global g
    foreach car $g(west) {
        $w move $car [expr {$g(dx)*rand()}] 0
        if {[lindex [$w bbox $car] 2]<0} {$w move $car 2000 0}
    }
    foreach car $g(east) {
        $w move $car [expr {-$g(dx)*rand()}] 0
        if {[lindex [$w bbox $car] 0]>1000} {$w move $car -2000 0}
    }
 }
#-- General utilities:
 proc every {ms body} {eval $body; after $ms [info level 0]}
 proc in {list element} {expr {[lsearch -exact $list $element]>=0}}
 
if 0 {For rapid turnaround, the main part was coded so the script can be
repeatedly sourced - either the canvas is created; or it's cleared, and all
events flushed:}
 if [catch {
    pack [canvas .c -width 600] -fill both -expand 1
 }] {
    .c delete all
    foreach i [after info] {after cancel $i}
 }

 .c create rect 0 0 1000 30 -fill green4 ;# "north" meadow
 .c create line 0 120 1000 120 -fill yellow -width 3 ;# mid-road line
 .c create rect 0 210 1000 1000 -fill green3 ;# "south" meadow
#-- And here come the cars! 
 add .c 100 70   Truck lightblue
 add .c 1500 85  Sedan orange
 add .c 500 100  Police -
 add .c 100 150  Station magenta east
 add .c 500 170  Convertible red east
 add .c 1500 190 Truck bisque east

 bind . <Up>  {incr g(dx) -10}
 bind . <Down> {if {$g(dx)} {incr g(dx)  10}}
 every 50 {animate .c}
#-- Debugging helpers:
 bind . <Escape> {source $argv0}
 bind . <F1> {console show}


----
[AM] Maybe add random cars at random intervals? 
----
[Category Animation] | [Category Toys] | [Arts and crafts of Tcl-Tk programming]