if 0 {[Richard Suchenwirth] 2003-04-12 - A Ferris Wheel is a large
structure found in entertainment parks, where "cars" are suspended on
axes that connect a pair of very big, slowly rotating wheels. Here is
another Tcltoy, a study in [canvas]
animation simulating a Ferris Wheel, vaguely inspired by the famous
landmark of Vienna. Start resp. stop it with the check button at bottom
right (which with a little phantasy can be taken as ticket office ;-)
Little blinking lights were added for sheer fun. Zoom in/out with 
left/right mouse button.

[http://mini.net/files/tkferris.jpg]
}
 package require Tk
 proc FerrisWheel {w xm ym r {cars 12}} {
    $w create oval [expr $xm-$r] [expr $ym-$r] [expr $xm+$r] [expr $ym+$r]\
        -width 4 -fill {} -tag wheel
    $w create oval [expr $xm-8] [expr $ym-8] [expr $xm+8] [expr $ym+8]\
        -fill black
    for {set d 0} {$d<360} {set d [expr {$d+360./$cars}]} {
        set rad [deg2rad $d]
        set x [expr {$xm+cos($rad)*$r}]
        set y [expr {$ym+sin($rad)*$r}]
        $w create line $xm $ym $x $y -tag "wheel spoke sx$d"
        set color [lpick {white yellow orange green purple}]
        $w create oval [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] \
            -fill $color -tags "wheel x$d lamp"
        car $w $x $y x$d
    }
    $w raise wheel
    set ybot [expr {$ym+$r*1.5}]
    $w create line [expr $xm-$r] $ybot $xm $ym [expr $xm+$r] $ybot \
        -fill grey30 -width 8 -tag frame
    after 100 animate $w
 }
 proc car {w x y tag} {
    $w create rect [expr {$x-10}] $y [expr {$x+10}] [expr {$y+20}] \
        -fill red -tag $tag
    $w create rect [expr {$x-8}] [expr {$y+3}] [expr {$x+8}] [expr {$y+10}] \
        -fill [$w cget -bg] -tag $tag
    $w create rect [expr {$x-3}] [expr {$y+3}] [expr {$x+3}] [expr {$y+18}] \
        -fill {} -width 2 -tag $tag    
 }
 proc deg2rad deg {expr {$deg * atan(1)*8/360}}
 proc lpick list {lindex $list [expr {int(rand()*[llength $list])}]}
 proc animate {w} {
    if $::go {
        foreach {x0 - xm ym} [$w coords [$w find withtag frame]] break
        set r [expr {$xm-$x0}]
        foreach spoke [$w find withtag spoke] {
            foreach {x0 y0 x y} [$w coords $spoke] break
            set th [expr {($x? atan2($y-$ym,$x-$xm) : 0.0)+0.0075}]
            set x1 [expr {$xm + cos($th) * $r}]
            set y1 [expr {$ym + sin($th) * $r}]
            $w coords $spoke $x0 $y0 $x1 $y1
            regexp {s([x[0-9.]+)} [$w gettags $spoke] -> id
            $w move $id [expr {$x1-$x}] [expr {$y1-$y}]
        }
    }
    set id [lpick [$w find withtag lamp]]
    set color [$w itemcget $id -fill]
    if {$color ne "black"} {
       $w itemconfigure $id -fill black
       after 250 [list $w itemconfigure $id -fill $color]
    }
    after 50 [list animate $w]
 }
 pack [canvas .c -width 200 -height 220 -bg lightblue] -fill both -expand 1
 FerrisWheel .c 100 100 85 15
 checkbutton .c.go -variable go -text ""
 set go 1
 .c create window 180 212 -window .c.go

 bind .c <1> {.c scale all 0 0 2 2}
 bind .c <3> {.c scale all 0 0 0.5 0.5}

----
[Category Animation] | [Arts and crafts of Tcl-Tk programming]