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 , or decrease with . That's all so far - comments welcome, as always! This '''revised version''' features several new patterns, including a motorbike rider, as well as collision control and best of all, random generation of new vehicles. [http://mini.net/files/toycars.gif] See [Toy car workshop] for a little tool to design new vehicles.} 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, or drawn at random. Here's a few car types (feel free to make them better):} define Sedan { poly 1 -6 0 -25 34 -29 47 -44 95 -44 105 -30 130 -27 128 -6 -fill pink -outline black poly 32 -29 45 -43 48 -42 40 -30 -fill white -outline black poly 52 -41 43 -28 70 -28 70 -41 -fill white -outline black poly 73 -28 73 -41 91 -41 95 -28 -fill white -outline black line 38 -7 38 -28 42 -28 line 71 -7 71 -30 line 96 -10 96 -30 rect 1 -22 4 -16 -fill white rect 123 -19 129 -14 -fill red oval 10 -18 28 0 -fill grey90 -outline black -width 4 oval 92 -18 110 0 -fill grey90 -outline black -width 4 } define Pickup { poly 2 -6 0 -27 3 -29 34 -29 47 -47 77 -47 79 -30 130 -30 130 -6 -fill pink -outline black poly 34 -30 45 -45 48 -43 40 -32 -fill white -outline black poly 52 -44 43 -30 70 -30 70 -44 -fill white -outline black line 38 -7 38 -31 40 -31 line 71 -7 71 -30 oval 10 -18 28 0 -fill pink -outline black -width 4 oval 95 -18 113 0 -fill pink -outline black -width 4 rect 0 -22 4 -15 -fill orange rect 126 -27 130 -15 -fill red } define Camper { poly 46 -47 33 -47 45 -66 136 -66 146 -61 146 -21 75 -21 -fill beige -outline black rect 49 -61 69 -55 -fill lightblue rect 96 -54 123 -38 -fill lightblue line 109 -53 109 -38 poly 2 -6 0 -27 3 -29 34 -29 47 -47 77 -47 77 -21 140 -21 140 -6 -fill pink -outline black poly 34 -30 45 -45 48 -43 40 -32 -fill lightblue -outline black poly 52 -44 43 -30 70 -30 70 -44 -fill lightblue -outline black line 38 -7 38 -31 40 -31 line 71 -7 71 -30 oval 10 -18 28 0 -fill white -outline black -width 4 oval 105 -18 123 0 -fill white -outline black -width 4 rect 0 -22 4 -15 -fill orange rect 136 -22 140 -15 -fill red } define Police { poly 1 -6 0 -27 34 -32 47 -47 95 -47 105 -32 130 -26 130 -6 -fill white poly 34 -32 45 -45 48 -43 40 -32 -fill lightblue poly 52 -44 43 -30 70 -30 70 -44 -fill lightblue -outline black poly 73 -30 73 -44 91 -43 95 -30 -fill lightblue -outline black poly 38 -7 38 -31 96 -30 90 -7 -fill black rect 60 -54 66 -47 -fill red oval 10 -18 28 0 -fill white -outline black -width 4 oval 93 -18 111 0 -fill white -outline black -width 4 } define Van { poly 1 -6 0 -27 34 -32 47 -47 118 -47 130 -26 130 -6 -fill pink poly 34 -32 45 -45 48 -43 40 -32 -fill white -outline black poly 52 -44 43 -30 70 -30 70 -44 -fill white -outline black poly 73 -30 73 -44 91 -44 95 -30 -fill white -outline black poly 98 -30 94 -44 114 -44 120 -30 -fill white -outline black line 38 -7 38 -31 40 -31 line 71 -7 71 -30 oval 10 -18 28 0 -fill white -outline black -width 4 oval 93 -18 111 0 -fill white -outline black -width 4 } define Ambulance { poly 1 -6 0 -27 34 -32 47 -47 118 -47 130 -26 130 -6 -fill white poly 34 -32 45 -45 48 -43 40 -32 -fill lightblue poly 52 -44 43 -30 70 -30 70 -44 -fill lightblue -outline red poly 73 -30 73 -44 91 -44 95 -30 -fill white -outline red poly 98 -30 94 -44 114 -44 120 -30 -fill white -outline red line 38 -7 38 -31 40 -31 line 71 -7 71 -30 poly 48 -22 52 -22 52 -26 58 -26 58 -22 62 -22 62 -18 58 -18 58 -14 52 -14 52 -18 48 -18 -fill red rect 59 -54 64 -47 -fill blue oval 10 -18 28 0 -fill red -outline black -width 4 oval 93 -18 111 0 -fill red -outline black -width 4 } define Convertible { poly 1 -6 0 -24 34 -28 47 -43 55 -41 47 -28 110 -28 130 -22 130 -6 -fill pink poly 34 -28 45 -41 50 -39 42 -28 -fill white poly 80 -26 80 -31 105 -33 105 -26 -fill black oval 58 -38 68 -28 -fill orange line 40 -7 40 -27 46 -27 line 73 -7 73 -28 oval 10 -18 28 0 -fill white -outline black -width 4 oval 93 -18 111 0 -fill white -outline black -width 4 } define Beetle { poly 0 -6 3 -8 6 -18 20 -26 33 -26 36 -27 44 -42 72 -42 82 -38 92 -27 104 -7 100 -6 -fill pink -outline black -smooth 1 line 12 -20 34 -28 36 -6 -smooth 1 line 68 -6 69 -21 97 -24 100 -6 -smooth 1 line 39 -26 39 -9 line 63 -39 63 -9 rect 2 -12 7 -7 -fill grey90 rect 38 -9 68 -6 -fill darkgrey rect 96 -18 99 -13 -fill red rect 99 -12 103 -7 -fill grey90 poly 40 -27 45 -35 50 -38 61 -38 61 -27 -fill lightblue -outline black poly 65 -27 65 -38 74 -37 78 -33 79 -30 77 -27 -fill lightblue -outline black oval 12 -16 28 0 -fill white -outline black -width 3 oval 76 -16 92 0 -fill white -outline black -width 3 } define Truck { rect 0 -18 120 -8 -fill black rect 0 -55 40 -12 -fill pink rect 0 -50 5 -35 -fill white rect 7 -50 25 -35 -fill white rect 50 -70 265 -23 -fill pink text 150 -43 -text "Tcl & Tk Deliver!" -font {Helvetica 18} oval 10 -20 30 0 -fill darkgrey -outline black -width 6 oval 65 -20 85 0 -fill darkgrey -outline black -width 6 oval 95 -20 115 0 -fill darkgrey -outline black -width 6 rect 180 -21 260 -8 -fill black oval 190 -20 210 0 -fill darkgrey -outline black -width 6 oval 225 -20 245 0 -fill darkgrey -outline black -width 6 } define Prototype1 { poly 0 -8 0 -13 18 -22 128 -22 131 -13 131 -9 115 -4 10 -4 -fill pink poly 48 -32 90 -31 98 -22 128 -22 127 -23 101 -23 91 -33 -fill pink -outline black poly 47 -31 30 -19 30 -7 67 -7 67 -31 -fill pink -outline grey poly 70 -7 93 -7 98 -22 90 -31 70 -31 -fill pink -outline grey poly 34 -22 67 -22 67 -30 47 -30 -fill black -outline grey poly 70 -22 98 -22 90 -30 70 -30 -fill black -outline grey poly 18 -22 32 -22 48 -31 -fill black -outline grey poly 102 -24 125 -24 94 -32 -fill black -outline grey poly 0 -8 0 -13 10 -13 10 -5 -fill grey -outline black poly 115 -5 131 -9 131 -13 115 -13 -fill grey -outline black oval 11 -18 29 0 -fill pink -outline black -width 5 oval 94 -18 112 0 -fill pink -outline black -width 5 } define Steamroller { oval 0 -30 30 0 -fill brown -width 2 line 15 -15 15 -35 -width 3 poly 10 -35 30 -35 39 -15 110 -15 110 -45 10 -45 -fill orange -outline red text 50 -37 -text ACME oval 65 -40 105 0 -fill brown -width 2 oval 83 -22 87 -18 -outline black line 71 -60 71 -44 line 102 -60 102 -44 rect 67 -65 107 -60 -fill brown oval 82 -55 91 -46 -fill bisque } define Motorbike { oval 10 -18 28 0 -outline black -width 3 oval 56 -18 74 0 -outline black -width 3 rect 22 -29 28 -24 -fill pink line 19 -9 32 -29 37 -27 -width 3 -fill grey90 line 36 -8 66 -9 52 -17 38 -9 -fill grey90 -width 3 poly 29 -19 31 -24 52 -20 53 -8 36 -8 -fill pink rect 44 -24 70 -20 -fill black oval 36 -53 49 -38 -fill pink rect 37 -48 40 -44 -fill black line 40 -5 44 -8 37 -19 52 -27 48 -40 37 -28 -width 7 -fill gray30 } 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(#)] 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 } $w addtag y$y withtag $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. When they drive out of sight, they are deleted, and a new random car is created at the other side of the viewport, so the road never gets empty: } proc animate w { global g foreach car $g(west) { foreach {x0 y0 x1 y1} [$w bbox $car] break set dx [expr {$g(dx)*(0.5+rand())}] set x2 [expr {$x0+$dx}] set ym [expr {($y0+$y1)/2.}] if {[$w find overlap $x2 $ym [expr {$x2-50}] $ym] eq ""} { $w move $car $dx 0 if {$x1 < 0} { $w delete $car lremove g(west) $car random'car $w 1000 $y1 } } } foreach car $g(east) { foreach {x0 y0 x1 y1} [$w bbox $car] break set dx [expr {-$g(dx)*(0.5+rand())}] set x2 [expr {$x1+$dx}] set ym [expr {($y0+$y1)/2.}] if {[$w find overlap $x2 $ym [expr {$x2+50}] $ym] eq ""} { $w move $car $dx 0 if {$x0 > 1000} { $w delete $car lremove g(east) $car random'car $w -200 $y1 } } } } if 0 {This routine picks one of the patterns that start with an uppercase letter (so if you want no Steamroller, just change its name to #Steamroller or such) with a random color: } proc random'car {w x y} { global g set type [lpick [array names g {[A-Z]*}]] set color [lpick { beige yellow orange red brown purple green blue magenta grey90 pink darkblue darkgreen white black cyan }] set direction [expr {$x>0? "west" : "east"}] set y [expr {($y/10)*10}] add $w $x $y $type $color $direction } #-- General utilities: proc every {ms body} {eval $body; after $ms [info level 0]} proc in {list element} {expr {[lsearch -exact $list $element]>=0}} proc lpick list {lindex $list [expr {int(rand()*[llength $list])}]} proc lremove {listVar element} { upvar 1 $listVar list set pos [lsearch $list $element] set list [lreplace $list $pos $pos] } if 0 {For rapid turnaround, the main part was coded so the script can be repeatedly sourced (by just hitting ) - 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 comes the initial set of vehicles add .c 1000 50 Steamroller orange add .c 100 50 Prototype1 lightblue add .c 500 100 Motorbike orange add .c 300 100 Police - add .c 300 150 Camper magenta east add .c 600 150 Beetle red east add .c 150 200 Truck bisque east add .c 1000 200 Sedan darkblue east bind . {incr g(dx) -10} bind . {if {$g(dx)} {incr g(dx) 10}} every 50 { animate .c .c raise y50; .c raise y100; .c raise y150; .c raise y200 } bind . {source $argv0} bind . {console show} ---- [AM] Maybe add random cars at random intervals? - [RS]: Done in this revised version. [SS] Very nice! - [RS]: See [HTC Magician] for the story of how I brought it to run under [Tclkit Mobile] 3. ---- [Category Animation] | [Category Toys] | [Arts and crafts of Tcl-Tk programming]