Toy cars

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! 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.

WikiDbImage 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}

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
 }

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
    }
 }

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
            }
        }
    }
 }

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 [namespace code [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]
 }

For rapid turnaround, the main part was coded so the script can be repeatedly sourced (by just hitting <Escape>) - 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 . <Up>  {incr g(dx) -10}
 bind . <Down> {if {$g(dx)} {incr g(dx)  10}}
 every 50 {
    animate .c
    .c raise y50; .c raise y100; .c raise y150; .c raise y200
 }

 bind . <Escape> {source $argv0}
 bind . <F1> {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.

Could you add a frog that the user controls to navigate the road? The frog would be place at the bottom of the screen, and the user would need to get the frog to the top of the screen, without getting run over.

Category Animation

Category Toys

Toys and Games

Arts and Crafts of Tcl-Tk Programming