Added Keith Vetter's tkGoldberg as an animation demo. Thanks Keith!

1 files changed, 1734 insertions, 0 deletions

diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl
new file mode 100644
index 0000000..674217a
--- /dev/null
+++ b/library/demos/goldberg.tcl
@@ -0,0 +1,1734 @@
+##+#################################################################
+#
+# TkGoldberg.tcl
+# by Keith Vetter, March 13, 2003
+#
+# "Man will always find a difficult means to perform a simple task"
+# Rube Goldberg
+#
+# Reproduced here with permission.
+#
+##+#################################################################
+#
+# Keith Vetter 2003-03-21: this started out as a simple little program
+# but was so much fun that it grew and grew. So I apologize about the
+# size but I just couldn't resist sharing it.
+#
+# This is a whizzlet that does a Rube Goldberg type animation, the
+# design of which comes from an New Years e-card from IncrediMail.
+# That version had nice sound effects which I eschewed. On the other
+# hand, that version was in black and white (actually dark blue and
+# light blue) and this one is fully colorized.
+#
+# One thing I learned from this project is that drawing filled complex
+# objects on a canvas is really hard. More often than not I had to
+# draw each item twice--once with the desired fill color but no
+# outline, and once with no fill but with the outline. Another trick
+# is erasing by drawing with the background color. Having a flood fill
+# command would have been extremely helpful.
+#
+# Two wiki pages were extremely helpful: Drawing rounded rectangles
+# which I generalized into Drawing rounded polygons, and regular
+# polygons which allowed me to convert ovals and arcs into polygons
+# which could then be rotated (see Canvas Rotation). I also wrote
+# Named Colors to aid in the color selection.
+#
+# I could comment on the code, but it's just 26 state machines with
+# lots of canvas create and move calls.
+
+if 0 {
+if {![info exists widgetDemo]} {
+    error "This script should be run from the \"widget\" demo."
+}
+}
+
+set w .goldberg
+catch {destroy $w}
+toplevel $w
+wm title $w "Tk Goldberg (demonstration)"
+wm iconname $w "goldberg"
+wm resizable $w 0 0
+#positionWindow $w
+
+set font {Arial 10}
+label $w.msg -font $font -wraplength 4i -justify left -text "This is a demonstration of just how complex you can make your animations become. Click the ball to start things moving!\n\n\"Man will always find a difficult means to perform a simple task\"\n - Rube Goldberg"
+pack $w.msg -side top
+
+if 0 {
+## See Code / Dismiss buttons
+set btns [addSeeDismiss $w.buttons $w]
+pack $btns -side bottom -fill x
+}
+
+
+# Ensure that this this is an array
+array set animationCallbacks {}
+
+###--- End of Boilerplate ---###
+
+set S(title) "Tk Goldberg"
+set S(speed) 5
+set S(cnt) 0
+set S(message) "\\nWelcome\\nto\\nTcl/Tk"
+array set speed {1 10 2 20 3 50 4 80 5 100 6 150 7 200 8 300 9 400 10 500}
+
+set MSTART 0; set MGO 1; set MPAUSE 2; set MSSTEP 3; set MBSTEP 4; set MDONE 5
+set S(mode) $::MSTART
+
+# Colors for everything
+set C(fg) black
+set C(bg) gray75
+set C(bg) cornflowerblue
+
+set C(0) white;         set C(1a) darkgreen;   set C(1b) yellow
+set C(2) red;           set C(3a) green;       set C(3b) darkblue
+set C(4) $C(fg);        set C(5a) brown;       set C(5b) white
+set C(6) magenta;       set C(7) green;        set C(8) $C(fg)
+set C(9) blue4;         set C(10a) white;      set C(10b) cyan
+set C(11a) yellow;      set C(11b) mediumblue; set C(12) tan2
+set C(13a) yellow;      set C(13b) red;        set C(14) white
+set C(15a) green;       set C(15b) yellow;     set C(16) gray65
+set C(17) \#A65353;     set C(18) $C(fg);      set C(19) gray50
+set C(20) cyan;         set C(21) gray65;      set C(22) $C(20)
+set C(23a) blue;        set C(23b) red;        set C(23c) yellow
+set C(24a) red;         set C(24b) white;
+
+proc DoDisplay {} {
+    global S C w
+
+    frame $w.ctrl -relief ridge -bd 2 -padx 5 -pady 5
+    pack [frame $w.screen -bd 2 -relief raised] -side left -fill both -expand 1
+
+    canvas $w.c -width 860 -height 730 -bg $C(bg) -highlightthickness 0
+    $w.c config -scrollregion {0 0 1000 1000}	;# Kludge to move everything up
+    $w.c yview moveto .05
+    pack $w.c -in $w.screen -side top -fill both -expand 1
+
+    bind $w.c <3> [list $w.pause invoke]
+    bind $w.c <Destroy> {
+	after cancel $animationCallbacks(goldberg)
+	unset animationCallbacks(goldberg)
+    }
+    DoCtrlFrame
+    DoDetailFrame
+    button $w.show -text ">>" -command ShowCtrl -bg $C(bg) -activebackground $C(bg)
+    place $w.show -in $w.c -relx 1 -rely 0 -anchor ne
+    update
+}
+proc DoCtrlFrame {} {
+    global w
+    button $w.start -text "Start" -bd 6 -command {DoButton 0}
+    $w.start configure -font "[font actual [$w.start cget -font]] -weight bold"
+    set font [$w.start cget -font]
+    checkbutton $w.pause -text "Pause" -font $font \
+	    -command {DoButton 1} -variable S(pause) -relief raised
+    button $w.step -text "Single Step"   -font $font -command {DoButton 2}
+    button $w.bstep -text "Big Step"  -font $font -command {DoButton 4}
+    button $w.reset -text "Reset" -font $font -command {DoButton 3}
+    frame $w.details -bd 2 -relief ridge
+    checkbutton $w.detail -text "Details" -font $font -variable S(details)
+
+    entry $w.message -textvariable S(message) -justify center
+    scale $w.speed -orient h -from 1 -to 10 -font $font \
+	    -variable S(speed) -bd 2 -relief ridge -showvalue 0
+    button $w.about -text About -command About -font $font
+
+    grid $w.start -in $w.ctrl -row 0 -sticky ew
+    grid rowconfigure $w.ctrl 1 -minsize 10
+    grid $w.pause -in $w.ctrl -row 2 -sticky ew
+    grid $w.step  -in $w.ctrl -sticky ew
+    grid $w.bstep  -in $w.ctrl -sticky ew
+    grid $w.reset -in $w.ctrl -sticky ew
+    grid rowconfigure $w.ctrl 10 -minsize 20
+    grid $w.details -in $w.ctrl -row 11 -sticky ew
+    grid $w.detail -in $w.details -row 0 -sticky ew
+    grid rowconfigure $w.ctrl 50 -weight 1
+    trace variable ::S(mode) w ActiveGUI
+    trace variable ::S(details) w ActiveGUI
+    trace variable ::S(speed) w ActiveGUI
+
+    grid $w.message -in $w.ctrl -row 98 -sticky ew -pady 5
+    grid $w.speed -in $w.ctrl -row 99 -sticky ew
+    grid $w.about -in $w.ctrl -row 100 -sticky ew
+    bind $w.reset <3> {set S(mode) -1}            ;# Debugging
+}
+proc DoDetailFrame {} {
+    global w
+    set w2 $w.details.f
+    frame $w2
+
+    set bd 2
+    set rel solid
+    label $w2.l -textvariable S(cnt) -bd 1 -relief $rel -bg white
+    grid $w2.l - - - -sticky ew -row 0
+    for {set i 1} {1} {incr i} {
+        if {[info procs "Move$i"] == {}} break
+        label $w2.l$i -text $i -anchor e -width 2 -bd 1 -relief $rel -bg white
+        label $w2.ll$i -textvariable STEP($i) -width 5 -bd 1 -relief $rel -bg white
+        set row [expr {($i + 1) / 2}]
+        set col [expr {(($i + 1) & 1) * 2}]
+        grid $w2.l$i -sticky ew -row $row -column $col
+        grid $w2.ll$i -sticky ew -row $row -column [incr col]
+    }
+    grid columnconfigure $w2 1 -weight 1
+}
+# Map or unmap the ctrl window
+proc ShowCtrl {} {
+    global w
+    if {[winfo ismapped $w.ctrl]} {
+        pack forget $w.ctrl
+        $w.show config -text ">>"
+    } else {
+        pack $w.ctrl -side right -fill both -ipady 5
+        $w.show config -text "<<"
+    }
+}
+proc DrawAll {} {
+    global w
+    ResetStep
+    $w.c delete all
+    for {set i 0} {1} {incr i} {
+        set p "Draw$i"
+        if {[info procs $p] == {}} break
+        $p
+    }
+}
+proc ActiveGUI {var1 var2 op} {
+    global S w
+    array set z {0 disabled 1 normal}
+
+    set m $S(mode)
+    set S(pause) [expr {$m == 2}]
+    $w.start  config -state $z([expr {$m != $::MGO}])
+    $w.pause  config -state $z([expr {$m != $::MSTART && $m != $::MDONE}])
+    $w.step   config -state $z([expr {$m != $::MGO && $m != $::MDONE}])
+    $w.bstep  config -state $z([expr {$m != $::MGO && $m != $::MDONE}])
+    $w.reset  config -state $z([expr {$m != $::MSTART}])
+
+    if {$S(details)} {
+        grid $w.details.f -in $w.details -row 2 -sticky ew
+    } else {
+        grid forget $w.details.f
+    }
+    $w.speed config -label "Speed: $S(speed)"
+}
+proc Start {} {
+    global S
+    set S(mode) $::MGO
+}
+proc DoButton {what} {
+    global S
+
+    if {$what == 0} {                           ;# Start
+        if {$S(mode) == $::MDONE} Reset
+        set S(mode) $::MGO
+    } elseif {$what == 1} {                     ;# Pause
+        set S(mode) [expr {$S(pause) ? $::MPAUSE : $::MGO}]
+    } elseif {$what == 2} {                     ;# Step
+        set S(mode) $::MSSTEP
+    } elseif {$what == 3} {                     ;# Reset
+        Reset
+    } elseif {$what == 4} {                     ;# Big step
+        set S(mode) $::MBSTEP
+    }
+}
+proc Go {{who {}}} {
+    global S speed animationCallbacks
+
+    set now [clock clicks -milliseconds]
+    catch {after cancel $animationCallbacks(goldberg)}
+    if {$who != {}} {                           ;# Start here for debugging
+        set S(active) $who;
+        set S(mode) $::MGO
+    }
+    if {$S(mode) == -1} return                  ;# Debugging
+    set n 0
+    if {$S(mode) != $::MPAUSE} {                ;# Not paused
+        set n [NextStep]                        ;# Do the next move
+    }
+    if {$S(mode) == $::MSSTEP} {set S(mode) $::MPAUSE} ;# Single step
+    if {$S(mode) == $::MBSTEP && $n} {set S(mode) $::MSSTEP} ;# Big step
+
+    set elapsed [expr {[clock click -milliseconds] - $now}]
+    set delay [expr {$speed($S(speed)) - $elapsed}]
+    if {$delay <= 0} { set delay 1}
+    set animationCallbacks(goldberg) [after $delay Go]
+}
+# NextStep: drives the next step of the animation
+proc NextStep {} {
+    global S
+    set rval 0                                  ;# Return value
+
+    if {$S(mode) != $::MSTART && $S(mode) != $::MDONE} { incr S(cnt) }
+    set alive {}
+    foreach {who} $S(active) {
+        set n ["Move$who"]
+        if {$n & 1} {                           ;# This guy still alive
+            lappend alive $who
+        }
+        if {$n & 2} {                           ;# Next guy is active
+            lappend alive [expr {$who + 1}]
+            set rval 1
+        }
+        if {$n & 4} {                           ;# End of puzzle flag
+            set S(mode) $::MDONE                ;# Done mode
+            set S(active) {}                    ;# No more animation
+            return 1
+        }
+    }
+    set S(active) $alive
+    return $rval
+}
+proc About {} {
+    set msg "$::S(title)\nby Keith Vetter, March 2003\n(Reproduced by kind permission of the author)\n\n"
+    append msg "Man will always find a difficult means to perform a simple task"
+    append msg "\nRube Goldberg"
+    tk_messageBox -message $msg -title About
+}
+################################################################
+#
+# All the drawing and moving routines
+#
+
+# START HERE! banner
+proc Draw0 {} {
+    global w
+    set color $::C(0)
+    set xy {579 119}
+    $w.c create text $xy -text "START HERE!" -fill $color -anchor w \
+	    -tag I0 -font {{Times Roman} 12 italic bold}
+    set xy {719 119 763 119}
+    $w.c create line $xy -tag I0 -fill $color -width 5 -arrow last \
+	    -arrowshape {18 18 5}
+    $w.c bind I0 <1> Start
+}
+proc Move0 {{step {}}} {
+    set step [GetStep 0 $step]
+
+    if {$::S(mode) > $::MSTART} {               ;# Start the ball rolling
+        MoveAbs I0 {-100 -100}                  ;# Hide the banner
+        return 2
+    }
+
+    set pos {
+	{673 119} {678 119} {683 119} {688 119}
+	{693 119} {688 119} {683 119} {678 119}
+    }
+    set step [expr {$step % [llength $pos]}]
+    MoveAbs I0 [lindex $pos $step]
+    return 1
+}
+# Dropping ball
+proc Draw1 {} {
+    global w
+    set color $::C(1a)
+    set color2 $::C(1b)
+    set xy {844 133 800 133 800 346 820 346 820 168 844 168 844 133}
+    $w.c create poly $xy -width 3 -fill $color -outline {}
+    set xy {771 133 685 133 685 168 751 168 751 346 771 346 771 133}
+    $w.c create poly $xy -width 3 -fill $color -outline {}
+
+    set xy [box 812 122 9]
+    $w.c create oval $xy -tag I1 -fill $color2 -outline {}
+    $w.c bind I1 <1> Start
+}
+proc Move1 {{step {}}} {
+    set step [GetStep 1 $step]
+    set pos {
+	{807 122} {802 122} {797 123} {793 124} {789 129} {785 153}
+        {785 203} {785 278 x} {785 367} {810 392} {816 438} {821 503}
+        {824 585 y} {838 587} {848 593} {857 601} {-100 -100}
+    }
+    if {$step >= [llength $pos]} {
+	return 0
+    }
+    set where [lindex $pos $step]
+    MoveAbs I1 $where
+
+    if {[lindex $where 2] == "y"} {
+	Move15a
+    }
+    if {[lindex $where 2] == "x"} {
+	return 3
+    }
+    return 1
+}
+# Lighting the match
+proc Draw2 {} {
+    global w
+    set color red
+    set color $::C(2)
+    set xy  {750 369 740 392 760 392}           ;# Fulcrum
+    $w.c create poly $xy -fill $::C(fg) -outline $::C(fg)
+    set xy {628 335 660 383}                    ;# Strike box
+    $w.c create rect $xy -fill {} -outline $::C(fg)
+    for {set y 0} {$y < 3} {incr y} {
+        set yy [expr {335+$y*16}]
+        $w.c create bitmap 628 $yy -bitmap gray25 -anchor nw -foreground $::C(fg)
+        $w.c create bitmap 644 $yy -bitmap gray25 -anchor nw -foreground $::C(fg)
+    }
+
+    set xy {702 366 798 366}                    ;# Lever
+    $w.c create line $xy -fill $::C(fg) -width 6 -tag I2_0
+    set xy {712 363 712 355}                    ;# R strap
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I2_1
+    set xy {705 363 705 355}                    ;# L strap
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I2_2
+    set xy {679 356 679 360 717 360 717 356 679 356} ;# Match stick
+    $w.c create line $xy -fill $::C(fg) -tag I2_3
+
+    #set xy {662 352 680 365}                   ;# Match head
+    set xy {
+	671 352 677.4 353.9 680 358.5 677.4 363.1 671 365 664.6 363.1
+        662 358.5 664.6 353.9
+    }
+    $w.c create poly $xy -fill $color -outline $color -tag I2_4
+}
+proc Move2 {{step {}}} {
+    global w
+    set step [GetStep 2 $step]
+
+    set stages {0 0 1 2 0 2 1 0 1 2 0 2 1}
+    set xy(0) {
+	686 333 692 323 682 316 674 309 671 295 668 307 662 318 662 328
+	671 336
+    }
+    set xy(1) {687 331 698 322 703 295 680 320 668 297 663 311 661 327 671 335}
+    set xy(2) {
+	686 331 704 322 688 300 678 283 678 283 674 298 666 309 660 324
+	672 336
+    }
+
+    if {$step >= [llength $stages]} {
+	$w.c delete I2
+	return 0
+    }
+
+    if {$step == 0} {                           ;# Rotate the match
+        set beta 20
+        foreach {Ox Oy} [Anchor I2_0 s] break   ;# Where to pivot
+        for {set i 0} {[$w.c find withtag I2_$i] != {}} {incr i} {
+            RotateItem I2_$i $Ox $Oy $beta
+        }
+        $w.c create poly -tag I2 -smooth 1 -fill $::C(2) ;# For the flame
+        return 1
+    }
+    $w.c coords I2 $xy([lindex $stages $step])
+    return [expr {$step == 7 ? 3 : 1}]
+}
+# Weight and pulleys
+proc Draw3 {} {
+    global w
+    set color $::C(3a)
+    set color2 $::C(3b)
+
+    set xy {602 296 577 174 518 174}
+    foreach {x y} $xy {                         ;# 3 Pulleys
+        $w.c create oval [box $x $y 13] -fill $color -outline $::C(fg) -width 3
+        $w.c create oval [box $x $y 2] -fill $::C(fg) -outline $::C(fg)
+    }
+
+    set xy {750 309 670 309}                    ;# Wall to flame
+    $w.c create line $xy -tag I3_s -width 3 -fill $::C(fg) -smooth 1
+    set xy {670 309 650 309}                    ;# Flame to pulley 1
+    $w.c create line $xy -tag I3_0 -width 3 -fill $::C(fg)
+    set xy {650 309 600 309}                    ;# Flame to pulley 1
+    $w.c create line $xy -tag I3_1 -width 3 -fill $::C(fg)
+    set xy {589 296 589 235}                    ;# Pulley 1 half way to 2
+    $w.c create line $xy -tag I3_2 -width 3 -fill $::C(fg)
+    set xy {589 235 589 174}                    ;# Pulley 1 other half to 2
+    $w.c create line $xy -width 3 -fill $::C(fg)
+    set xy {577 161 518 161}                    ;# Across the top
+    $w.c create line $xy -width 3 -fill $::C(fg)
+    set xy {505 174 505 205}                    ;# Down to weight
+    $w.c create line $xy -tag I3_w -width 3 -fill $::C(fg)
+
+    # Draw the weight as 2 circles, two rectangles and 1 rounded rectangle
+    set xy {515 207 495 207}
+    foreach {x1 y1 x2 y2} $xy {
+        $w.c create oval [box $x1 $y1 6] -tag I3_ -fill $color2 -outline $color2
+        $w.c create oval [box $x2 $y2 6] -tag I3_ -fill $color2 -outline $color2
+        incr y1 -6; incr y2 6
+        $w.c create rect $x1 $y1 $x2 $y2 -tag I3_ -fill $color2 -outline $color2
+    }
+    set xy {492 220 518 263}
+    set xy [RoundRect $xy 15]
+    $w.c create poly $xy -smooth 1 -tag I3_ -fill $color2 -outline $color2
+    set xy {500 217 511 217}
+    $w.c create line $xy -tag I3_ -fill $color2 -width 10
+
+    set xy {502 393 522 393 522 465}            ;# Bottom weight target
+    $w.c create line $xy -tag I3__ -fill $::C(fg) -join miter -width 10
+}
+proc Move3 {{step {}}} {
+    global w
+    set step [GetStep 3 $step]
+
+    set pos {{505 247} {505 297} {505 386.5} {505 386.5}}
+    set rope(0) {750 309 729 301 711 324 690 300}
+    set rope(1) {750 309 737 292 736 335 717 315 712 320}
+    set rope(2) {750 309 737 309 740 343 736 351 725 340}
+    set rope(3) {750 309 738 321 746 345 742 356}
+
+    if {$step >= [llength $pos]} {return 0}
+
+    $w.c delete "I3_$step"                        ;# Delete part of the rope
+    MoveAbs I3_ [lindex $pos $step]             ;# Move weight down
+    $w.c coords I3_s $rope($step)                 ;# Flapping rope end
+    $w.c coords I3_w [concat 505 174 [lindex $pos $step]]
+    if {$step == 2} {
+        $w.c move I3__ 0 30
+        return 2
+    }
+    return 1
+}
+# Cage and door
+proc Draw4 {} {
+    global w
+    set color $::C(4)
+    set xy {527 356 611 464}
+    foreach {x0 y0 x1 y1} $xy break
+
+    for {set y $y0} {$y <= $y1} {incr y 12} {   ;# Horizontal bars
+        $w.c create line $x0 $y $x1 $y -fill $color -width 1
+    }
+    for {set x $x0} {$x <= $x1} {incr x 12} {   ;# Vertical bars
+        $w.c create line $x $y0 $x $y1 -fill $color -width 1
+    }
+
+    set xy {518 464 518 428}                    ;# Swing gate
+    $w.c create line $xy -tag I4 -fill $color -width 3
+}
+proc Move4 {{step {}}} {
+    global w
+    set step [GetStep 4 $step]
+
+    set angles {-10 -20 -30 -30}
+    if {$step >= [llength $angles]} {return 0}
+    RotateItem I4 518 464 [lindex $angles $step]
+    $w.c raise I4
+    return [expr {$step == 3 ? 3 : 1}]
+}
+# Mouse
+proc Draw5 {} {
+    global w
+    set color $::C(5a)
+    set color2 $::C(5b)
+    set xy {377 248 410 248 410 465 518 465}    ;# Mouse course
+    lappend xy 518 428 451 428 451 212 377 212
+    $w.c create poly $xy -fill $color2 -outline $::C(fg) -width 3
+
+    set xy {
+	534.5 445.5 541 440 552 436 560 436 569 440 574 446 575 452 574 454
+	566 456 554 456 545 456 537 454 530 452
+    }
+    $w.c create poly $xy -tag {I5 I5_0} -fill $color
+    set xy {573 452 592 458 601 460 613 456}    ;# Tail
+    $w.c create line $xy -tag {I5 I5_1} -fill $color -smooth 1 -width 3
+    set xy [box 540 446 2]                      ;# Eye
+    set xy {540 444 541 445 541 447 540 448 538 447 538 445}
+    #.c create oval $xy -tag {I5 I5_2} -fill $::C(bg) -outline {}
+    $w.c create poly $xy -tag {I5 I5_2} -fill $::C(bg) -outline {} -smooth 1
+    set xy {538 454 535 461}                    ;# Front leg
+    $w.c create line $xy -tag {I5 I5_3} -fill $color -width 2
+    set xy {566 455 569 462}                    ;# Back leg
+    $w.c create line $xy -tag {I5 I5_4} -fill $color -width 2
+    set xy {544 455 545 460}                    ;# 2nd front leg
+    $w.c create line $xy -tag {I5 I5_5} -fill $color -width 2
+    set xy {560 455 558 460}                    ;# 2nd back leg
+    $w.c create line $xy -tag {I5 I5_6}  -fill $color -width 2
+}
+proc Move5 {{step {}}} {
+    set step [GetStep 5 $step]
+
+    set pos {
+	{553 452} {533 452} {513 452} {493 452} {473 452}
+        {463 442 30} {445.5 441.5 30} {425.5 434.5 30} {422 414} {422 394}
+        {422 374} {422 354} {422 334} {422 314} {422 294}
+        {422 274 -30} {422 260.5 -30 x} {422.5 248.5 -28} {425 237}
+    }
+    if {$step >= [llength $pos]} {
+	return 0
+    }
+
+    foreach {x y beta next} [lindex $pos $step] break
+    MoveAbs I5 [list $x $y]
+    if {$beta != {}} {
+        foreach {Ox Oy} [Centroid I5_0] break
+        foreach id {0 1 2 3 4 5 6} {
+            RotateItem I5_$id $Ox $Oy $beta
+        }
+    }
+    if {$next == "x"} {return 3}
+    return 1
+}
+# Dropping gumballs
+array set XY6 {
+    -1 {366 207} -2 {349 204} -3 {359 193} -4 {375 192} -5 {340 190}
+    -6 {349 177} -7 {366 177} -8 {380 176} -9 {332 172} -10 {342 161}
+    -11 {357 164} -12 {372 163} -13 {381 149} -14 {364 151} -15 {349 146}
+    -16 {333 148} 0 {357 219}
+    1 {359 261} 2 {359 291} 3 {359 318}  4 {361 324}  5 {365 329}  6 {367 334}
+    7 {367 340} 8 {366 346} 9 {364 350} 10 {361 355} 11 {359 370} 12 {359 391}
+    13,0 {360 456}  13,1 {376 456}  13,2 {346 456}  13,3 {330 456}
+    13,4 {353 444}  13,5 {368 443}  13,6 {339 442}  13,7 {359 431}
+    13,8 {380 437}  13,9 {345 428}  13,10 {328 434} 13,11 {373 424}
+    13,12 {331 420} 13,13 {360 417} 13,14 {345 412} 13,15 {376 410}
+    13,16 {360 403}
+}
+
+proc Draw6 {} {
+    global w
+    set color $::C(6)
+    set xy {324 130 391 204}                    ;# Ball holder
+    set xy [RoundRect $xy 10]
+    $w.c create poly $xy -smooth 1 -outline $::C(fg) -width 3 -fill $color
+    set xy {339 204 376 253}                    ;# Below the ball holder
+    $w.c create rect $xy -fill {} -outline $::C(fg) -width 3 -fill $color -tag I6c
+    set xy [box 346 339 28]
+    $w.c create oval $xy -fill $color -outline {} ;# Rotor
+    $w.c create arc $xy -outline $::C(fg) -width 2 -style arc \
+	    -start 80 -extent 205
+    $w.c create arc $xy -outline $::C(fg) -width 2 -style arc \
+	    -start -41 -extent 85
+
+    set xy [box 346 339 15]                     ;# Center of rotor
+    $w.c create oval $xy -outline $::C(fg) -fill $::C(fg) -tag I6m
+    set xy {352 312 352 254 368 254 368 322}    ;# Top drop to rotor
+    $w.c create poly $xy -fill $color -outline {}
+    $w.c create line $xy -fill $::C(fg) -width 2
+
+    set xy {353 240 367 300}                    ;# Poke bottom hole
+    $w.c create rect $xy -fill $color -outline {}
+    set xy {341 190 375 210}                    ;# Poke another hole
+    $w.c create rect $xy -fill $color -outline {}
+
+    set xy {368 356 368 403 389 403 389 464 320 464 320 403 352 403 352 366}
+    $w.c create poly $xy -fill $color -outline {} -width 2 ;# Below rotor
+    $w.c create line $xy -fill $::C(fg) -width 2
+    set xy [box 275 342 7]                      ;# On/off rotor
+    $w.c create oval $xy -outline $::C(fg) -fill $::C(fg)
+    set xy {276 334 342 325}                    ;# Fan belt top
+    $w.c create line $xy -fill $::C(fg) -width 3
+    set xy {276 349 342 353}                    ;# Fan belt bottom
+    $w.c create line $xy -fill $::C(fg) -width 3
+
+    set xy {337 212 337 247}                    ;# What the mouse pushes
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I6_
+    set xy {392 212 392 247}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I6_
+    set xy {337 230 392 230}
+    $w.c create line $xy -fill $::C(fg) -width 7 -tag I6_
+
+    set who -1                                  ;# All the balls
+    set colors {red cyan orange green blue darkblue}
+    eval lappend colors $colors $colors
+
+    for {set i 0} {$i < 17} {incr i} {
+        set loc [expr {-1 * $i}]
+        set color [lindex $colors $i]
+        $w.c create oval [eval box $::XY6($loc) 5] -fill $color \
+		-outline $color -tag I6_b$i
+    }
+    Draw6a 12                                   ;# The wheel
+}
+proc Draw6a {beta} {
+    global w
+    $w.c delete I6_0
+    foreach {Ox Oy} {346 339} break
+    for {set i 0} {$i < 4} {incr i} {
+        set b [expr {$beta + $i * 45}]
+        foreach {x y} [RotateC 28 0 0 0 $b] break
+        set xy [list [expr {$Ox+$x}] [expr {$Oy+$y}] \
+		[expr {$Ox-$x}] [expr {$Oy-$y}]]
+        $w.c create line $xy -tag I6_0 -fill $::C(fg) -width 2
+    }
+}
+proc Move6 {{step {}}} {
+    global w
+    set step [GetStep 6 $step]
+    if {$step > 62} {return 0}
+
+    if {$step < 2} {                            ;# Open gate for balls to drop
+        $w.c move I6_ -7 0
+        if {$step == 1} {                       ;# Poke a hole
+            set xy {348 226 365 240}
+            $w.c create rect $xy -fill [$w.c itemcget I6c -fill] -outline {}
+        }
+        return 1
+    }
+
+    set s [expr {$step - 1}]                    ;# Do the gumball drop dance
+    for {set i 0} {$i <= int(($s-1) / 3)} {incr i} {
+        set tag "I6_b$i"
+        if {[$w.c find withtag $tag] == {}} break
+        set loc [expr {$s - 3 * $i}]
+
+        if {[info exists ::XY6($loc,$i)]} {
+            MoveAbs $tag $::XY6($loc,$i)
+        } elseif {[info exists ::XY6($loc)]} {
+            MoveAbs $tag $::XY6($loc)
+        }
+    }
+    if {($s % 3) == 1} {
+        set first [expr {($s + 2) / 3}]
+        for {set i $first} {1} {incr i} {
+            set tag "I6_b$i"
+            if {[$w.c find withtag $tag] == {}} break
+            set loc [expr {$first - $i}]
+            MoveAbs $tag $::XY6($loc)
+        }
+    }
+    if {$s >= 3} {                              ;# Rotate the motor
+        set idx [expr {$s % 3}]
+        #Draw6a [lindex {12 35 64} $idx]
+        Draw6a [expr {12 + $s * 15}]
+    }
+    return [expr {$s == 3 ? 3 : 1}]
+}
+# On/off switch
+proc Draw7 {} {
+    global w
+    set color $::C(7)
+    set xy {198 306 277 374}                    ;# Box
+    $w.c create rect $xy -outline $::C(fg) -width 2 -fill $color -tag I7z
+    $w.c lower I7z
+    set xy {275 343 230 349}
+    $w.c create line $xy -tag I7 -fill $::C(fg) -arrow last \
+	    -arrowshape {23 23 8} -width 6
+    set xy {225 324}                            ;# On button
+    $w.c create oval [eval box $xy 3] -fill $::C(fg) -outline $::C(fg)
+    set xy {218 323}                            ;# On text
+    set font {{Times Roman} 8}
+    $w.c create text $xy -text "on" -anchor e -fill $::C(fg) -font $font
+    set xy {225 350}                            ;# Off button
+    $w.c create oval [eval box $xy 3] -fill $::C(fg) -outline $::C(fg)
+    set xy {218 349}                            ;# Off button
+    $w.c create text $xy -text "off" -anchor e -fill $::C(fg) -font $font
+}
+proc Move7 {{step {}}} {
+    set step [GetStep 7 $step]
+    set numsteps 30
+    if {$step > $numsteps} {return 0}
+    set beta [expr {30.0 / $numsteps}]
+    RotateItem I7 275 343 $beta
+
+    return [expr {$step == $numsteps ? 3 : 1}]
+}
+# Electricity to the fan
+proc Draw8 {} {
+    Sine 271 248 271 306 5 8 -tag I8_s -fill $::C(8) -width 3
+}
+proc Move8 {{step {}}} {
+    global w
+    set step [GetStep 8 $step]
+
+    if {$step > 3} {return 0}
+    if {$step == 0} {
+        Sparkle [Anchor I8_s s] I8
+        return 1
+
+    } elseif {$step == 1} {
+        MoveAbs I8 [Anchor I8_s c]
+    } elseif {$step == 2} {
+        MoveAbs I8 [Anchor I8_s n]
+    } else {
+        $w.c delete I8
+    }
+    return [expr {$step == 2 ? 3 : 1}]
+}
+# Fan
+proc Draw9 {} {
+    global w
+    set color $::C(9)
+    set xy {266 194 310 220}
+    $w.c create oval $xy -outline $color -fill $color
+    set xy {280 209 296 248}
+    $w.c create oval $xy -outline $color -fill $color
+    set xy {288 249 252 249 260 240 280 234 296 234 316 240 324 249 288 249}
+    $w.c create poly $xy -fill $color -smooth 1
+
+    set xy {248 205 265 214 264 205 265 196}    ;# Spinner
+    $w.c create poly $xy -fill $color
+
+    set xy {255 206 265 234}                    ;# Fan blades
+    $w.c create oval $xy -fill {} -outline $::C(fg) -width 3 -tag I9_0
+    set xy {255 176 265 204}
+    $w.c create oval $xy -fill {} -outline $::C(fg) -width 3 -tag I9_0
+    set xy {255 206 265 220}
+    $w.c create oval $xy -fill {} -outline $::C(fg) -width 1 -tag I9_1
+    set xy {255 190 265 204}
+    $w.c create oval $xy -fill {} -outline $::C(fg) -width 1 -tag I9_1
+}
+proc Move9 {{step {}}} {
+    global w
+    set step [GetStep 9 $step]
+
+    if {$step & 1} {
+        $w.c itemconfig I9_0 -width 4
+        $w.c itemconfig I9_1 -width 1
+        $w.c lower I9_1 I9_0
+    } else {
+        $w.c itemconfig I9_0 -width 1
+        $w.c itemconfig I9_1 -width 4
+        $w.c lower I9_0 I9_1
+    }
+    if {$step == 0} {return 3}
+    return 1
+}
+# Boat
+proc Draw10 {} {
+    global w
+    set color $::C(10a)
+    set color2 $::C(10b)
+    set xy {191 230 233 230 233 178 191 178}    ;# Sail
+    $w.c create poly $xy -fill $color -width 3 -outline $::C(fg) -tag I10
+    set xy [box 209 204 31]                     ;# Front
+    $w.c create arc $xy -outline {} -fill $color -style pie \
+	    -start 120 -extent 120 -tag I10
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
+	    -start 120 -extent 120 -tag I10
+    set xy [box 249 204 31]                     ;# Back
+    $w.c create arc $xy -outline {} -fill $::C(bg) -width 3 -style pie \
+	    -start 120 -extent 120 -tag I10
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
+	    -start 120 -extent 120 -tag I10
+
+    set xy {200 171 200 249}                    ;# Mast
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I10
+    set xy {159 234 182 234}                    ;# Bow sprit
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I10
+    set xy {180 234 180 251 220 251}            ;# Hull
+    $w.c create line $xy -fill $::C(fg) -width 6 -tag I10
+
+    set xy {92 255 221 255}                     ;# Waves
+    eval Sine $xy 2 25 -fill $color2 -width 1 -tag I10w
+
+    set xy [lrange [$w.c coords I10w] 4 end-4]    ;# Water
+    set xy [concat $xy 222 266 222 277 99 277]
+    $w.c create poly $xy -fill $color2 -outline $color2
+    set xy {222 266 222 277 97 277 97 266}      ;# Water bottom
+    $w.c create line $xy -fill $::C(fg) -width 3
+
+    set xy [box 239 262 17]
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
+	    -start 95 -extent 103
+    set xy [box 76 266 21]
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc -extent 190
+}
+proc Move10 {{step {}}} {
+    set step [GetStep 10 $step]
+    set pos {
+	{195 212} {193 212} {190 212} {186 212} {181 212} {176 212}
+        {171 212} {166 212} {161 212} {156 212} {151 212} {147 212} {142 212}
+        {137 212} {132 212 x} {127 212} {121 212} {116 212} {111 212}
+    }
+
+    if {$step >= [llength $pos]} {return 0}
+    set where [lindex $pos $step]
+    MoveAbs I10 $where
+
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+# 2nd ball drop
+proc Draw11 {} {
+    global w
+    set color $::C(11a)
+    set color2 $::C(11b)
+    set xy {23 264 55 591}                      ;# Color the down tube
+    $w.c create rect $xy -fill $color -outline {}
+    set xy [box 71 460 48]                      ;# Color the outer loop
+    $w.c create oval $xy -fill $color -outline {}
+
+    set xy {55 264 55 458}                      ;# Top right side
+    $w.c create line $xy -fill $::C(fg) -width 3
+    set xy {55 504 55 591}                      ;# Bottom right side
+    $w.c create line $xy -fill $::C(fg) -width 3
+    set xy [box 71 460 48]                      ;# Outer loop
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
+	    -start 110 -extent -290 -tag I11i
+    set xy [box 71 460 16]                      ;# Inner loop
+    $w.c create oval $xy -outline $::C(fg) -fill {} -width 3 -tag I11i
+    $w.c create oval $xy -outline $::C(fg) -fill $::C(bg) -width 3
+
+    set xy {23 264 23 591}                      ;# Left side
+    $w.c create line $xy -fill $::C(fg) -width 3
+    set xy [box 1 266 23]                       ;# Top left curve
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc -extent 90
+
+    set xy [box 75 235 9]                       ;# The ball
+    $w.c create oval $xy -fill $color2 -outline {} -width 3 -tag I11
+}
+proc Move11 {{step {}}} {
+    set step [GetStep 11 $step]
+    set pos {
+	{75 235} {70 235} {65 237} {56 240} {46 247} {38 266} {38 296}
+        {38 333} {38 399} {38 475} {74 496} {105 472} {100 437} {65 423}
+        {-100 -100} {38 505} {38 527 x} {38 591}
+    }
+
+    if {$step >= [llength $pos]} {return 0}
+    set where [lindex $pos $step]
+    MoveAbs I11 $where
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+# Hand
+proc Draw12 {} {
+    global w
+    set xy {20 637 20 617 20 610 20 590 40 590 40 590 60 590 60 610 60 610}
+    lappend xy 60 610 65 620 60 631             ;# Thumb
+    lappend xy 60 631 60 637 60 662 60 669 52 669 56 669 50 669 50 662 50 637
+
+    set y0 637                                  ;# Bumps for fingers
+    set y1 645
+    for {set x 50} {$x > 20} {incr x -10} {
+        set x1 [expr {$x - 5}]
+        set x2 [expr {$x - 10}]
+        lappend xy $x $y0 $x1 $y1 $x2 $y0
+    }
+    $w.c create poly $xy -fill $::C(12) -outline $::C(fg) -smooth 1 -tag I12 \
+	    -width 3
+}
+proc Move12 {{step {}}} {
+    set step [GetStep 12 $step]
+    set pos {{42.5 641 x}}
+    if {$step >= [llength $pos]} {return 0}
+
+    set where [lindex $pos $step]
+    MoveAbs I12 $where
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+# Fax
+proc Draw13 {} {
+    global w
+    set color $::C(13a)
+    set xy {86 663 149 663 149 704 50 704 50 681 64 681 86 671}
+    set xy2 {784 663 721 663 721 704 820 704 820 681 806 681 784 671}
+    set radii {2 9 9 8 5 5 2}
+
+    RoundPoly $w.c $xy $radii -width 3 -outline $::C(fg) -fill $color
+    RoundPoly $w.c $xy2 $radii -width 3 -outline $::C(fg) -fill $color
+
+    set xy {56 677}
+    $w.c create rect [eval box $xy 4] -fill {} -outline $::C(fg) -width 3 -tag I13
+    set xy {809 677}
+    $w.c create rect [eval box $xy 4] -fill {} -outline $::C(fg) -width 3 -tag I13R
+
+    set xy {112 687}                            ;# Label
+    $w.c create text $xy -text "FAX" -fill $::C(fg) -font {{Times Roman} 12 bold}
+    set xy {762 687}
+    $w.c create text $xy -text "FAX" -fill $::C(fg) -font {{Times Roman} 12 bold}
+
+    set xy {138 663 148 636 178 636}            ;# Paper guide
+    $w.c create line $xy -smooth 1 -fill $::C(fg) -width 3
+    set xy {732 663 722 636 692 636}
+    $w.c create line $xy -smooth 1 -fill $::C(fg) -width 3
+
+    Sine 149 688 720 688 5 15 -tag I13_s -fill $::C(fg) -width 3
+}
+proc Move13 {{step {}}} {
+    global w
+    set step [GetStep 13 $step]
+    set numsteps 7
+
+    if {$step == $numsteps+2} {
+        MoveAbs I13_star {-100 -100}
+        $w.c itemconfig I13R -fill $::C(13b) -width 2
+        return 2
+    }
+    if {$step == 0} {                           ;# Button down
+        $w.c delete I13
+        Sparkle {-100 -100} I13_star            ;# Create off screen
+        return 1
+    }
+    foreach {x0 y0} [Anchor I13_s w] {x1 y1} [Anchor I13_s e] break
+    set x [expr {$x0 + ($x1-$x0) * ($step - 1) / double($numsteps)}]
+    MoveAbs I13_star [list $x $y0]
+    return 1
+}
+# Paper in fax
+proc Draw14 {} {
+    global w
+    set color $::C(14)
+    set xy {102 661 113 632 130 618}            ;# Left paper edge
+    $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14L_0
+    set xy {148 629 125 640 124 662}            ;# Right paper edge
+    $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14L_1
+    Draw14a L
+
+    set xy {
+	768.0 662.5 767.991316225 662.433786215 767.926187912 662.396880171
+    }
+    $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14R_0
+    $w.c lower I14R_0
+    # NB. these numbers are VERY sensitive, you must start with final size
+    # and shrink down to get the values
+    set xy {
+	745.947897349 662.428358855 745.997829056 662.452239237 746.0 662.5
+    }
+    $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14R_1
+    $w.c lower I14R_1
+}
+proc Draw14a {side} {
+    global w
+    set color $::C(14)
+    set xy [$w.c coords I14${side}_0]
+    set xy2 [$w.c coords I14${side}_1]
+    foreach {x0 y0 x1 y1 x2 y2} $xy break
+    foreach {x3 y3 x4 y4 x5 y5} $xy2 break
+    set zz [concat \
+	    $x0 $y0 $x0 $y0 $xy $x2 $y2 $x2 $y2 \
+	    $x3 $y3 $x3 $y3 $xy2 $x5 $y5 $x5 $y5]
+    $w.c delete I14$side
+    $w.c create poly $zz -tag I14$side -smooth 1 -fill $color -outline $color \
+	    -width 3
+    $w.c lower I14$side
+}
+proc Move14 {{step {}}} {
+    global w
+    set step [GetStep 14 $step]
+
+    # Paper going down
+    set sc [expr {.9 - .05*$step}]
+    if {$sc < .3} {
+        $w.c delete I14L
+        return 0
+    }
+
+    foreach {Ox Oy} [$w.c coords I14L_0] break
+    $w.c scale I14L_0 $Ox $Oy $sc $sc
+    foreach {Ox Oy} [lrange [$w.c coords I14L_1] end-1 end] break
+    $w.c scale I14L_1 $Ox $Oy $sc $sc
+    Draw14a L
+
+    # Paper going up
+    set sc [expr {.35 + .05*$step}]
+    set sc [expr {1 / $sc}]
+
+    foreach {Ox Oy} [$w.c coords I14R_0] break
+    $w.c scale I14R_0 $Ox $Oy $sc $sc
+    foreach {Ox Oy} [lrange [$w.c coords I14R_1] end-1 end] break
+    $w.c scale I14R_1 $Ox $Oy $sc $sc
+    Draw14a R
+
+    return [expr {$step == 10 ? 3 : 1}]
+}
+# Light beam
+proc Draw15 {} {
+    global w
+    set color $::C(15a)
+    set xy {824 599 824 585 820 585 829 585}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I15a
+    set xy {789 599 836 643}
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
+    set xy {778 610 788 632}
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
+    set xy {766 617 776 625}
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
+
+    set xy {633 600 681 640}
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
+    set xy {635 567 657 599}
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 2
+    set xy {765 557 784 583}
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 2
+
+    Sine 658 580 765 580 3 15 -tag I15_s -fill $::C(fg) -width 3
+}
+proc Move15a {} {
+    global w
+    set color $::C(15b)
+    $w.c scale I15a 824 599 1 .3                  ;# Button down
+    set xy {765 621 681 621}
+    $w.c create line $xy -dash "-" -width 3 -fill $color -tag I15
+}
+proc Move15 {{step {}}} {
+    global w
+    set step [GetStep 15 $step]
+    set numsteps 6
+
+    if {$step == $numsteps+2} {
+        MoveAbs I15_star {-100 -100}
+        return 2
+    }
+    if {$step == 0} {                           ;# Break the light beam
+        Sparkle {-100 -100} I15_star
+        set xy {765 621 745 621}
+        $w.c coords I15 $xy
+        return 1
+    }
+    foreach {x0 y0} [Anchor I15_s w] {x1 y1} [Anchor I15_s e] break
+    set x [expr {$x0 + ($x1-$x0) * ($step - 1) / double($numsteps)}]
+    MoveAbs I15_star [list $x $y0]
+    return 1
+}
+# Bell
+proc Draw16 {} {
+    global w
+    set color $::C(16)
+    set xy {722 485 791 556}
+    $w.c create rect $xy -fill {} -outline $::C(fg) -width 3
+    set xy [box 752 515 25]                     ;# Bell
+    $w.c create oval $xy -fill $color -outline black -tag I16b -width 2
+    set xy [box 752 515 5]                      ;# Bell button
+    $w.c create oval $xy -fill black -outline black -tag I16b
+
+    set xy {784 523 764 549}                    ;# Clapper
+    $w.c create line $xy -width 3 -tag I16c -fill $::C(fg)
+    set xy [box 784 523 4]
+    $w.c create oval $xy -fill $::C(fg) -outline $::C(fg) -tag I16d
+}
+proc Move16 {{step {}}} {
+    global w
+    set step [GetStep 16 $step]
+
+    # Note: we never stop
+    foreach {Ox Oy} {760 553} break
+    if {$step & 1} {
+        set beta 12
+        $w.c move I16b 3 0
+    } else {
+        set beta -12
+        $w.c move I16b -3 0
+    }
+    RotateItem I16c $Ox $Oy $beta
+    RotateItem I16d $Ox $Oy $beta
+
+    return [expr {$step == 1 ? 3 : 1}]
+}
+# Cat
+proc Draw17 {} {
+    global w
+    set color $::C(17)
+
+    set xy {584 556 722 556}
+    $w.c create line $xy -fill $::C(fg) -width 3
+    set xy {584 485 722 485}
+    $w.c create line $xy -fill $::C(fg) -width 3
+
+    set xy {664 523 717 549}                    ;# Body
+    $w.c create arc $xy -outline $::C(fg) -fill $color -width 3 \
+	    -style chord -start 128 -extent -260 -tag I17
+
+    set xy {709 554 690 543}                    ;# Paw
+    $w.c create oval $xy -outline $::C(fg) -fill $color -width 3 -tag I17
+    set xy {657 544 676 555}
+    $w.c create oval $xy -outline $::C(fg) -fill $color -width 3 -tag I17
+
+    set xy [box 660 535 15]                     ;# Lower face
+    $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
+	    -start 150 -extent 240 -tag I17_
+    $w.c create arc $xy -outline {} -fill $color -width 1 -style chord \
+	    -start 150 -extent 240 -tag I17_
+    set xy {674 529 670 513 662 521 658 521 650 513 647 529} ;# Ears
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+    $w.c create poly $xy -fill $color -outline {} -width 1 -tag {I17_ I17_c}
+    set xy {652 542 628 539}                    ;# Whiskers
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+    set xy {652 543 632 545}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+    set xy {652 546 632 552}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+
+    set xy {668 543 687 538}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w}
+    set xy {668 544 688 546}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w}
+    set xy {668 547 688 553}
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w}
+
+    set xy {649 530 654 538 659 530}            ;# Left eye
+    $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17
+    set xy {671 530 666 538 661 530}            ;# Right eye
+    $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17
+    set xy {655 543 660 551 665 543}            ;# Mouth
+    $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17
+}
+proc Move17 {{step {}}} {
+    global w
+    set step [GetStep 17 $step]
+
+    if {$step == 0} {
+        $w.c delete I17                           ;# Delete most of the cat
+        set xy {655 543 660 535 665 543}        ;# Mouth
+        $w.c create line $xy -fill $::C(fg) -width 3 -smooth 1 -tag I17_
+        set xy [box 654 530 4]                  ;# Left eye
+        $w.c create oval $xy -outline $::C(fg) -width 3 -fill {} -tag I17_
+        set xy [box 666 530 4]                  ;# Right eye
+        $w.c create oval $xy -outline $::C(fg) -width 3 -fill {} -tag I17_
+
+        $w.c move I17_ 0 -20                      ;# Move face up
+        set xy {652 528 652 554}                ;# Front leg
+        $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+        set xy {670 528 670 554}                ;# 2nd front leg
+        $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+
+        set xy {
+	    675 506 694 489 715 513 715 513 715 513 716 525 716 525 716 525
+            706 530 695 530 679 535 668 527 668 527 668 527 675 522 676 517
+            677 512
+	}					;# Body
+        $w.c create poly $xy -fill [$w.c itemcget I17_c -fill] \
+		-outline $::C(fg) -width 3 -smooth 1 -tag I17_
+        set xy {716 514 716 554}                ;# Back leg
+        $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+        set xy {694 532 694 554}                ;# 2nd back leg
+        $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
+        set xy {715 514 718 506 719 495 716 488};# Tail
+        $w.c create line $xy -fill $::C(fg) -width 3 -smooth 1 -tag I17_
+
+        $w.c raise I17w                           ;# Make whiskers visible
+        $w.c move I17_ -5 0                       ;# Move away from the wall a bit
+        return 2
+    }
+    return 0
+}
+# Sling shot
+proc Draw18 {} {
+    global w
+    set color $::C(18)
+    set xy {721 506 627 506}                    ;# Sling hold
+    $w.c create line $xy -width 4 -fill $::C(fg) -tag I18
+
+    set xy {607 500 628 513}                    ;# Sling rock
+    $w.c create oval $xy -fill $color -outline {} -tag I18a
+
+    set xy {526 513 606 507 494 502}            ;# Sling band
+    $w.c create line $xy -fill $::C(fg) -width 4 -tag I18b
+    set xy { 485 490 510 540 510 575 510 540 535 491 } ;# Sling
+    $w.c create line $xy -fill $::C(fg) -width 6
+}
+proc Move18 {{step {}}} {
+    global w
+    set step [GetStep 18 $step]
+
+    set pos {
+	{587 506} {537 506} {466 506} {376 506} {266 506 x} {136 506}
+        {16 506} {-100 -100}
+    }
+
+    set b(0) {490 502 719 507 524 512}          ;# Band collapsing
+    set b(1) {
+	491 503 524 557 563 505 559 496 546 506 551 525 553 536 538 534
+	532 519 529 499
+    }
+    set b(2) {491 503 508 563 542 533 551 526 561 539 549 550 530 500}
+    set b(3) {491 503 508 563 530 554 541 562 525 568 519 544 530 501}
+
+    if {$step >= [llength $pos]} { return 0}
+
+    if {$step == 0} {
+        $w.c delete I18
+        $w.c itemconfig I18b -smooth 1
+    }
+    if {[info exists b($step)]} {
+        $w.c coords I18b $b($step)
+    }
+
+    set where [lindex $pos $step]
+    MoveAbs I18a $where
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+# Water pipe
+proc Draw19 {} {
+    global w
+    set color $::C(19)
+    set xx {249 181 155 118  86 55 22 0}
+    foreach {x1 x2} $xx {
+        $w.c create rect $x1 453 $x2 467 -fill $color -outline {} -tag I19
+        $w.c create line $x1 453 $x2 453 -fill $::C(fg) -width 1 ;# Pipe top
+        $w.c create line $x1 467 $x2 467 -fill $::C(fg) -width 1 ;# Pipe bottom
+    }
+    $w.c raise I11i
+
+    set xy [box 168 460 16]                     ;# Bulge by the joint
+    $w.c create oval $xy -fill $color -outline {}
+    $w.c create arc $xy -outline $::C(fg) -width 1 -style arc \
+	    -start 21 -extent 136
+    $w.c create arc $xy -outline $::C(fg) -width 1 -style arc \
+	    -start -21 -extent -130
+
+    set xy {249 447 255 473}                    ;# First joint 26x6
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
+
+    set xy [box 257 433 34]                     ;# Bend up
+    $w.c create arc $xy -outline {} -fill $color -width 1 \
+	    -style pie -start 0 -extent -91
+    $w.c create arc $xy -outline $::C(fg) -width 1 \
+	    -style arc -start 0 -extent -90
+    set xy [box 257 433 20]
+    $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \
+	    -style pie -start 0 -extent -92
+    $w.c create arc $xy -outline $::C(fg) -width 1 \
+	    -style arc -start 0 -extent -90
+    set xy [box 257 421 34]                     ;# Bend left
+    $w.c create arc $xy -outline {} -fill $color -width 1 \
+	    -style pie -start 1 -extent 91
+    $w.c create arc $xy -outline $::C(fg) -width 1 \
+	    -style arc -start 0 -extent 90
+    set xy [box 257 421 20]
+    $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \
+	    -style pie -start 0 -extent 90
+    $w.c create arc $xy -outline $::C(fg) -width 1 \
+	    -style arc -start 0 -extent 90
+    set xy [box 243 421 34]                     ;# Bend down
+    $w.c create arc $xy -outline {} -fill $color -width 1 \
+	    -style pie -start 90 -extent 90
+    $w.c create arc $xy -outline $::C(fg) -width 1 \
+	    -style arc -start 90 -extent 90
+    set xy [box 243 421 20]
+    $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \
+	    -style pie -start 90 -extent 90
+    $w.c create arc $xy -outline $::C(fg) -width 1 \
+	    -style arc -start 90 -extent 90
+
+    set xy {270 427 296 433}                    ;# 2nd joint bottom
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
+    set xy {270 421 296 427}                    ;# 2nd joint top
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
+    set xy {249 382 255 408}                    ;# Third joint right
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
+    set xy {243 382 249 408}                    ;# Third joint left
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
+    set xy {203 420 229 426}                    ;# Last joint
+    $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
+
+    set xy [box 168 460 6]                      ;# Handle joint
+    $w.c create oval $xy -fill $::C(fg) -outline {} -tag I19a
+    set xy {168 460 168 512}                    ;# Handle bar
+    $w.c create line $xy -fill $::C(fg) -width 5 -tag I19b
+}
+proc Move19 {{step {}}} {
+    set step [GetStep 19 $step]
+
+    set angles {30 30 30}
+    if {$step == [llength $angles]} {return 2}
+
+    foreach {Ox Oy} [Centroid I19a] break
+    RotateItem I19b $Ox $Oy [lindex $angles $step]
+
+    return 1
+}
+# Water pouring
+proc Draw20 {} {
+}
+proc Move20 {{step {}}} {
+    global w
+    set step [GetStep 20 $step]
+
+    set pos {451 462 473 484 496 504 513 523 532}
+    set freq {20 40   40  40  40  40  40  40  40}
+    set pos {
+	{451 20} {462 40} {473 40} {484 40} {496 40} {504 40} {513 40}
+        {523 40} {532 40 x}
+    }
+    if {$step >= [llength $pos]} {return 0}
+
+    $w.c delete I20
+    set where [lindex $pos $step]
+    foreach {y f} $where break
+    H2O $y $f
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+proc H2O {y f} {
+    global w
+    set color $::C(20)
+    $w.c delete I20
+
+    Sine 208 428 208 $y 4 $f -tag {I20 I20s} -width 3 -fill $color -smooth 1
+    $w.c create line [$w.c coords I20s] -width 3 -fill $color -smooth 1 -tag {I20 I20a}
+    $w.c create line [$w.c coords I20s] -width 3 -fill $color -smooth 1 -tag {I20 I20b}
+    $w.c move I20a 8 0
+    $w.c move I20b 16 0
+}
+# Bucket
+proc Draw21 {} {
+    global w
+    set color $::C(21)
+    set xy {217 451 244 490}                    ;# Right handle
+    $w.c create line $xy -fill $::C(fg) -width 2 -tag I21_a
+    set xy {201 467 182 490}                    ;# Left handle
+    $w.c create line $xy -fill $::C(fg) -width 2 -tag I21_a
+
+    set xy {245 490 237 535}                    ;# Right side
+    set xy2 {189 535 181 490}                   ;# Left side
+    $w.c create poly [concat $xy $xy2] -fill $color -outline {} -tag {I21 I21f}
+    $w.c create line $xy -fill $::C(fg) -width 2 -tag I21
+    $w.c create line $xy2 -fill $::C(fg) -width 2 -tag I21
+
+    set xy {182 486 244 498}                    ;# Top
+    $w.c create oval $xy -fill $color -outline {} -width 2 -tag {I21 I21f}
+    $w.c create oval $xy -fill {} -outline $::C(fg) -width 2 -tag {I21 I21t}
+    set xy {189 532 237 540}                    ;# Bottom
+    $w.c create oval $xy -fill $color -outline $::C(fg) -width 2 -tag {I21 I21b}
+}
+proc Move21 {{step {}}} {
+    global w
+    set step [GetStep 21 $step]
+
+    set numsteps 30
+    if {$step  >= $numsteps} {return 0}
+
+    foreach {x1 y1 x2 y2} [$w.c coords I21b] break
+    #foreach {X1 Y1 X2 Y2} [$w.c coords I21t] break
+    foreach {X1 Y1 X2 Y2} {183 492 243 504} break
+
+    set f [expr {$step / double($numsteps)}]
+    set y2 [expr {$y2 - 3}]
+    set xx1 [expr {$x1 + ($X1 - $x1) * $f}]
+    set yy1 [expr {$y1 + ($Y1 - $y1) * $f}]
+    set xx2 [expr {$x2 + ($X2 - $x2) * $f}]
+    set yy2 [expr {$y2 + ($Y2 - $y2) * $f}]
+    #H2O $yy1 40
+
+    $w.c itemconfig I21b -fill $::C(20)
+    $w.c delete I21w
+    $w.c create poly $x2 $y2 $x1 $y1 $xx1 $yy1 $xx2 $yy1 -tag {I21 I21w} \
+	    -outline {} -fill $::C(20)
+    $w.c lower I21w I21
+    $w.c raise I21b
+    $w.c lower I21f
+
+    return [expr {$step == $numsteps-1 ? 3 : 1}]
+}
+# Bucket drop
+proc Draw22 {} {
+}
+proc Move22 {{step {}}} {
+    global w
+    set step [GetStep 22 $step]
+    set pos {{213 513} {213 523} {213 543 x} {213 583} {213 593}}
+
+    if {$step == 0} {$w.c itemconfig I21f -fill $::C(22)}
+    if {$step >= [llength $pos]} {return 0}
+    set where [lindex $pos $step]
+    MoveAbs I21 $where
+    H2O [lindex $where 1] 40
+    $w.c delete I21_a                             ;# Delete handles
+
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+# Blow dart
+proc Draw23 {} {
+    global w
+    set color  $::C(23a)
+    set color2 $::C(23b)
+    set color3 $::C(23c)
+
+    set xy {185 623 253 650}                    ;# Block
+    $w.c create rect $xy -fill black -outline $::C(fg) -width 2 -tag I23a
+    set xy {187 592 241 623}                    ;# Balloon
+    $w.c create oval $xy -outline {} -fill $color -tag I23b
+    $w.c create arc $xy -outline $::C(fg) -width 3 -tag I23b \
+	    -style arc -start 12 -extent 336
+    set xy {239 604  258 589 258 625 239 610}   ;# Balloon nozzle
+    $w.c create poly $xy -outline {} -fill $color -tag I23b
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I23b
+
+    set xy {285 611 250 603}                    ;# Dart body
+    $w.c create oval $xy -fill $color2 -outline $::C(fg) -width 3 -tag I23d
+    set xy {249 596 249 618 264 607 249 596}    ;# Dart tail
+    $w.c create poly $xy -fill $color3 -outline $::C(fg) -width 3 -tag I23d
+    set xy {249 607 268 607}                    ;# Dart detail
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I23d
+    set xy {285 607 305 607}                    ;# Dart needle
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I23d
+}
+proc Move23 {{step {}}} {
+    global w
+    set step [GetStep 23 $step]
+
+    set pos {
+	{277 607} {287 607} {307 607 x} {347 607} {407 607} {487 607}
+        {587 607} {687 607} {787 607} {-100 -100}
+    }
+
+    if {$step >= [llength $pos]} {return 0}
+    if {$step <= 1} {
+        eval $w.c scale I23b [Anchor I23a n] .9 .5
+    }
+    set where [lindex $pos $step]
+    MoveAbs I23d $where
+
+    if {[lindex $where 2] == "x"} {return 3}
+    return 1
+}
+# Balloon
+proc Draw24 {} {
+    global w
+    set color $::C(24a)
+    set xy {366 518 462 665}                    ;# Balloon
+    $w.c create oval $xy -fill $color -outline $::C(fg) -width 3 -tag I24
+    set xy {414 666 414 729}                    ;# String
+    $w.c create line $xy -fill $::C(fg) -width 3 -tag I24
+    set xy {410 666 404 673 422 673 418 666}    ;# Nozzle
+    $w.c create poly $xy -fill $color -outline $::C(fg) -width 3 -tag I24
+
+    set xy {387 567 390 549 404 542}            ;# Reflections
+    $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
+    set xy {395 568 399 554 413 547}
+    $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
+    set xy {403 570 396 555 381 553}
+    $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
+    set xy {408 564 402 547 386 545}
+    $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
+}
+proc Move24 {{step {}}} {
+    global S w
+    set step [GetStep 24 $step]
+
+    if {$step > 4} {return 0}
+    if {$step == 4} {return 2}
+
+    if {$step == 0} {
+        $w.c delete I24                           ;# Exploding balloon
+        set xy {
+	    347 465 361 557 271 503 272 503 342 574 259 594 259 593 362 626
+	    320 737 320 740 398 691 436 738 436 739 476 679 528 701 527 702
+	    494 627 548 613 548 613 480 574 577 473 577 473 474 538 445 508
+	    431 441 431 440 400 502 347 465 347 465
+	}
+        $w.c create poly $xy -tag I24 -fill $::C(24b) -outline $::C(24a) \
+		-width 10 -smooth 1
+        set msg [subst $S(message)]
+        $w.c create text [Centroid I24] -text $msg -tag {I24 I24t} \
+		-justify center -font {{Times Roman} 18 bold}
+        return 1
+    }
+
+    $w.c itemconfig I24t -font [list {Times Roman} [expr {18 + 6*$step}] bold]
+    $w.c move I24 0 -60
+    eval $w.c scale I24 [Centroid I24] 1.25 1.25
+    return 1
+}
+# Displaying the message
+proc Move25 {{step {}}} {
+    global S
+    set step [GetStep 25 $step]
+    if {$step == 0} {
+        set ::XY(25) [clock clicks -milliseconds]
+        return 1
+    }
+    set elapsed [expr {[clock clicks -milliseconds] - $::XY(25)}]
+    if {$elapsed < 5000} {return 1}
+    return 2
+}
+# Collapsing balloon
+proc Move26 {{step {}}} {
+    global S w
+    set step [GetStep 26 $step]
+
+    if {$step >= 3} {
+        $w.c delete I24 I26
+        $w.c create text 430 755 -anchor s -tag I26 \
+		-text "click to continue" -font {{Times Roman} 24 bold}
+        bind $w.c <1> Reset
+        return 4
+    }
+
+    eval $w.c scale I24 [Centroid I24] .8 .8
+    $w.c move I24 0 60
+    $w.c itemconfig I24t -font [list {Times Roman} [expr {30 - 6*$step}] bold]
+    return 1
+}
+
+################################################################
+#
+# Helper functions
+#
+proc box {x y r} {
+    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
+}
+proc MoveAbs {item xy} {
+    global w
+    foreach {x y} $xy break
+    foreach {Ox Oy} [Centroid $item] break
+    set dx [expr {$x - $Ox}]
+    set dy [expr {$y - $Oy}]
+    $w.c move $item $dx $dy
+}
+proc RotateItem {item Ox Oy beta} {
+    global w
+    set xy [$w.c coords $item]
+    set xy2 {}
+    foreach {x y} $xy {
+        eval lappend xy2 [RotateC $x $y $Ox $Oy $beta]
+    }
+    $w.c coords $item $xy2
+}
+proc RotateC {x y Ox Oy beta} {
+    # rotates vector (Ox,Oy)->(x,y) by beta degrees clockwise
+
+    set x [expr {$x - $Ox}]                     ;# Shift to origin
+    set y [expr {$y - $Oy}]
+
+    set beta [expr {$beta * atan(1) * 4 / 180.0}] ;# Radians
+    set xx [expr {$x * cos($beta) - $y * sin($beta)}] ;# Rotate
+    set yy [expr {$x * sin($beta) + $y * cos($beta)}]
+
+    set xx [expr {$xx + $Ox}]                   ;# Shift back
+    set yy [expr {$yy + $Oy}]
+
+    return [list $xx $yy]
+}
+
+proc Reset {} {
+    global S w
+    DrawAll
+    bind $w.c <1> {}
+    set S(mode) $::MSTART
+    set S(active) 0
+}
+# Each Move## keeps its state info in STEP, this retrieves and increments it
+proc GetStep {who step} {
+    global STEP
+    if {$step != {}} {
+        set STEP($who) $step
+    } else {
+        if {! [info exists STEP($who)] || $STEP($who) == ""} {
+            set STEP($who) 0
+        } else {
+            incr STEP($who)
+        }
+    }
+    return $STEP($who)
+}
+proc ResetStep {} {
+    global STEP
+    set ::S(cnt) 0
+    foreach a [array names STEP] { set STEP($a) ""}
+}
+proc Sine {x0 y0 x1 y1 amp freq args} {
+    global w
+    set PI [expr {4 * atan(1)}]
+    set step 2
+    set xy {}
+    if {$y0 == $y1} {                           ;# Horizontal
+        for {set x $x0} {$x <= $x1} {incr x $step} {
+            set beta [expr {($x - $x0) * 2 * $PI / $freq}]
+            set y [expr {$y0 + $amp * sin($beta)}]
+            lappend xy $x $y
+        }
+    } else {
+        for {set y $y0} {$y <= $y1} {incr y $step} {
+            set beta [expr {($y - $y0) * 2 * $PI / $freq}]
+            set x [expr {$x0 + $amp * sin($beta)}]
+            lappend xy $x $y
+        }
+    }
+    return [eval $w.c create line $xy $args]
+}
+proc RoundRect {xy radius args} {
+    global w
+    foreach {x0 y0 x3 y3} $xy break
+    set r [winfo pixels $w.c $radius]
+    set d [expr {2 * $r}]
+
+    # Make sure that the radius of the curve is less than 3/8 size of the box!
+    set maxr 0.75
+    if {$d > $maxr * ($x3 - $x0) } {
+        set d [expr { $maxr * ($x3 - $x0)}]
+    }
+    if {$d > $maxr * ($y3 - $y0) } {
+        set d [expr { $maxr * ($y3 - $y0) }]
+    }
+
+    set x1 [expr { $x0 + $d }]
+    set x2 [expr { $x3 - $d }]
+    set y1 [expr { $y0 + $d }]
+    set y2 [expr { $y3 - $d }]
+
+    set xy [list $x0 $y0 $x1 $y0 $x2 $y0 $x3 $y0 $x3 $y1 $x3 $y2]
+    lappend xy $x3 $y3 $x2 $y3 $x1 $y3 $x0 $y3 $x0 $y2 $x0 $y1
+    return $xy
+}
+proc RoundPoly {canv xy radii args} {
+    set lenXY [llength $xy]
+    set lenR [llength $radii]
+    if {$lenXY != 2*$lenR} {
+        error "wrong number of vertices and radii"
+    }
+
+    set knots {}
+    foreach {x0 y0} [lrange $xy end-1 end] break
+    foreach {x1 y1} $xy break
+    eval lappend xy [lrange $xy 0 1]
+
+    for {set i 0} {$i < $lenXY} {incr i 2} {
+        set radius [lindex $radii [expr {$i/2}]]
+        set r [winfo pixels $canv $radius]
+
+        foreach {x2 y2} [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] break
+        set z [_RoundPoly2 $x0 $y0 $x1 $y1 $x2 $y2 $r]
+        eval lappend knots $z
+
+        foreach {x0 y0} [list $x1 $y1] break
+        foreach {x1 y1} [list $x2 $y2] break
+    }
+    set n [eval $canv create polygon $knots -smooth 1 $args]
+    return $n
+}
+proc _RoundPoly2 {x0 y0 x1 y1 x2 y2 radius} {
+    set d [expr { 2 * $radius }]
+    set maxr 0.75
+
+    set v1x [expr {$x0 - $x1}]
+    set v1y [expr {$y0 - $y1}]
+    set v2x [expr {$x2 - $x1}]
+    set v2y [expr {$y2 - $y1}]
+
+    set vlen1 [expr {sqrt($v1x*$v1x + $v1y*$v1y)}]
+    set vlen2 [expr {sqrt($v2x*$v2x + $v2y*$v2y)}]
+    if {$d > $maxr * $vlen1} {
+        set d [expr {$maxr * $vlen1}]
+    }
+    if {$d > $maxr * $vlen2} {
+        set d [expr {$maxr * $vlen2}]
+    }
+
+    lappend xy [expr {$x1 + $d * $v1x/$vlen1}] [expr {$y1 + $d * $v1y/$vlen1}]
+    lappend xy $x1 $y1
+    lappend xy [expr {$x1 + $d * $v2x/$vlen2}] [expr {$y1 + $d * $v2y/$vlen2}]
+
+    return $xy
+}
+proc Sparkle {Oxy tag} {
+    global w
+    set xy {299 283 298 302 295 314 271 331 239 310 242 292 256 274 281 273}
+    foreach {x y} $xy {
+        $w.c create line 271 304 $x $y -fill white -width 3 -tag $tag
+    }
+    MoveAbs $tag $Oxy
+}
+proc Centroid {item} {
+    return [Anchor $item c]
+}
+proc Anchor {item where} {
+    global w
+    foreach {x1 y1 x2 y2} [$w.c bbox $item] break
+    if {[string first "n" $where] > -1} {
+        set y $y1
+    } elseif {[string first "s" $where] > -1} {
+        set y $y2
+    } else {
+        set y [expr {($y1 + $y2) / 2.0}]
+    }
+    if {[string first "w" $where] > -1} {
+        set x $x1
+    } elseif {[string first "e" $where] > -1} {
+        set x $x2
+    } else {
+        set x [expr {($x1 + $x2) / 2.0}]
+    }
+    return [list $x $y]
+}
+
+DoDisplay
+Reset
+Go						;# Start everything going