PageRenderTime 57ms CodeModel.GetById 14ms RepoModel.GetById 1ms app.codeStats 0ms

/mingw/lib/tk8.5/demos/goldberg.tcl

https://code.google.com/
TCL | 1833 lines | 1534 code | 205 blank | 94 comment | 166 complexity | 395a368f65dcf63ba1ac868a20bff71c MD5 | raw file
Possible License(s): AGPL-3.0, GPL-2.0, LGPL-2.0, GPL-3.0, LGPL-2.1

Large files files are truncated, but you can click here to view the full file

    

  1. ##+#################################################################
    2. 

  2. #
    3. 

  3. # TkGoldberg.tcl
    4. 

  4. # by Keith Vetter, March 13, 2003
    5. 

  5. #
    6. 

  6. # "Man will always find a difficult means to perform a simple task"
    7. 

  7. # Rube Goldberg
    8. 

  8. #
    9. 

  9. # Reproduced here with permission.
    10. 

  10. #
    11. 

  11. ##+#################################################################
    12. 

  12. #
    13. 

  13. # Keith Vetter 2003-03-21: this started out as a simple little program
    14. 

  14. # but was so much fun that it grew and grew. So I apologize about the
    15. 

  15. # size but I just couldn't resist sharing it.
    16. 

  16. #
    17. 

  17. # This is a whizzlet that does a Rube Goldberg type animation, the
    18. 

  18. # design of which comes from an New Years e-card from IncrediMail.
    19. 

  19. # That version had nice sound effects which I eschewed. On the other
    20. 

  20. # hand, that version was in black and white (actually dark blue and
    21. 

  21. # light blue) and this one is fully colorized.
    22. 

  22. #
    23. 

  23. # One thing I learned from this project is that drawing filled complex
    24. 

  24. # objects on a canvas is really hard. More often than not I had to
    25. 

  25. # draw each item twice--once with the desired fill color but no
    26. 

  26. # outline, and once with no fill but with the outline. Another trick
    27. 

  27. # is erasing by drawing with the background color. Having a flood fill
    28. 

  28. # command would have been extremely helpful.
    29. 

  29. #
    30. 

  30. # Two wiki pages were extremely helpful: Drawing rounded rectangles
    31. 

  31. # which I generalized into Drawing rounded polygons, and regular
    32. 

  32. # polygons which allowed me to convert ovals and arcs into polygons
    33. 

  33. # which could then be rotated (see Canvas Rotation). I also wrote
    34. 

  34. # Named Colors to aid in the color selection.
    35. 

  35. #
    36. 

  36. # I could comment on the code, but it's just 26 state machines with
    37. 

  37. # lots of canvas create and move calls.
    38. 

  38. 

  39. if {![info exists widgetDemo]} {
    40. 

  40.     error "This script should be run from the \"widget\" demo."
    41. 

  41. }
    42. 

  42. 

  43. package require Tk
    44. 

  44. 

  45. set w .goldberg
    46. 

  46. catch {destroy $w}
    47. 

  47. toplevel $w
    48. 

  48. wm title $w "Tk Goldberg (demonstration)"
    49. 

  49. wm iconname $w "goldberg"
    50. 

  50. wm resizable $w 0 0
    51. 

  51. #positionWindow $w
    52. 

  52. 

  53. label $w.msg -font {Arial 10} -wraplength 4i -justify left -text "This is a\
    54. 

  54. 	demonstration of just how complex you can make your animations\
    55. 

  55. 	become. Click the ball to start things moving!\n\n\"Man will always\
    56. 

  56. 	find a difficult means to perform a simple task\"\n - Rube Goldberg"
    57. 

  57. pack $w.msg -side top
    58. 

  58. 

  59. ###--- End of Boilerplate ---###
    60. 

  60. 

  61. # Ensure that this this is an array
    62. 

  62. array set animationCallbacks {}
    63. 

  63. bind $w <Destroy> {
    64. 

  64.     if {"%W" eq [winfo toplevel %W]} {
    65. 

  65. 	unset S C speed
    66. 

  66.     }
    67. 

  67. }
    68. 

  68. 

  69. set S(title) "Tk Goldberg"
    70. 

  70. set S(speed) 5
    71. 

  71. set S(cnt) 0
    72. 

  72. set S(message) "\\nWelcome\\nto\\nTcl/Tk"
    73. 

  73. array set speed {1 10 2 20 3 50 4 80 5 100 6 150 7 200 8 300 9 400 10 500}
    74. 

  74. 

  75. set MSTART 0; set MGO 1; set MPAUSE 2; set MSSTEP 3; set MBSTEP 4; set MDONE 5
    76. 

  76. set S(mode) $::MSTART
    77. 

  77. 

  78. # Colors for everything
    79. 

  79. set C(fg) black
    80. 

  80. set C(bg) gray75
    81. 

  81. set C(bg) cornflowerblue
    82. 

  82. 

  83. set C(0) white;		set C(1a) darkgreen;	set C(1b) yellow
    84. 

  84. set C(2) red;		set C(3a) green;	set C(3b) darkblue
    85. 

  85. set C(4) $C(fg);	set C(5a) brown;	set C(5b) white
    86. 

  86. set C(6) magenta;	set C(7) green;		set C(8) $C(fg)
    87. 

  87. set C(9) blue4;		set C(10a) white;	set C(10b) cyan
    88. 

  88. set C(11a) yellow;	set C(11b) mediumblue;	set C(12) tan2
    89. 

  89. set C(13a) yellow;	set C(13b) red;		set C(14) white
    90. 

  90. set C(15a) green;	set C(15b) yellow;	set C(16) gray65
    91. 

  91. set C(17) \#A65353;	set C(18) $C(fg);	set C(19) gray50
    92. 

  92. set C(20) cyan;		set C(21) gray65;	set C(22) $C(20)
    93. 

  93. set C(23a) blue;	set C(23b) red;		set C(23c) yellow
    94. 

  94. set C(24a) red;		set C(24b) white;
    95. 

  95. 

  96. proc DoDisplay {w} {
    97. 

  97.     global S C
    98. 

  98. 

  99.     ttk::frame $w.ctrl -relief ridge -borderwidth 2 -padding 5
    100. 

  100.     pack [frame $w.screen -bd 2 -relief raised] \
    101. 

  101. 	    -side left -fill both -expand 1
    102. 

  102. 

  103.     canvas $w.c -width 860 -height 730 -bg $C(bg) -highlightthickness 0
    104. 

  104.     $w.c config -scrollregion {0 0 1000 1000}	;# Kludge: move everything up
    105. 

  105.     $w.c yview moveto .05
    106. 

  106.     pack $w.c -in $w.screen -side top -fill both -expand 1
    107. 

  107. 

  108.     bind $w.c <3> [list $w.pause invoke]
    109. 

  109.     bind $w.c <Destroy> {
    110. 

  110. 	after cancel $animationCallbacks(goldberg)
    111. 

  111. 	unset animationCallbacks(goldberg)
    112. 

  112.     }
    113. 

  113.     DoCtrlFrame $w
    114. 

  114.     DoDetailFrame $w
    115. 

  115.     if {[tk windowingsystem] ne "aqua"} {
    116. 

  116. 	ttk::button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2
    117. 

  117.     } else {
    118. 

  118. 	button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
    119. 

  119.     }
    120. 

  120.     place $w.show -in $w.c -relx 1 -rely 0 -anchor ne
    121. 

  121.     update
    122. 

  122. }
    123. 

  123. 

  124. proc DoCtrlFrame {w} {
    125. 

  125.     global S
    126. 

  126.     ttk::button $w.start -text "Start" -command [list DoButton $w 0]
    127. 

  127.     ttk::checkbutton $w.pause -text "Pause" -command [list DoButton $w 1] \
    128. 

  128. 	    -variable S(pause)
    129. 

  129.     ttk::button $w.step -text "Single Step" -command [list DoButton $w 2]
    130. 

  130.     ttk::button $w.bstep -text "Big Step" -command [list DoButton $w 4]
    131. 

  131.     ttk::button $w.reset -text "Reset" -command [list DoButton $w 3]
    132. 

  132.     ttk::labelframe $w.details
    133. 

  133.     raise $w.details
    134. 

  134.     set S(details) 0
    135. 

  135.     ttk::checkbutton $w.details.cb -text "Details" -variable S(details)
    136. 

  136.     ttk::labelframe $w.message -text "Message"
    137. 

  137.     ttk::entry $w.message.e -textvariable S(message) -justify center
    138. 

  138.     ttk::labelframe $w.speed -text "Speed: 0"
    139. 

  139.     ttk::scale $w.speed.scale -orient h -from 1 -to 10 -variable S(speed)
    140. 

  140.     ttk::button $w.about -text About -command [list About $w]
    141. 

  141. 

  142.     grid $w.start -in $w.ctrl -row 0 -sticky ew
    143. 

  143.     grid rowconfigure $w.ctrl 1 -minsize 10
    144. 

  144.     grid $w.pause -in $w.ctrl -row 2 -sticky ew
    145. 

  145.     grid $w.step  -in $w.ctrl -sticky ew -pady 2
    146. 

  146.     grid $w.bstep -in $w.ctrl -sticky ew
    147. 

  147.     grid $w.reset -in $w.ctrl -sticky ew -pady 2
    148. 

  148.     grid rowconfigure $w.ctrl 10 -minsize 18
    149. 

  149.     grid $w.details -in $w.ctrl -row 11 -sticky ew
    150. 

  150.     grid rowconfigure $w.ctrl 11 -minsize 20
    151. 

  151.     $w.details configure -labelwidget $w.details.cb
    152. 

  152.     grid [ttk::frame $w.details.b -height 1]	;# Work around minor bug
    153. 

  153.     raise $w.details
    154. 

  154.     raise $w.details.cb
    155. 

  155.     grid rowconfigure $w.ctrl 50 -weight 1
    156. 

  156.     trace variable ::S(mode) w	  [list ActiveGUI $w]
    157. 

  157.     trace variable ::S(details) w [list ActiveGUI $w]
    158. 

  158.     trace variable ::S(speed) w	  [list ActiveGUI $w]
    159. 

  159. 

  160.     grid $w.message -in $w.ctrl -row 98 -sticky ew -pady 5
    161. 

  161.     grid $w.message.e -sticky nsew
    162. 

  162.     grid $w.speed -in $w.ctrl -row 99 -sticky ew -pady {0 5}
    163. 

  163.     pack $w.speed.scale -fill both -expand 1
    164. 

  164.     grid $w.about -in $w.ctrl -row 100 -sticky ew
    165. 

  165.     bind $w.reset <3> {set S(mode) -1}		;# Debugging
    166. 

  166. 

  167.     ## See Code / Dismiss buttons hack!
    168. 

  168.     set btns [addSeeDismiss $w.ctrl.buttons $w]
    169. 

  169.     grid [ttk::separator $w.ctrl.sep] -sticky ew -pady 4
    170. 

  170.     set i 0
    171. 

  171.     foreach b [winfo children $btns] {
    172. 

  172. 	if {[winfo class $b] eq "TButton"} {
    173. 

  173. 	    grid [set b2 [ttk::button $w.ctrl.b[incr i]]] -sticky ew
    174. 

  174. 	    foreach b3 [$b configure] {
    175. 

  175. 		set b3 [lindex $b3 0]
    176. 

  176. 		# Some options are read-only; ignore those errors
    177. 

  177. 		catch {$b2 configure $b3 [$b cget $b3]}
    178. 

  178. 	    }
    179. 

  179. 	}
    180. 

  180.     }
    181. 

  181.     destroy $btns
    182. 

  182. }
    183. 

  183. 

  184. proc DoDetailFrame {w} {
    185. 

  185.     set w2 $w.details.f
    186. 

  186.     ttk::frame $w2
    187. 

  187. 

  188.     set bd 2
    189. 

  189.     ttk::label $w2.l -textvariable S(cnt) -background white
    190. 

  190.     grid $w2.l - - - -sticky ew -row 0
    191. 

  191.     for {set i 1} {1} {incr i} {
    192. 

  192. 	if {[info procs "Move$i"] eq ""} break
    193. 

  193. 	ttk::label $w2.l$i -text $i -anchor e -width 2 -background white
    194. 

  194. 	ttk::label $w2.ll$i -textvariable STEP($i) -width 5 -background white
    195. 

  195. 	set row [expr {($i + 1) / 2}]
    196. 

  196. 	set col [expr {(($i + 1) & 1) * 2}]
    197. 

  197. 	grid $w2.l$i -sticky ew -row $row -column $col
    198. 

  198. 	grid $w2.ll$i -sticky ew -row $row -column [incr col]
    199. 

  199.     }
    200. 

  200.     grid columnconfigure $w2 1 -weight 1
    201. 

  201. }
    202. 

  202. 

  203. # Map or unmap the ctrl window
    204. 

  204. proc ShowCtrl {w} {
    205. 

  205.     if {[winfo ismapped $w.ctrl]} {
    206. 

  206. 	pack forget $w.ctrl
    207. 

  207. 	$w.show config -text "\u00bb"
    208. 

  208.     } else {
    209. 

  209. 	pack $w.ctrl -side right -fill both -ipady 5
    210. 

  210. 	$w.show config -text "\u00ab"
    211. 

  211.     }
    212. 

  212. }
    213. 

  213. 

  214. proc DrawAll {w} {
    215. 

  215.     ResetStep
    216. 

  216.     $w.c delete all
    217. 

  217.     for {set i 0} {1} {incr i} {
    218. 

  218. 	set p "Draw$i"
    219. 

  219. 	if {[info procs $p] eq ""} break
    220. 

  220. 	$p $w
    221. 

  221.     }
    222. 

  222. }
    223. 

  223. 

  224. proc ActiveGUI {w var1 var2 op} {
    225. 

  225.     global S MGO MSTART MDONE
    226. 

  226.     array set z {0 disabled 1 normal}
    227. 

  227. 

  228.     set m $S(mode)
    229. 

  229.     set S(pause) [expr {$m == 2}]
    230. 

  230.     $w.start  config -state $z([expr {$m != $MGO}])
    231. 

  231.     $w.pause  config -state $z([expr {$m != $MSTART && $m != $MDONE}])
    232. 

  232.     $w.step   config -state $z([expr {$m != $MGO && $m != $MDONE}])
    233. 

  233.     $w.bstep  config -state $z([expr {$m != $MGO && $m != $MDONE}])
    234. 

  234.     $w.reset  config -state $z([expr {$m != $MSTART}])
    235. 

  235. 

  236.     if {$S(details)} {
    237. 

  237. 	grid $w.details.f -sticky ew
    238. 

  238.     } else {
    239. 

  239. 	grid forget $w.details.f
    240. 

  240.     }
    241. 

  241.     set S(speed) [expr {round($S(speed))}]
    242. 

  242.     $w.speed config -text "Speed: $S(speed)"
    243. 

  243. }
    244. 

  244. 

  245. proc Start {} {
    246. 

  246.     global S MGO
    247. 

  247.     set S(mode) $MGO
    248. 

  248. }
    249. 

  249. 

  250. proc DoButton {w what} {
    251. 

  251.     global S MDONE MGO MSSTEP MBSTEP MPAUSE
    252. 

  252. 

  253.     if {$what == 0} {				;# Start
    254. 

  254. 	if {$S(mode) == $MDONE} {
    255. 

  255. 	    Reset $w
    256. 

  256. 	}
    257. 

  257. 	set S(mode) $MGO
    258. 

  258.     } elseif {$what == 1} {			;# Pause
    259. 

  259. 	set S(mode) [expr {$S(pause) ? $MPAUSE : $MGO}]
    260. 

  260.     } elseif {$what == 2} {			;# Step
    261. 

  261. 	set S(mode) $MSSTEP
    262. 

  262.     } elseif {$what == 3} {			;# Reset
    263. 

  263. 	Reset $w
    264. 

  264.     } elseif {$what == 4} {			;# Big step
    265. 

  265. 	set S(mode) $MBSTEP
    266. 

  266.     }
    267. 

  267. }
    268. 

  268. 

  269. proc Go {w {who {}}} {
    270. 

  270.     global S speed animationCallbacks MGO MPAUSE MSSTEP MBSTEP
    271. 

  271. 

  272.     set now [clock clicks -milliseconds]
    273. 

  273.     catch {after cancel $animationCallbacks(goldberg)}
    274. 

  274.     if {$who ne ""} {				;# Start here for debugging
    275. 

  275. 	set S(active) $who;
    276. 

  276. 	set S(mode) $MGO
    277. 

  277.     }
    278. 

  278.     if {$S(mode) == -1} return			;# Debugging
    279. 

  279.     set n 0
    280. 

  280.     if {$S(mode) != $MPAUSE} {			;# Not paused
    281. 

  281. 	set n [NextStep $w]			;# Do the next move
    282. 

  282.     }
    283. 

  283.     if {$S(mode) == $MSSTEP} {			;# Single step
    284. 

  284. 	set S(mode) $MPAUSE
    285. 

  285.     }
    286. 

  286.     if {$S(mode) == $MBSTEP && $n} {		;# Big step
    287. 

  287. 	set S(mode) $MSSTEP
    288. 

  288.     }
    289. 

  289. 

  290.     set elapsed [expr {[clock click -milliseconds] - $now}]
    291. 

  291.     set delay [expr {$speed($S(speed)) - $elapsed}]
    292. 

  292.     if {$delay <= 0} {
    293. 

  293. 	set delay 1
    294. 

  294.     }
    295. 

  295.     set animationCallbacks(goldberg) [after $delay [list Go $w]]
    296. 

  296. }
    297. 

  297. 

  298. # NextStep: drives the next step of the animation
    299. 

  299. proc NextStep {w} {
    300. 

  300.     global S MSTART MDONE
    301. 

  301.     set rval 0					;# Return value
    302. 

  302. 

  303.     if {$S(mode) != $MSTART && $S(mode) != $MDONE} {
    304. 

  304. 	incr S(cnt)
    305. 

  305.     }
    306. 

  306.     set alive {}
    307. 

  307.     foreach {who} $S(active) {
    308. 

  308. 	set n ["Move$who" $w]
    309. 

  309. 	if {$n & 1} {				;# This guy still alive
    310. 

  310. 	    lappend alive $who
    311. 

  311. 	}
    312. 

  312. 	if {$n & 2} {				;# Next guy is active
    313. 

  313. 	    lappend alive [expr {$who + 1}]
    314. 

  314. 	    set rval 1
    315. 

  315. 	}
    316. 

  316. 	if {$n & 4} {				;# End of puzzle flag
    317. 

  317. 	    set S(mode) $MDONE			;# Done mode
    318. 

  318. 	    set S(active) {}			;# No more animation
    319. 

  319. 	    return 1
    320. 

  320. 	}
    321. 

  321.     }
    322. 

  322.     set S(active) $alive
    323. 

  323.     return $rval
    324. 

  324. }
    325. 

  325. proc About {w} {
    326. 

  326.     set msg "$::S(title)\nby Keith Vetter, March 2003\n(Reproduced by kind\
    327. 

  327. 	    permission of the author)\n\n\"Man will always find a difficult\
    328. 

  328. 	    means to perform a simple task.\"\nRube Goldberg"
    329. 

  329.     tk_messageBox -parent $w -message $msg -title About
    330. 

  330. }
    331. 

  331. ################################################################
    332. 

  332. #
    333. 

  333. # All the drawing and moving routines
    334. 

  334. #
    335. 

  335. 

  336. # START HERE! banner
    337. 

  337. proc Draw0 {w} {
    338. 

  338.     set color $::C(0)
    339. 

  339.     set xy {579 119}
    340. 

  340.     $w.c create text $xy -text "START HERE!" -fill $color -anchor w \
    341. 

  341. 	    -tag I0 -font {{Times Roman} 12 italic bold}
    342. 

  342.     set xy {719 119 763 119}
    343. 

  343.     $w.c create line $xy -tag I0 -fill $color -width 5 -arrow last \
    344. 

  344. 	    -arrowshape {18 18 5}
    345. 

  345.     $w.c bind I0 <1> Start
    346. 

  346. }
    347. 

  347. proc Move0 {w {step {}}} {
    348. 

  348.     set step [GetStep 0 $step]
    349. 

  349. 

  350.     if {$::S(mode) > $::MSTART} {		;# Start the ball rolling
    351. 

  351. 	MoveAbs $w I0 {-100 -100}		;# Hide the banner
    352. 

  352. 	return 2
    353. 

  353.     }
    354. 

  354. 

  355.     set pos {
    356. 

  356. 	{673 119} {678 119} {683 119} {688 119}
    357. 

  357. 	{693 119} {688 119} {683 119} {678 119}
    358. 

  358.     }
    359. 

  359.     set step [expr {$step % [llength $pos]}]
    360. 

  360.     MoveAbs $w I0 [lindex $pos $step]
    361. 

  361.     return 1
    362. 

  362. }
    363. 

  363. 

  364. # Dropping ball
    365. 

  365. proc Draw1 {w} {
    366. 

  366.     set color $::C(1a)
    367. 

  367.     set color2 $::C(1b)
    368. 

  368.     set xy {844 133 800 133 800 346 820 346 820 168 844 168 844 133}
    369. 

  369.     $w.c create poly $xy -width 3 -fill $color -outline {}
    370. 

  370.     set xy {771 133 685 133 685 168 751 168 751 346 771 346 771 133}
    371. 

  371.     $w.c create poly $xy -width 3 -fill $color -outline {}
    372. 

  372. 

  373.     set xy [box 812 122 9]
    374. 

  374.     $w.c create oval $xy -tag I1 -fill $color2 -outline {}
    375. 

  375.     $w.c bind I1 <1> Start
    376. 

  376. }
    377. 

  377. proc Move1 {w {step {}}} {
    378. 

  378.     set step [GetStep 1 $step]
    379. 

  379.     set pos {
    380. 

  380. 	{807 122} {802 122} {797 123} {793 124} {789 129} {785 153}
    381. 

  381. 	{785 203} {785 278 x} {785 367} {810 392} {816 438} {821 503}
    382. 

  382. 	{824 585 y} {838 587} {848 593} {857 601} {-100 -100}
    383. 

  383.     }
    384. 

  384.     if {$step >= [llength $pos]} {
    385. 

  385. 	return 0
    386. 

  386.     }
    387. 

  387.     set where [lindex $pos $step]
    388. 

  388.     MoveAbs $w I1 $where
    389. 

  389. 

  390.     if {[lindex $where 2] eq "y"} {
    391. 

  391. 	Move15a $w
    392. 

  392.     }
    393. 

  393.     if {[lindex $where 2] eq "x"} {
    394. 

  394. 	return 3
    395. 

  395.     }
    396. 

  396.     return 1
    397. 

  397. }
    398. 

  398. 

  399. # Lighting the match
    400. 

  400. proc Draw2 {w} {
    401. 

  401.     set color red
    402. 

  402.     set color $::C(2)
    403. 

  403.     set xy  {750 369 740 392 760 392}		;# Fulcrum
    404. 

  404.     $w.c create poly $xy -fill $::C(fg) -outline $::C(fg)
    405. 

  405.     set xy {628 335 660 383}			;# Strike box
    406. 

  406.     $w.c create rect $xy -fill {} -outline $::C(fg)
    407. 

  407.     for {set y 0} {$y < 3} {incr y} {
    408. 

  408. 	set yy [expr {335+$y*16}]
    409. 

  409. 	$w.c create bitmap 628 $yy -bitmap gray25 -anchor nw \
    410. 

  410. 		-foreground $::C(fg)
    411. 

  411. 	$w.c create bitmap 644 $yy -bitmap gray25 -anchor nw \
    412. 

  412. 		-foreground $::C(fg)
    413. 

  413.     }
    414. 

  414. 

  415.     set xy {702 366 798 366}			;# Lever
    416. 

  416.     $w.c create line $xy -fill $::C(fg) -width 6 -tag I2_0
    417. 

  417.     set xy {712 363 712 355}			;# R strap
    418. 

  418.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I2_1
    419. 

  419.     set xy {705 363 705 355}			;# L strap
    420. 

  420.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I2_2
    421. 

  421.     set xy {679 356 679 360 717 360 717 356 679 356}	;# Match stick
    422. 

  422.     $w.c create line $xy -fill $::C(fg) -tag I2_3
    423. 

  423. 

  424.     #set xy {662 352 680 365}			;# Match head
    425. 

  425.     set xy {
    426. 

  426. 	671 352 677.4 353.9 680 358.5 677.4 363.1 671 365 664.6 363.1
    427. 

  427. 	662 358.5 664.6 353.9
    428. 

  428.     }
    429. 

  429.     $w.c create poly $xy -fill $color -outline $color -tag I2_4
    430. 

  430. }
    431. 

  431. proc Move2 {w {step {}}} {
    432. 

  432.     set step [GetStep 2 $step]
    433. 

  433. 

  434.     set stages {0 0 1 2 0 2 1 0 1 2 0 2 1}
    435. 

  435.     set xy(0) {
    436. 

  436. 	686 333 692 323 682 316 674 309 671 295 668 307 662 318 662 328
    437. 

  437. 	671 336
    438. 

  438.     }
    439. 

  439.     set xy(1) {687 331 698 322 703 295 680 320 668 297 663 311 661 327 671 335}
    440. 

  440.     set xy(2) {
    441. 

  441. 	686 331 704 322 688 300 678 283 678 283 674 298 666 309 660 324
    442. 

  442. 	672 336
    443. 

  443.     }
    444. 

  444. 

  445.     if {$step >= [llength $stages]} {
    446. 

  446. 	$w.c delete I2
    447. 

  447. 	return 0
    448. 

  448.     }
    449. 

  449. 

  450.     if {$step == 0} {				;# Rotate the match
    451. 

  451. 	set beta 20
    452. 

  452. 	lassign [Anchor $w I2_0 s] Ox Oy	;# Where to pivot
    453. 

  453. 	for {set i 0} {[$w.c find withtag I2_$i] ne ""} {incr i} {
    454. 

  454. 	    RotateItem $w I2_$i $Ox $Oy $beta
    455. 

  455. 	}
    456. 

  456. 	$w.c create poly -tag I2 -smooth 1 -fill $::C(2) ;# For the flame
    457. 

  457. 	return 1
    458. 

  458.     }
    459. 

  459.     $w.c coords I2 $xy([lindex $stages $step])
    460. 

  460.     return [expr {$step == 7 ? 3 : 1}]
    461. 

  461. }
    462. 

  462. 

  463. # Weight and pulleys
    464. 

  464. proc Draw3 {w} {
    465. 

  465.     set color $::C(3a)
    466. 

  466.     set color2 $::C(3b)
    467. 

  467. 

  468.     set xy {602 296 577 174 518 174}
    469. 

  469.     foreach {x y} $xy {				;# 3 Pulleys
    470. 

  470. 	$w.c create oval [box $x $y 13] -fill $color -outline $::C(fg) \
    471. 

  471. 		-width 3
    472. 

  472. 	$w.c create oval [box $x $y 2] -fill $::C(fg) -outline $::C(fg)
    473. 

  473.     }
    474. 

  474. 

  475.     set xy {750 309 670 309}			;# Wall to flame
    476. 

  476.     $w.c create line $xy -tag I3_s -width 3 -fill $::C(fg) -smooth 1
    477. 

  477.     set xy {670 309 650 309}			;# Flame to pulley 1
    478. 

  478.     $w.c create line $xy -tag I3_0 -width 3 -fill $::C(fg)
    479. 

  479.     set xy {650 309 600 309}			;# Flame to pulley 1
    480. 

  480.     $w.c create line $xy -tag I3_1 -width 3 -fill $::C(fg)
    481. 

  481.     set xy {589 296 589 235}			;# Pulley 1 half way to 2
    482. 

  482.     $w.c create line $xy -tag I3_2 -width 3 -fill $::C(fg)
    483. 

  483.     set xy {589 235 589 174}			;# Pulley 1 other half to 2
    484. 

  484.     $w.c create line $xy -width 3 -fill $::C(fg)
    485. 

  485.     set xy {577 161 518 161}			;# Across the top
    486. 

  486.     $w.c create line $xy -width 3 -fill $::C(fg)
    487. 

  487.     set xy {505 174 505 205}			;# Down to weight
    488. 

  488.     $w.c create line $xy -tag I3_w -width 3 -fill $::C(fg)
    489. 

  489. 

  490.     # Draw the weight as 2 circles, two rectangles and 1 rounded rectangle
    491. 

  491.     set xy {515 207 495 207}
    492. 

  492.     foreach {x1 y1 x2 y2} $xy {
    493. 

  493. 	$w.c create oval [box $x1 $y1 6] -tag I3_ -fill $color2 \
    494. 

  494. 		-outline $color2
    495. 

  495. 	$w.c create oval [box $x2 $y2 6] -tag I3_ -fill $color2 \
    496. 

  496. 		-outline $color2
    497. 

  497. 	incr y1 -6; incr y2 6
    498. 

  498. 	$w.c create rect $x1 $y1 $x2 $y2 -tag I3_ -fill $color2 \
    499. 

  499. 		-outline $color2
    500. 

  500.     }
    501. 

  501.     set xy {492 220 518 263}
    502. 

  502.     set xy [RoundRect $w $xy 15]
    503. 

  503.     $w.c create poly $xy -smooth 1 -tag I3_ -fill $color2 -outline $color2
    504. 

  504.     set xy {500 217 511 217}
    505. 

  505.     $w.c create line $xy -tag I3_ -fill $color2 -width 10
    506. 

  506. 

  507.     set xy {502 393 522 393 522 465}		;# Bottom weight target
    508. 

  508.     $w.c create line $xy -tag I3__ -fill $::C(fg) -join miter -width 10
    509. 

  509. }
    510. 

  510. proc Move3 {w {step {}}} {
    511. 

  511.     set step [GetStep 3 $step]
    512. 

  512. 

  513.     set pos {{505 247} {505 297} {505 386.5} {505 386.5}}
    514. 

  514.     set rope(0) {750 309 729 301 711 324 690 300}
    515. 

  515.     set rope(1) {750 309 737 292 736 335 717 315 712 320}
    516. 

  516.     set rope(2) {750 309 737 309 740 343 736 351 725 340}
    517. 

  517.     set rope(3) {750 309 738 321 746 345 742 356}
    518. 

  518. 

  519.     if {$step >= [llength $pos]} {
    520. 

  520. 	return 0
    521. 

  521.     }
    522. 

  522. 

  523.     $w.c delete "I3_$step"			;# Delete part of the rope
    524. 

  524.     MoveAbs $w I3_ [lindex $pos $step]		;# Move weight down
    525. 

  525.     $w.c coords I3_s $rope($step)		;# Flapping rope end
    526. 

  526.     $w.c coords I3_w [concat 505 174 [lindex $pos $step]]
    527. 

  527.     if {$step == 2} {
    528. 

  528. 	$w.c move I3__ 0 30
    529. 

  529. 	return 2
    530. 

  530.     }
    531. 

  531.     return 1
    532. 

  532. }
    533. 

  533. 

  534. # Cage and door
    535. 

  535. proc Draw4 {w} {
    536. 

  536.     set color $::C(4)
    537. 

  537.     lassign {527 356 611 464} x0 y0 x1 y1
    538. 

  538. 

  539.     for {set y $y0} {$y <= $y1} {incr y 12} {	;# Horizontal bars
    540. 

  540. 	$w.c create line $x0 $y $x1 $y -fill $color -width 1
    541. 

  541.     }
    542. 

  542.     for {set x $x0} {$x <= $x1} {incr x 12} {	;# Vertical bars
    543. 

  543. 	$w.c create line $x $y0 $x $y1 -fill $color -width 1
    544. 

  544.     }
    545. 

  545. 

  546.     set xy {518 464 518 428}			;# Swing gate
    547. 

  547.     $w.c create line $xy -tag I4 -fill $color -width 3
    548. 

  548. }
    549. 

  549. proc Move4 {w {step {}}} {
    550. 

  550.     set step [GetStep 4 $step]
    551. 

  551. 

  552.     set angles {-10 -20 -30 -30}
    553. 

  553.     if {$step >= [llength $angles]} {
    554. 

  554. 	return 0
    555. 

  555.     }
    556. 

  556.     RotateItem $w I4 518 464 [lindex $angles $step]
    557. 

  557.     $w.c raise I4
    558. 

  558.     return [expr {$step == 3 ? 3 : 1}]
    559. 

  559. }
    560. 

  560. 

  561. # Mouse
    562. 

  562. proc Draw5 {w} {
    563. 

  563.     set color $::C(5a)
    564. 

  564.     set color2 $::C(5b)
    565. 

  565.     set xy {377 248 410 248 410 465 518 465}	;# Mouse course
    566. 

  566.     lappend xy 518 428 451 428 451 212 377 212
    567. 

  567.     $w.c create poly $xy -fill $color2 -outline $::C(fg) -width 3
    568. 

  568. 

  569.     set xy {
    570. 

  570. 	534.5 445.5 541 440 552 436 560 436 569 440 574 446 575 452 574 454
    571. 

  571. 	566 456 554 456 545 456 537 454 530 452
    572. 

  572.     }
    573. 

  573.     $w.c create poly $xy -tag {I5 I5_0} -fill $color
    574. 

  574.     set xy {573 452 592 458 601 460 613 456}	;# Tail
    575. 

  575.     $w.c create line $xy -tag {I5 I5_1} -fill $color -smooth 1 -width 3
    576. 

  576.     set xy [box 540 446 2]			;# Eye
    577. 

  577.     set xy {540 444 541 445 541 447 540 448 538 447 538 445}
    578. 

  578.     #.c create oval $xy -tag {I5 I5_2} -fill $::C(bg) -outline {}
    579. 

  579.     $w.c create poly $xy -tag {I5 I5_2} -fill $::C(bg) -outline {} -smooth 1
    580. 

  580.     set xy {538 454 535 461}			;# Front leg
    581. 

  581.     $w.c create line $xy -tag {I5 I5_3} -fill $color -width 2
    582. 

  582.     set xy {566 455 569 462}			;# Back leg
    583. 

  583.     $w.c create line $xy -tag {I5 I5_4} -fill $color -width 2
    584. 

  584.     set xy {544 455 545 460}			;# 2nd front leg
    585. 

  585.     $w.c create line $xy -tag {I5 I5_5} -fill $color -width 2
    586. 

  586.     set xy {560 455 558 460}			;# 2nd back leg
    587. 

  587.     $w.c create line $xy -tag {I5 I5_6}	 -fill $color -width 2
    588. 

  588. }
    589. 

  589. proc Move5 {w {step {}}} {
    590. 

  590.     set step [GetStep 5 $step]
    591. 

  591. 

  592.     set pos {
    593. 

  593. 	{553 452} {533 452} {513 452} {493 452} {473 452}
    594. 

  594. 	{463 442 30} {445.5 441.5 30} {425.5 434.5 30} {422 414} {422 394}
    595. 

  595. 	{422 374} {422 354} {422 334} {422 314} {422 294}
    596. 

  596. 	{422 274 -30} {422 260.5 -30 x} {422.5 248.5 -28} {425 237}
    597. 

  597.     }
    598. 

  598.     if {$step >= [llength $pos]} {
    599. 

  599. 	return 0
    600. 

  600.     }
    601. 

  601. 

  602.     lassign [lindex $pos $step] x y beta next
    603. 

  603.     MoveAbs $w I5 [list $x $y]
    604. 

  604.     if {$beta ne ""} {
    605. 

  605. 	lassign [Centroid $w I5_0] Ox Oy
    606. 

  606. 	foreach id {0 1 2 3 4 5 6} {
    607. 

  607. 	    RotateItem $w I5_$id $Ox $Oy $beta
    608. 

  608. 	}
    609. 

  609.     }
    610. 

  610.     if {$next eq "x"} {
    611. 

  611. 	return 3
    612. 

  612.     }
    613. 

  613.     return 1
    614. 

  614. }
    615. 

  615. 

  616. # Dropping gumballs
    617. 

  617. array set XY6 {
    618. 

  618.     -1 {366 207} -2 {349 204} -3 {359 193} -4 {375 192} -5 {340 190}
    619. 

  619.     -6 {349 177} -7 {366 177} -8 {380 176} -9 {332 172} -10 {342 161}
    620. 

  620.     -11 {357 164} -12 {372 163} -13 {381 149} -14 {364 151} -15 {349 146}
    621. 

  621.     -16 {333 148} 0 {357 219}
    622. 

  622.     1 {359 261} 2 {359 291} 3 {359 318}	 4 {361 324}  5 {365 329}  6 {367 334}
    623. 

  623.     7 {367 340} 8 {366 346} 9 {364 350} 10 {361 355} 11 {359 370} 12 {359 391}
    624. 

  624.     13,0 {360 456}  13,1 {376 456}  13,2 {346 456}  13,3 {330 456}
    625. 

  625.     13,4 {353 444}  13,5 {368 443}  13,6 {339 442}  13,7 {359 431}
    626. 

  626.     13,8 {380 437}  13,9 {345 428}  13,10 {328 434} 13,11 {373 424}
    627. 

  627.     13,12 {331 420} 13,13 {360 417} 13,14 {345 412} 13,15 {376 410}
    628. 

  628.     13,16 {360 403}
    629. 

  629. }
    630. 

  630. proc Draw6 {w} {
    631. 

  631.     set color $::C(6)
    632. 

  632.     set xy {324 130 391 204}			;# Ball holder
    633. 

  633.     set xy [RoundRect $w $xy 10]
    634. 

  634.     $w.c create poly $xy -smooth 1 -outline $::C(fg) -width 3 -fill $color
    635. 

  635.     set xy {339 204 376 253}			;# Below the ball holder
    636. 

  636.     $w.c create rect $xy -fill {} -outline $::C(fg) -width 3 -fill $color \
    637. 

  637. 	    -tag I6c
    638. 

  638.     set xy [box 346 339 28]
    639. 

  639.     $w.c create oval $xy -fill $color -outline {}	;# Rotor
    640. 

  640.     $w.c create arc $xy -outline $::C(fg) -width 2 -style arc \
    641. 

  641. 	    -start 80 -extent 205
    642. 

  642.     $w.c create arc $xy -outline $::C(fg) -width 2 -style arc \
    643. 

  643. 	    -start -41 -extent 85
    644. 

  644. 

  645.     set xy [box 346 339 15]			;# Center of rotor
    646. 

  646.     $w.c create oval $xy -outline $::C(fg) -fill $::C(fg) -tag I6m
    647. 

  647.     set xy {352 312 352 254 368 254 368 322}	;# Top drop to rotor
    648. 

  648.     $w.c create poly $xy -fill $color -outline {}
    649. 

  649.     $w.c create line $xy -fill $::C(fg) -width 2
    650. 

  650. 

  651.     set xy {353 240 367 300}			;# Poke bottom hole
    652. 

  652.     $w.c create rect $xy -fill $color -outline {}
    653. 

  653.     set xy {341 190 375 210}			;# Poke another hole
    654. 

  654.     $w.c create rect $xy -fill $color -outline {}
    655. 

  655. 

  656.     set xy {368 356 368 403 389 403 389 464 320 464 320 403 352 403 352 366}
    657. 

  657.     $w.c create poly $xy -fill $color -outline {} -width 2	;# Below rotor
    658. 

  658.     $w.c create line $xy -fill $::C(fg) -width 2
    659. 

  659.     set xy [box 275 342 7]			;# On/off rotor
    660. 

  660.     $w.c create oval $xy -outline $::C(fg) -fill $::C(fg)
    661. 

  661.     set xy {276 334 342 325}			;# Fan belt top
    662. 

  662.     $w.c create line $xy -fill $::C(fg) -width 3
    663. 

  663.     set xy {276 349 342 353}			;# Fan belt bottom
    664. 

  664.     $w.c create line $xy -fill $::C(fg) -width 3
    665. 

  665. 

  666.     set xy {337 212 337 247}			;# What the mouse pushes
    667. 

  667.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I6_
    668. 

  668.     set xy {392 212 392 247}
    669. 

  669.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I6_
    670. 

  670.     set xy {337 230 392 230}
    671. 

  671.     $w.c create line $xy -fill $::C(fg) -width 7 -tag I6_
    672. 

  672. 

  673.     set who -1					;# All the balls
    674. 

  674.     set colors {red cyan orange green blue darkblue}
    675. 

  675.     lappend colors {*}$colors {*}$colors
    676. 

  676. 

  677.     for {set i 0} {$i < 17} {incr i} {
    678. 

  678. 	set loc [expr {-1 * $i}]
    679. 

  679. 	set color [lindex $colors $i]
    680. 

  680. 	$w.c create oval [box {*}$::XY6($loc) 5] -fill $color \
    681. 

  681. 		-outline $color -tag I6_b$i
    682. 

  682.     }
    683. 

  683.     Draw6a $w 12				;# The wheel
    684. 

  684. }
    685. 

  685. proc Draw6a {w beta} {
    686. 

  686.     $w.c delete I6_0
    687. 

  687.     lassign {346 339} Ox Oy
    688. 

  688.     for {set i 0} {$i < 4} {incr i} {
    689. 

  689. 	set b [expr {$beta + $i * 45}]
    690. 

  690. 	lassign [RotateC 28 0 0 0 $b] x y
    691. 

  691. 	set xy [list [expr {$Ox+$x}] [expr {$Oy+$y}] \
    692. 

  692. 		[expr {$Ox-$x}] [expr {$Oy-$y}]]
    693. 

  693. 	$w.c create line $xy -tag I6_0 -fill $::C(fg) -width 2
    694. 

  694.     }
    695. 

  695. }
    696. 

  696. proc Move6 {w {step {}}} {
    697. 

  697.     set step [GetStep 6 $step]
    698. 

  698.     if {$step > 62} {
    699. 

  699. 	return 0
    700. 

  700.     }
    701. 

  701. 

  702.     if {$step < 2} {				;# Open gate for balls to drop
    703. 

  703. 	$w.c move I6_ -7 0
    704. 

  704. 	if {$step == 1} {			;# Poke a hole
    705. 

  705. 	    set xy {348 226 365 240}
    706. 

  706. 	    $w.c create rect $xy -fill [$w.c itemcget I6c -fill] -outline {}
    707. 

  707. 	}
    708. 

  708. 	return 1
    709. 

  709.     }
    710. 

  710. 

  711.     set s [expr {$step - 1}]			;# Do the gumball drop dance
    712. 

  712.     for {set i 0} {$i <= int(($s-1) / 3)} {incr i} {
    713. 

  713. 	set tag "I6_b$i"
    714. 

  714. 	if {[$w.c find withtag $tag] eq ""} break
    715. 

  715. 	set loc [expr {$s - 3 * $i}]
    716. 

  716. 

  717. 	if {[info exists ::XY6($loc,$i)]} {
    718. 

  718. 	    MoveAbs $w $tag $::XY6($loc,$i)
    719. 

  719. 	} elseif {[info exists ::XY6($loc)]} {
    720. 

  720. 	    MoveAbs $w $tag $::XY6($loc)
    721. 

  721. 	}
    722. 

  722.     }
    723. 

  723.     if {($s % 3) == 1} {
    724. 

  724. 	set first [expr {($s + 2) / 3}]
    725. 

  725. 	for {set i $first} {1} {incr i} {
    726. 

  726. 	    set tag "I6_b$i"
    727. 

  727. 	    if {[$w.c find withtag $tag] eq ""} break
    728. 

  728. 	    set loc [expr {$first - $i}]
    729. 

  729. 	    MoveAbs $w $tag $::XY6($loc)
    730. 

  730. 	}
    731. 

  731.     }
    732. 

  732.     if {$s >= 3} {				;# Rotate the motor
    733. 

  733. 	set idx [expr {$s % 3}]
    734. 

  734. 	#Draw6a $w [lindex {12 35 64} $idx]
    735. 

  735. 	Draw6a $w [expr {12 + $s * 15}]
    736. 

  736.     }
    737. 

  737.     return [expr {$s == 3 ? 3 : 1}]
    738. 

  738. }
    739. 

  739. 

  740. # On/off switch
    741. 

  741. proc Draw7 {w} {
    742. 

  742.     set color $::C(7)
    743. 

  743.     set xy {198 306 277 374}			;# Box
    744. 

  744.     $w.c create rect $xy -outline $::C(fg) -width 2 -fill $color -tag I7z
    745. 

  745.     $w.c lower I7z
    746. 

  746.     set xy {275 343 230 349}
    747. 

  747.     $w.c create line $xy -tag I7 -fill $::C(fg) -arrow last \
    748. 

  748. 	    -arrowshape {23 23 8} -width 6
    749. 

  749.     set xy {225 324}				;# On button
    750. 

  750.     $w.c create oval [box {*}$xy 3] -fill $::C(fg) -outline $::C(fg)
    751. 

  751.     set xy {218 323}				;# On text
    752. 

  752.     set font {{Times Roman} 8}
    753. 

  753.     $w.c create text $xy -text "on" -anchor e -fill $::C(fg) -font $font
    754. 

  754.     set xy {225 350}				;# Off button
    755. 

  755.     $w.c create oval [box {*}$xy 3] -fill $::C(fg) -outline $::C(fg)
    756. 

  756.     set xy {218 349}				;# Off button
    757. 

  757.     $w.c create text $xy -text "off" -anchor e -fill $::C(fg) -font $font
    758. 

  758. }
    759. 

  759. proc Move7 {w {step {}}} {
    760. 

  760.     set step [GetStep 7 $step]
    761. 

  761.     set numsteps 30
    762. 

  762.     if {$step > $numsteps} {
    763. 

  763. 	return 0
    764. 

  764.     }
    765. 

  765.     set beta [expr {30.0 / $numsteps}]
    766. 

  766.     RotateItem $w I7 275 343 $beta
    767. 

  767. 

  768.     return [expr {$step == $numsteps ? 3 : 1}]
    769. 

  769. }
    770. 

  770. 

  771. # Electricity to the fan
    772. 

  772. proc Draw8 {w} {
    773. 

  773.     Sine $w 271 248 271 306 5 8 -tag I8_s -fill $::C(8) -width 3
    774. 

  774. }
    775. 

  775. proc Move8 {w {step {}}} {
    776. 

  776.     set step [GetStep 8 $step]
    777. 

  777. 

  778.     if {$step > 3} {
    779. 

  779. 	return 0
    780. 

  780.     }
    781. 

  781.     if {$step == 0} {
    782. 

  782. 	Sparkle $w [Anchor $w I8_s s] I8
    783. 

  783. 	return 1
    784. 

  784. 

  785.     } elseif {$step == 1} {
    786. 

  786. 	MoveAbs $w I8 [Anchor $w I8_s c]
    787. 

  787.     } elseif {$step == 2} {
    788. 

  788. 	MoveAbs $w I8 [Anchor $w I8_s n]
    789. 

  789.     } else {
    790. 

  790. 	$w.c delete I8
    791. 

  791.     }
    792. 

  792.     return [expr {$step == 2 ? 3 : 1}]
    793. 

  793. }
    794. 

  794. 

  795. # Fan
    796. 

  796. proc Draw9 {w} {
    797. 

  797.     set color $::C(9)
    798. 

  798.     set xy {266 194 310 220}
    799. 

  799.     $w.c create oval $xy -outline $color -fill $color
    800. 

  800.     set xy {280 209 296 248}
    801. 

  801.     $w.c create oval $xy -outline $color -fill $color
    802. 

  802.     set xy {288 249 252 249 260 240 280 234 296 234 316 240 324 249 288 249}
    803. 

  803.     $w.c create poly $xy -fill $color -smooth 1
    804. 

  804. 

  805.     set xy {248 205 265 214 264 205 265 196}	;# Spinner
    806. 

  806.     $w.c create poly $xy -fill $color
    807. 

  807. 

  808.     set xy {255 206 265 234}			;# Fan blades
    809. 

  809.     $w.c create oval $xy -fill {} -outline $::C(fg) -width 3 -tag I9_0
    810. 

  810.     set xy {255 176 265 204}
    811. 

  811.     $w.c create oval $xy -fill {} -outline $::C(fg) -width 3 -tag I9_0
    812. 

  812.     set xy {255 206 265 220}
    813. 

  813.     $w.c create oval $xy -fill {} -outline $::C(fg) -width 1 -tag I9_1
    814. 

  814.     set xy {255 190 265 204}
    815. 

  815.     $w.c create oval $xy -fill {} -outline $::C(fg) -width 1 -tag I9_1
    816. 

  816. }
    817. 

  817. proc Move9 {w {step {}}} {
    818. 

  818.     set step [GetStep 9 $step]
    819. 

  819. 

  820.     if {$step & 1} {
    821. 

  821. 	$w.c itemconfig I9_0 -width 4
    822. 

  822. 	$w.c itemconfig I9_1 -width 1
    823. 

  823. 	$w.c lower I9_1 I9_0
    824. 

  824.     } else {
    825. 

  825. 	$w.c itemconfig I9_0 -width 1
    826. 

  826. 	$w.c itemconfig I9_1 -width 4
    827. 

  827. 	$w.c lower I9_0 I9_1
    828. 

  828.     }
    829. 

  829.     if {$step == 0} {
    830. 

  830. 	return 3
    831. 

  831.     }
    832. 

  832.     return 1
    833. 

  833. }
    834. 

  834. 

  835. # Boat
    836. 

  836. proc Draw10 {w} {
    837. 

  837.     set color $::C(10a)
    838. 

  838.     set color2 $::C(10b)
    839. 

  839.     set xy {191 230 233 230 233 178 191 178}	;# Sail
    840. 

  840.     $w.c create poly $xy -fill $color -width 3 -outline $::C(fg) -tag I10
    841. 

  841.     set xy [box 209 204 31]			;# Front
    842. 

  842.     $w.c create arc $xy -outline {} -fill $color -style pie \
    843. 

  843. 	    -start 120 -extent 120 -tag I10
    844. 

  844.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
    845. 

  845. 	    -start 120 -extent 120 -tag I10
    846. 

  846.     set xy [box 249 204 31]			;# Back
    847. 

  847.     $w.c create arc $xy -outline {} -fill $::C(bg) -width 3 -style pie \
    848. 

  848. 	    -start 120 -extent 120 -tag I10
    849. 

  849.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
    850. 

  850. 	    -start 120 -extent 120 -tag I10
    851. 

  851. 

  852.     set xy {200 171 200 249}			;# Mast
    853. 

  853.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I10
    854. 

  854.     set xy {159 234 182 234}			;# Bow sprit
    855. 

  855.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I10
    856. 

  856.     set xy {180 234 180 251 220 251}		;# Hull
    857. 

  857.     $w.c create line $xy -fill $::C(fg) -width 6 -tag I10
    858. 

  858. 

  859.     set xy {92 255 221 255}			;# Waves
    860. 

  860.     Sine $w {*}$xy 2 25 -fill $color2 -width 1 -tag I10w
    861. 

  861. 

  862.     set xy [lrange [$w.c coords I10w] 4 end-4]	;# Water
    863. 

  863.     set xy [concat $xy 222 266 222 277 99 277]
    864. 

  864.     $w.c create poly $xy -fill $color2 -outline $color2
    865. 

  865.     set xy {222 266 222 277 97 277 97 266}	;# Water bottom
    866. 

  866.     $w.c create line $xy -fill $::C(fg) -width 3
    867. 

  867. 

  868.     set xy [box 239 262 17]
    869. 

  869.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
    870. 

  870. 	    -start 95 -extent 103
    871. 

  871.     set xy [box 76 266 21]
    872. 

  872.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc -extent 190
    873. 

  873. }
    874. 

  874. proc Move10 {w {step {}}} {
    875. 

  875.     set step [GetStep 10 $step]
    876. 

  876.     set pos {
    877. 

  877. 	{195 212} {193 212} {190 212} {186 212} {181 212} {176 212}
    878. 

  878. 	{171 212} {166 212} {161 212} {156 212} {151 212} {147 212} {142 212}
    879. 

  879. 	{137 212} {132 212 x} {127 212} {121 212} {116 212} {111 212}
    880. 

  880.     }
    881. 

  881. 

  882.     if {$step >= [llength $pos]} {
    883. 

  883. 	return 0
    884. 

  884.     }
    885. 

  885.     set where [lindex $pos $step]
    886. 

  886.     MoveAbs $w I10 $where
    887. 

  887. 

  888.     if {[lindex $where 2] eq "x"} {
    889. 

  889. 	return 3
    890. 

  890.     }
    891. 

  891.     return 1
    892. 

  892. }
    893. 

  893. 

  894. # 2nd ball drop
    895. 

  895. proc Draw11 {w} {
    896. 

  896.     set color $::C(11a)
    897. 

  897.     set color2 $::C(11b)
    898. 

  898.     set xy {23 264 55 591}			;# Color the down tube
    899. 

  899.     $w.c create rect $xy -fill $color -outline {}
    900. 

  900.     set xy [box 71 460 48]			;# Color the outer loop
    901. 

  901.     $w.c create oval $xy -fill $color -outline {}
    902. 

  902. 

  903.     set xy {55 264 55 458}			;# Top right side
    904. 

  904.     $w.c create line $xy -fill $::C(fg) -width 3
    905. 

  905.     set xy {55 504 55 591}			;# Bottom right side
    906. 

  906.     $w.c create line $xy -fill $::C(fg) -width 3
    907. 

  907.     set xy [box 71 460 48]			;# Outer loop
    908. 

  908.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
    909. 

  909. 	    -start 110 -extent -290 -tag I11i
    910. 

  910.     set xy [box 71 460 16]			;# Inner loop
    911. 

  911.     $w.c create oval $xy -outline $::C(fg) -fill {} -width 3 -tag I11i
    912. 

  912.     $w.c create oval $xy -outline $::C(fg) -fill $::C(bg) -width 3
    913. 

  913. 

  914.     set xy {23 264 23 591}			;# Left side
    915. 

  915.     $w.c create line $xy -fill $::C(fg) -width 3
    916. 

  916.     set xy [box 1 266 23]			;# Top left curve
    917. 

  917.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc -extent 90
    918. 

  918. 

  919.     set xy [box 75 235 9]			;# The ball
    920. 

  920.     $w.c create oval $xy -fill $color2 -outline {} -width 3 -tag I11
    921. 

  921. }
    922. 

  922. proc Move11 {w {step {}}} {
    923. 

  923.     set step [GetStep 11 $step]
    924. 

  924.     set pos {
    925. 

  925. 	{75 235} {70 235} {65 237} {56 240} {46 247} {38 266} {38 296}
    926. 

  926. 	{38 333} {38 399} {38 475} {74 496} {105 472} {100 437} {65 423}
    927. 

  927. 	{-100 -100} {38 505} {38 527 x} {38 591}
    928. 

  928.     }
    929. 

  929. 

  930.     if {$step >= [llength $pos]} {
    931. 

  931. 	return 0
    932. 

  932.     }
    933. 

  933.     set where [lindex $pos $step]
    934. 

  934.     MoveAbs $w I11 $where
    935. 

  935.     if {[lindex $where 2] eq "x"} {
    936. 

  936. 	return 3
    937. 

  937.     }
    938. 

  938.     return 1
    939. 

  939. }
    940. 

  940. 

  941. # Hand
    942. 

  942. proc Draw12 {w} {
    943. 

  943.     set xy {20 637 20 617 20 610 20 590 40 590 40 590 60 590 60 610 60 610}
    944. 

  944.     lappend xy 60 610 65 620 60 631		;# Thumb
    945. 

  945.     lappend xy 60 631 60 637 60 662 60 669 52 669 56 669 50 669 50 662 50 637
    946. 

  946. 

  947.     set y0 637					;# Bumps for fingers
    948. 

  948.     set y1 645
    949. 

  949.     for {set x 50} {$x > 20} {incr x -10} {
    950. 

  950. 	set x1 [expr {$x - 5}]
    951. 

  951. 	set x2 [expr {$x - 10}]
    952. 

  952. 	lappend xy $x $y0 $x1 $y1 $x2 $y0
    953. 

  953.     }
    954. 

  954.     $w.c create poly $xy -fill $::C(12) -outline $::C(fg) -smooth 1 -tag I12 \
    955. 

  955. 	    -width 3
    956. 

  956. }
    957. 

  957. proc Move12 {w {step {}}} {
    958. 

  958.     set step [GetStep 12 $step]
    959. 

  959.     set pos {{42.5 641 x}}
    960. 

  960.     if {$step >= [llength $pos]} {
    961. 

  961. 	return 0
    962. 

  962.     }
    963. 

  963. 

  964.     set where [lindex $pos $step]
    965. 

  965.     MoveAbs $w I12 $where
    966. 

  966.     if {[lindex $where 2] eq "x"} {
    967. 

  967. 	return 3
    968. 

  968.     }
    969. 

  969.     return 1
    970. 

  970. }
    971. 

  971. 

  972. # Fax
    973. 

  973. proc Draw13 {w} {
    974. 

  974.     set color $::C(13a)
    975. 

  975.     set xy {86 663 149 663 149 704 50 704 50 681 64 681 86 671}
    976. 

  976.     set xy2 {784 663 721 663 721 704 820 704 820 681 806 681 784 671}
    977. 

  977.     set radii {2 9 9 8 5 5 2}
    978. 

  978. 

  979.     RoundPoly $w.c $xy $radii -width 3 -outline $::C(fg) -fill $color
    980. 

  980.     RoundPoly $w.c $xy2 $radii -width 3 -outline $::C(fg) -fill $color
    981. 

  981. 

  982.     set xy {56 677}
    983. 

  983.     $w.c create rect [box {*}$xy 4] -fill {} -outline $::C(fg) -width 3 \
    984. 

  984. 	    -tag I13
    985. 

  985.     set xy {809 677}
    986. 

  986.     $w.c create rect [box {*}$xy 4] -fill {} -outline $::C(fg) -width 3 \
    987. 

  987. 	    -tag I13R
    988. 

  988. 

  989.     set xy {112 687}				;# Label
    990. 

  990.     $w.c create text $xy -text "FAX" -fill $::C(fg) \
    991. 

  991. 	    -font {{Times Roman} 12 bold}
    992. 

  992.     set xy {762 687}
    993. 

  993.     $w.c create text $xy -text "FAX" -fill $::C(fg) \
    994. 

  994. 	    -font {{Times Roman} 12 bold}
    995. 

  995. 

  996.     set xy {138 663 148 636 178 636}		;# Paper guide
    997. 

  997.     $w.c create line $xy -smooth 1 -fill $::C(fg) -width 3
    998. 

  998.     set xy {732 663 722 636 692 636}
    999. 

  999.     $w.c create line $xy -smooth 1 -fill $::C(fg) -width 3
    1000. 

  1000. 

  1001.     Sine $w 149 688 720 688 5 15 -tag I13_s -fill $::C(fg) -width 3
    1002. 

  1002. }
    1003. 

  1003. proc Move13 {w {step {}}} {
    1004. 

  1004.     set step [GetStep 13 $step]
    1005. 

  1005.     set numsteps 7
    1006. 

  1006. 

  1007.     if {$step == $numsteps+2} {
    1008. 

  1008. 	MoveAbs $w I13_star {-100 -100}
    1009. 

  1009. 	$w.c itemconfig I13R -fill $::C(13b) -width 2
    1010. 

  1010. 	return 2
    1011. 

  1011.     }
    1012. 

  1012.     if {$step == 0} {				;# Button down
    1013. 

  1013. 	$w.c delete I13
    1014. 

  1014. 	Sparkle $w {-100 -100} I13_star		;# Create off screen
    1015. 

  1015. 	return 1
    1016. 

  1016.     }
    1017. 

  1017.     lassign [Anchor $w I13_s w] x0 y0
    1018. 

  1018.     lassign [Anchor $w I13_s e] x1 y1
    1019. 

  1019.     set x [expr {$x0 + ($x1-$x0) * ($step - 1) / double($numsteps)}]
    1020. 

  1020.     MoveAbs $w I13_star [list $x $y0]
    1021. 

  1021.     return 1
    1022. 

  1022. }
    1023. 

  1023. 

  1024. # Paper in fax
    1025. 

  1025. proc Draw14 {w} {
    1026. 

  1026.     set color $::C(14)
    1027. 

  1027.     set xy {102 661 113 632 130 618}		;# Left paper edge
    1028. 

  1028.     $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14L_0
    1029. 

  1029.     set xy {148 629 125 640 124 662}		;# Right paper edge
    1030. 

  1030.     $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14L_1
    1031. 

  1031.     Draw14a $w L
    1032. 

  1032. 

  1033.     set xy {
    1034. 

  1034. 	768.0 662.5 767.991316225 662.433786215 767.926187912 662.396880171
    1035. 

  1035.     }
    1036. 

  1036.     $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14R_0
    1037. 

  1037.     $w.c lower I14R_0
    1038. 

  1038.     # NB. these numbers are VERY sensitive, you must start with final size
    1039. 

  1039.     # and shrink down to get the values
    1040. 

  1040.     set xy {
    1041. 

  1041. 	745.947897349 662.428358855 745.997829056 662.452239237 746.0 662.5
    1042. 

  1042.     }
    1043. 

  1043.     $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14R_1
    1044. 

  1044.     $w.c lower I14R_1
    1045. 

  1045. }
    1046. 

  1046. proc Draw14a {w side} {
    1047. 

  1047.     set color $::C(14)
    1048. 

  1048.     set xy [$w.c coords I14${side}_0]
    1049. 

  1049.     set xy2 [$w.c coords I14${side}_1]
    1050. 

  1050.     lassign $xy x0 y0 x1 y1 x2 y2
    1051. 

  1051.     lassign $xy2 x3 y3 x4 y4 x5 y5
    1052. 

  1052.     set zz [concat \
    1053. 

  1053. 	    $x0 $y0 $x0 $y0 $xy $x2 $y2 $x2 $y2 \
    1054. 

  1054. 	    $x3 $y3 $x3 $y3 $xy2 $x5 $y5 $x5 $y5]
    1055. 

  1055.     $w.c delete I14$side
    1056. 

  1056.     $w.c create poly $zz -tag I14$side -smooth 1 -fill $color -outline $color \
    1057. 

  1057. 	    -width 3
    1058. 

  1058.     $w.c lower I14$side
    1059. 

  1059. }
    1060. 

  1060. proc Move14 {w {step {}}} {
    1061. 

  1061.     set step [GetStep 14 $step]
    1062. 

  1062. 

  1063.     # Paper going down
    1064. 

  1064.     set sc [expr {.9 - .05*$step}]
    1065. 

  1065.     if {$sc < .3} {
    1066. 

  1066. 	$w.c delete I14L
    1067. 

  1067. 	return 0
    1068. 

  1068.     }
    1069. 

  1069. 

  1070.     lassign [$w.c coords I14L_0] Ox Oy
    1071. 

  1071.     $w.c scale I14L_0 $Ox $Oy $sc $sc
    1072. 

  1072.     lassign [lrange [$w.c coords I14L_1] end-1 end] Ox Oy
    1073. 

  1073.     $w.c scale I14L_1 $Ox $Oy $sc $sc
    1074. 

  1074.     Draw14a $w L
    1075. 

  1075. 

  1076.     # Paper going up
    1077. 

  1077.     set sc [expr {.35 + .05*$step}]
    1078. 

  1078.     set sc [expr {1 / $sc}]
    1079. 

  1079. 

  1080.     lassign [$w.c coords I14R_0] Ox Oy
    1081. 

  1081.     $w.c scale I14R_0 $Ox $Oy $sc $sc
    1082. 

  1082.     lassign [lrange [$w.c coords I14R_1] end-1 end] Ox Oy
    1083. 

  1083.     $w.c scale I14R_1 $Ox $Oy $sc $sc
    1084. 

  1084.     Draw14a $w R
    1085. 

  1085. 

  1086.     return [expr {$step == 10 ? 3 : 1}]
    1087. 

  1087. }
    1088. 

  1088. 

  1089. # Light beam
    1090. 

  1090. proc Draw15 {w} {
    1091. 

  1091.     set color $::C(15a)
    1092. 

  1092.     set xy {824 599 824 585 820 585 829 585}
    1093. 

  1093.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I15a
    1094. 

  1094.     set xy {789 599 836 643}
    1095. 

  1095.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
    1096. 

  1096.     set xy {778 610 788 632}
    1097. 

  1097.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
    1098. 

  1098.     set xy {766 617 776 625}
    1099. 

  1099.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
    1100. 

  1100. 

  1101.     set xy {633 600 681 640}
    1102. 

  1102.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 3
    1103. 

  1103.     set xy {635 567 657 599}
    1104. 

  1104.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 2
    1105. 

  1105.     set xy {765 557 784 583}
    1106. 

  1106.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 2
    1107. 

  1107. 

  1108.     Sine $w 658 580 765 580 3 15 -tag I15_s -fill $::C(fg) -width 3
    1109. 

  1109. }
    1110. 

  1110. proc Move15a {w} {
    1111. 

  1111.     set color $::C(15b)
    1112. 

  1112.     $w.c scale I15a 824 599 1 .3		;# Button down
    1113. 

  1113.     set xy {765 621 681 621}
    1114. 

  1114.     $w.c create line $xy -dash "-" -width 3 -fill $color -tag I15
    1115. 

  1115. }
    1116. 

  1116. proc Move15 {w {step {}}} {
    1117. 

  1117.     set step [GetStep 15 $step]
    1118. 

  1118.     set numsteps 6
    1119. 

  1119. 

  1120.     if {$step == $numsteps+2} {
    1121. 

  1121. 	MoveAbs $w I15_star {-100 -100}
    1122. 

  1122. 	return 2
    1123. 

  1123.     }
    1124. 

  1124.     if {$step == 0} {				;# Break the light beam
    1125. 

  1125. 	Sparkle $w {-100 -100} I15_star
    1126. 

  1126. 	set xy {765 621 745 621}
    1127. 

  1127. 	$w.c coords I15 $xy
    1128. 

  1128. 	return 1
    1129. 

  1129.     }
    1130. 

  1130.     lassign [Anchor $w I15_s w] x0 y0
    1131. 

  1131.     lassign [Anchor $w I15_s e] x1 y1
    1132. 

  1132.     set x [expr {$x0 + ($x1-$x0) * ($step - 1) / double($numsteps)}]
    1133. 

  1133.     MoveAbs $w I15_star [list $x $y0]
    1134. 

  1134.     return 1
    1135. 

  1135. }
    1136. 

  1136. 

  1137. # Bell
    1138. 

  1138. proc Draw16 {w} {
    1139. 

  1139.     set color $::C(16)
    1140. 

  1140.     set xy {722 485 791 556}
    1141. 

  1141.     $w.c create rect $xy -fill {} -outline $::C(fg) -width 3
    1142. 

  1142.     set xy [box 752 515 25]			;# Bell
    1143. 

  1143.     $w.c create oval $xy -fill $color -outline black -tag I16b -width 2
    1144. 

  1144.     set xy [box 752 515 5]			;# Bell button
    1145. 

  1145.     $w.c create oval $xy -fill black -outline black -tag I16b
    1146. 

  1146. 

  1147.     set xy {784 523 764 549}			;# Clapper
    1148. 

  1148.     $w.c create line $xy -width 3 -tag I16c -fill $::C(fg)
    1149. 

  1149.     set xy [box 784 523 4]
    1150. 

  1150.     $w.c create oval $xy -fill $::C(fg) -outline $::C(fg) -tag I16d
    1151. 

  1151. }
    1152. 

  1152. proc Move16 {w {step {}}} {
    1153. 

  1153.     set step [GetStep 16 $step]
    1154. 

  1154. 

  1155.     # Note: we never stop
    1156. 

  1156.     lassign {760 553} Ox Oy
    1157. 

  1157.     if {$step & 1} {
    1158. 

  1158. 	set beta 12
    1159. 

  1159. 	$w.c move I16b 3 0
    1160. 

  1160.     } else {
    1161. 

  1161. 	set beta -12
    1162. 

  1162. 	$w.c move I16b -3 0
    1163. 

  1163.     }
    1164. 

  1164.     RotateItem $w I16c $Ox $Oy $beta
    1165. 

  1165.     RotateItem $w I16d $Ox $Oy $beta
    1166. 

  1166. 

  1167.     return [expr {$step == 1 ? 3 : 1}]
    1168. 

  1168. }
    1169. 

  1169. 

  1170. # Cat
    1171. 

  1171. proc Draw17 {w} {
    1172. 

  1172.     set color $::C(17)
    1173. 

  1173. 

  1174.     set xy {584 556 722 556}
    1175. 

  1175.     $w.c create line $xy -fill $::C(fg) -width 3
    1176. 

  1176.     set xy {584 485 722 485}
    1177. 

  1177.     $w.c create line $xy -fill $::C(fg) -width 3
    1178. 

  1178. 

  1179.     set xy {664 523 717 549}			;# Body
    1180. 

  1180.     $w.c create arc $xy -outline $::C(fg) -fill $color -width 3 \
    1181. 

  1181. 	    -style chord -start 128 -extent -260 -tag I17
    1182. 

  1182. 

  1183.     set xy {709 554 690 543}			;# Paw
    1184. 

  1184.     $w.c create oval $xy -outline $::C(fg) -fill $color -width 3 -tag I17
    1185. 

  1185.     set xy {657 544 676 555}
    1186. 

  1186.     $w.c create oval $xy -outline $::C(fg) -fill $color -width 3 -tag I17
    1187. 

  1187. 

  1188.     set xy [box 660 535 15]			;# Lower face
    1189. 

  1189.     $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \
    1190. 

  1190. 	    -start 150 -extent 240 -tag I17_
    1191. 

  1191.     $w.c create arc $xy -outline {} -fill $color -width 1 -style chord \
    1192. 

  1192. 	    -start 150 -extent 240 -tag I17_
    1193. 

  1193.     set xy {674 529 670 513 662 521 658 521 650 513 647 529}	;# Ears
    1194. 

  1194.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1195. 

  1195.     $w.c create poly $xy -fill $color -outline {} -width 1 -tag {I17_ I17_c}
    1196. 

  1196.     set xy {652 542 628 539}			;# Whiskers
    1197. 

  1197.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1198. 

  1198.     set xy {652 543 632 545}
    1199. 

  1199.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1200. 

  1200.     set xy {652 546 632 552}
    1201. 

  1201.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1202. 

  1202. 

  1203.     set xy {668 543 687 538}
    1204. 

  1204.     $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w}
    1205. 

  1205.     set xy {668 544 688 546}
    1206. 

  1206.     $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w}
    1207. 

  1207.     set xy {668 547 688 553}
    1208. 

  1208.     $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w}
    1209. 

  1209. 

  1210.     set xy {649 530 654 538 659 530}		;# Left eye
    1211. 

  1211.     $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17
    1212. 

  1212.     set xy {671 530 666 538 661 530}		;# Right eye
    1213. 

  1213.     $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17
    1214. 

  1214.     set xy {655 543 660 551 665 543}		;# Mouth
    1215. 

  1215.     $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17
    1216. 

  1216. }
    1217. 

  1217. proc Move17 {w {step {}}} {
    1218. 

  1218.     set step [GetStep 17 $step]
    1219. 

  1219. 

  1220.     if {$step == 0} {
    1221. 

  1221. 	$w.c delete I17				;# Delete most of the cat
    1222. 

  1222. 	set xy {655 543 660 535 665 543}	;# Mouth
    1223. 

  1223. 	$w.c create line $xy -fill $::C(fg) -width 3 -smooth 1 -tag I17_
    1224. 

  1224. 	set xy [box 654 530 4]			;# Left eye
    1225. 

  1225. 	$w.c create oval $xy -outline $::C(fg) -width 3 -fill {} -tag I17_
    1226. 

  1226. 	set xy [box 666 530 4]			;# Right eye
    1227. 

  1227. 	$w.c create oval $xy -outline $::C(fg) -width 3 -fill {} -tag I17_
    1228. 

  1228. 

  1229. 	$w.c move I17_ 0 -20			;# Move face up
    1230. 

  1230. 	set xy {652 528 652 554}		;# Front leg
    1231. 

  1231. 	$w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1232. 

  1232. 	set xy {670 528 670 554}		;# 2nd front leg
    1233. 

  1233. 	$w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1234. 

  1234. 

  1235. 	set xy {
    1236. 

  1236. 	    675 506 694 489 715 513 715 513 715 513 716 525 716 525 716 525
    1237. 

  1237. 	    706 530 695 530 679 535 668 527 668 527 668 527 675 522 676 517
    1238. 

  1238. 	    677 512
    1239. 

  1239. 	}					;# Body
    1240. 

  1240. 	$w.c create poly $xy -fill [$w.c itemcget I17_c -fill] \
    1241. 

  1241. 		-outline $::C(fg) -width 3 -smooth 1 -tag I17_
    1242. 

  1242. 	set xy {716 514 716 554}		;# Back leg
    1243. 

  1243. 	$w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1244. 

  1244. 	set xy {694 532 694 554}		;# 2nd back leg
    1245. 

  1245. 	$w.c create line $xy -fill $::C(fg) -width 3 -tag I17_
    1246. 

  1246. 	set xy {715 514 718 506 719 495 716 488};# Tail
    1247. 

  1247. 	$w.c create line $xy -fill $::C(fg) -width 3 -smooth 1 -tag I17_
    1248. 

  1248. 

  1249. 	$w.c raise I17w				;# Make whiskers visible
    1250. 

  1250. 	$w.c move I17_ -5 0			;# Move away from wall a bit
    1251. 

  1251. 	return 2
    1252. 

  1252.     }
    1253. 

  1253.     return 0
    1254. 

  1254. }
    1255. 

  1255. 

  1256. # Sling shot
    1257. 

  1257. proc Draw18 {w} {
    1258. 

  1258.     set color $::C(18)
    1259. 

  1259.     set xy {721 506 627 506}			;# Sling hold
    1260. 

  1260.     $w.c create line $xy -width 4 -fill $::C(fg) -tag I18
    1261. 

  1261. 

  1262.     set xy {607 500 628 513}			;# Sling rock
    1263. 

  1263.     $w.c create oval $xy -fill $color -outline {} -tag I18a
    1264. 

  1264. 

  1265.     set xy {526 513 606 507 494 502}		;# Sling band
    1266. 

  1266.     $w.c create line $xy -fill $::C(fg) -width 4 -tag I18b
    1267. 

  1267.     set xy { 485 490 510 540 510 575 510 540 535 491 }	;# Sling
    1268. 

  1268.     $w.c create line $xy -fill $::C(fg) -width 6
    1269. 

  1269. }
    1270. 

  1270. proc Move18 {w {step {}}} {
    1271. 

  1271.     set step [GetStep 18 $step]
    1272. 

  1272. 

  1273.     set pos {
    1274. 

  1274. 	{587 506} {537 506} {466 506} {376 506} {266 506 x} {136 506}
    1275. 

  1275. 	{16 506} {-100 -100}
    1276. 

  1276.     }
    1277. 

  1277. 

  1278.     set b(0) {490 502 719 507 524 512}		;# Band collapsing
    1279. 

  1279.     set b(1) {
    1280. 

  1280. 	491 503 524 557 563 505 559 496 546 506 551 525 553 536 538 534
    1281. 

  1281. 	532 519 529 499
    1282. 

  1282.     }
    1283. 

  1283.     set b(2) {491 503 508 563 542 533 551 526 561 539 549 550 530 500}
    1284. 

  1284.     set b(3) {491 503 508 563 530 554 541 562 525 568 519 544 530 501}
    1285. 

  1285. 

  1286.     if {$step >= [llength $pos]} {
    1287. 

  1287. 	return 0
    1288. 

  1288.     }
    1289. 

  1289. 

  1290.     if {$step == 0} {
    1291. 

  1291. 	$w.c delete I18
    1292. 

  1292. 	$w.c itemconfig I18b -smooth 1
    1293. 

  1293.     }
    1294. 

  1294.     if {[info exists b($step)]} {
    1295. 

  1295. 	$w.c coords I18b $b($step)
    1296. 

  1296.     }
    1297. 

  1297. 

  1298.     set where [lindex $pos $step]
    1299. 

  1299.     MoveAbs $w I18a $where
    1300. 

  1300.     if {[lindex $where 2] eq "x"} {
    1301. 

  1301. 	return 3
    1302. 

  1302.     }
    1303. 

  1303.     return 1
    1304. 

  1304. }
    1305. 

  1305. 

  1306. # Water pipe
    1307. 

  1307. proc Draw19 {w} {
    1308. 

  1308.     set color $::C(19)
    1309. 

  1309.     set xx {249 181 155 118  86 55 22 0}
    1310. 

  1310.     foreach {x1 x2} $xx {
    1311. 

  1311. 	$w.c create rect $x1 453 $x2 467 -fill $color -outline {} -tag I19
    1312. 

  1312. 	$w.c create line $x1 453 $x2 453 -fill $::C(fg) -width 1;# Pipe top
    1313. 

  1313. 	$w.c create line $x1 467 $x2 467 -fill $::C(fg) -width 1;# Pipe bottom
    1314. 

  1314.     }
    1315. 

  1315.     $w.c raise I11i
    1316. 

  1316. 

  1317.     set xy [box 168 460 16]			;# Bulge by the joint
    1318. 

  1318.     $w.c create oval $xy -fill $color -outline {}
    1319. 

  1319.     $w.c create arc $xy -outline $::C(fg) -width 1 -style arc \
    1320. 

  1320. 	    -start 21 -extent 136
    1321. 

  1321.     $w.c create arc $xy -outline $::C(fg) -width 1 -style arc \
    1322. 

  1322. 	    -start -21 -extent -130
    1323. 

  1323. 

  1324.     set xy {249 447 255 473}			;# First joint 26x6
    1325. 

  1325.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
    1326. 

  1326. 

  1327.     set xy [box 257 433 34]			;# Bend up
    1328. 

  1328.     $w.c create arc $xy -outline {} -fill $color -width 1 \
    1329. 

  1329. 	    -style pie -start 0 -extent -91
    1330. 

  1330.     $w.c create arc $xy -outline $::C(fg) -width 1 \
    1331. 

  1331. 	    -style arc -start 0 -extent -90
    1332. 

  1332.     set xy [box 257 433 20]
    1333. 

  1333.     $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \
    1334. 

  1334. 	    -style pie -start 0 -extent -92
    1335. 

  1335.     $w.c create arc $xy -outline $::C(fg) -width 1 \
    1336. 

  1336. 	    -style arc -start 0 -extent -90
    1337. 

  1337.     set xy [box 257 421 34]			;# Bend left
    1338. 

  1338.     $w.c create arc $xy -outline {} -fill $color -width 1 \
    1339. 

  1339. 	    -style pie -start 1 -extent 91
    1340. 

  1340.     $w.c create arc $xy -outline $::C(fg) -width 1 \
    1341. 

  1341. 	    -style arc -start 0 -extent 90
    1342. 

  1342.     set xy [box 257 421 20]
    1343. 

  1343.     $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \
    1344. 

  1344. 	    -style pie -start 0 -extent 90
    1345. 

  1345.     $w.c create arc $xy -outline $::C(fg) -width 1 \
    1346. 

  1346. 	    -style arc -start 0 -extent 90
    1347. 

  1347.     set xy [box 243 421 34]			;# Bend down
    1348. 

  1348.     $w.c create arc $xy -outline {} -fill $color -width 1 \
    1349. 

  1349. 	    -style pie -start 90 -extent 90
    1350. 

  1350.     $w.c create arc $xy -outline $::C(fg) -width 1 \
    1351. 

  1351. 	    -style arc -start 90 -extent 90
    1352. 

  1352.     set xy [box 243 421 20]
    1353. 

  1353.     $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \
    1354. 

  1354. 	    -style pie -start 90 -extent 90
    1355. 

  1355.     $w.c create arc $xy -outline $::C(fg) -width 1 \
    1356. 

  1356. 	    -style arc -start 90 -extent 90
    1357. 

  1357. 

  1358.     set xy {270 427 296 433}			;# 2nd joint bottom
    1359. 

  1359.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
    1360. 

  1360.     set xy {270 421 296 427}			;# 2nd joint top
    1361. 

  1361.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
    1362. 

  1362.     set xy {249 382 255 408}			;# Third joint right
    1363. 

  1363.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
    1364. 

  1364.     set xy {243 382 249 408}			;# Third joint left
    1365. 

  1365.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
    1366. 

  1366.     set xy {203 420 229 426}			;# Last joint
    1367. 

  1367.     $w.c create rect $xy -fill $color -outline $::C(fg) -width 1
    1368. 

  1368. 

  1369.     set xy [box 168 460 6]			;# Handle joint
    1370. 

  1370.     $w.c create oval $xy -fill $::C(fg) -outline {} -tag I19a
    1371. 

  1371.     set xy {168 460 168 512}			;# Handle bar
    1372. 

  1372.     $w.c create line $xy -fill $::C(fg) -width 5 -tag I19b
    1373. 

  1373. }
    1374. 

  1374. proc Move19 {w {step {}}} {
    1375. 

  1375.     set step [GetStep 19 $step]
    1376. 

  1376. 

  1377.     set angles {30 30 30}
    1378. 

  1378.     if {$step == [llength $angles]} {
    1379. 

  1379. 	return 2
    1380. 

  1380.     }
    1381. 

  1381. 

  1382.     RotateItem $w I19b {*}[Centroid $w I19a] [lindex $angles $step]
    1383. 

  1383.     return 1
    1384. 

  1384. }
    1385. 

  1385. 

  1386. # Water pouring
    1387. 

  1387. proc Draw20 {w} {
    1388. 

  1388. }
    1389. 

  1389. proc Move20 {w {step {}}} {
    1390. 

  1390.     set step [GetStep 20 $step]
    1391. 

  1391. 

  1392.     set pos {451 462 473 484 496 504 513 523 532}
    1393. 

  1393.     set freq {20 40   40  40  40  40  40  40  40}
    1394. 

  1394.     set pos {
    1395. 

  1395. 	{451 20} {462 40} {473 40} {484 40} {496 40} {504 40} {513 40}
    1396. 

  1396. 	{523 40} {532 40 x}
    1397. 

  1397.     }
    1398. 

  1398.     if {$step >= [llength $pos]} {
    1399. 

  1399. 	return 0
    1400. 

  1400.     }
    1401. 

  1401. 

  1402.     $w.c delete I20
    1403. 

  1403.     set where [lindex $pos $step]
    1404. 

  1404.     lassign $where y f
    1405. 

  1405.     H2O $w $y $f
    1406. 

  1406.     if {[lindex $where 2] eq "x"} {
    1407. 

  1407. 	return 3
    1408. 

  1408.     }
    1409. 

  1409.     return 1
    1410. 

  1410. }
    1411. 

  1411. proc H2O {w y f} {
    1412. 

  1412.     set color $::C(20)
    1413. 

  1413.     $w.c delete I20
    1414. 

  1414. 

  1415.     Sine $w 208 428 208 $y 4 $f -tag {I20 I20s} -width 3 -fill $color \
    1416. 

  1416. 	    -smooth 1
    1417. 

  1417.     $w.c create line [$w.c coords I20s] -width 3 -fill $color -smooth 1 \
    1418. 

  1418. 	    -tag {I20 I20a}
    1419. 

  1419.     $w.c create line [$w.c coords I20s] -width 3 -fill $color -smooth 1 \
    1420. 

  1420. 	    -tag {I20 I20b}
    1421. 

  1421.     $w.c move I20a 8 0
    1422. 

  1422.     $w.c move I20b 16 0
    1423. 

  1423. }
    1424. 

  1424. 

  1425. # Bucket
    1426. 

  1426. proc Draw21 {w} {
    1427. 

  1427.     set color $::C(21)
    1428. 

  1428.     set xy {217 451 244 490}			;# Right handle
    1429. 

  1429.     $w.c create line $xy -fill $::C(fg) -width 2 -tag I21_a
    1430. 

  1430.     set xy {201 467 182 490}			;# Left handle
    1431. 

  1431.     $w.c create line $xy -fill $::C(fg) -width 2 -tag I21_a
    1432. 

  1432. 

  1433.     set xy {245 490 237 535}			;# Right side
    1434. 

  1434.     set xy2 {189 535 181 490}			;# Left side
    1435. 

  1435.     $w.c create poly [concat $xy $xy2] -fill $color -outline {} \
    1436. 

  1436. 	    -tag {I21 I21f}
    1437. 

  1437.     $w.c create line $xy -fill $::C(fg) -width 2 -tag I21
    1438. 

  1438.     $w.c create line $xy2 -fill $::C(fg) -width 2 -tag I21
    1439. 

  1439. 

  1440.     set xy {182 486 244 498}			;# Top
    1441. 

  1441.     $w.c create oval $xy -fill $color -outline {} -width 2 -tag {I21 I21f}
    1442. 

  1442.     $w.c create oval $xy -fill {} -outline $::C(fg) -width 2 -tag {I21 I21t}
    1443. 

  1443.     set xy {189 532 237 540}			;# Bottom
    1444. 

  1444.     $w.c create oval $xy -fill $color -outline $::C(fg) -width 2 \
    1445. 

  1445. 	    -tag {I21 I21b}
    1446. 

  1446. }
    1447. 

  1447. proc Move21 {w {step {}}} {
    1448. 

  1448.     set step [GetStep 21 $step]
    1449. 

  1449. 

  1450.     set numsteps 30
    1451. 

  1451.     if {$step  >= $numsteps} {
    1452. 

  1452. 	return 0
    1453. 

  1453.     }
    1454. 

  1454. 

  1455.     lassign [$w.c coords I21b] x1 y1 x2 y2
    1456. 

  1456.     #lassign [$w.c coords I21t] X1 Y1 X2 Y2
    1457. 

  1457.     lassign {183 492 243 504} X1 Y1 X2 Y2
    1458. 

  1458. 

  1459.     set f [expr {$step / double($numsteps)}]
    1460. 

  1460.     set y2 [expr {$y2 - 3}]
    1461. 

  1461.     set xx1 [expr {$x1 + ($X1 - $x1) * $f}]
    1462. 

  1462.     set yy1 [expr {$y1 + ($Y1 - $y1) * $f}]
    1463. 

  1463.     set xx2 [expr {$x2 + ($X2 - $x2) * $f}]
    1464. 

  1464.     set yy2 [expr {$y2 + ($Y2 - $y2) * $f}]
    1465. 

  1465.     #H2O $w $yy1 40
    1466. 

  1466. 

  1467.     $w.c itemconfig I21b -fill $::C(20)
    1468. 

  1468.     $w.c delete I21w
    1469. 

  1469.     $w.c create poly $x2 $y2 $x1 $y1 $xx1 $yy1 $xx2 $yy1 -tag {I21 I21w} \
    1470. 

  1470. 	    -outline {} -fill $::C(20)
    1471. 

  1471.     $w.c lower I21w I21
    1472. 

  1472.     $w.c raise I21b
    1473. 

  1473.     $w.c lower I21f
    1474. 

  1474. 

  1475.     return [expr {$step == $numsteps-1 ? 3 : 1}]
    1476. 

  1476. }
    1477. 

  1477. 

  1478. # Bucket drop
    1479. 

  1479. proc Draw22 {w} {
    1480. 

  1480. }
    1481. 

  1481. proc Move22 {w {step {}}} {
    1482. 

  1482.     set step [GetStep 22 $step]
    1483. 

  1483.     set pos {{213 513} {213 523} {213 543 x} {213 583} {213 593}}
    1484. 

  1484. 

  1485.     if {$step == 0} {$w.c itemconfig I21f -fill $::C(22)}
    1486. 

  1486.     if {$step >= [llength $pos]} {
    1487. 

  1487. 	return 0
    1488. 

  1488.     }
    1489. 

  1489.     set where [lindex $pos $step]
    1490. 

  1490.     MoveAbs $w I21 $where
    1491. 

  1491.     H2O $w [lindex $where 1] 40
    1492. 

  1492.     $w.c delete I21_a				;# Delete handles
    1493. 

  1493. 

  1494.     if {[lindex $where 2] eq "x"} {
    1495. 

  1495. 	return 3
    1496. 

  1496.     }
    1497. 

  1497.     return 1
    1498. 

  1498. }
    1499. 

  1499. 

  1500. # Blow dart
    1501. 

  1501. proc Draw23 {w} {
    1502. 

  1502.     set color  $::C(23a)
    1503. 

  1503.     set color2 $::C(23b)
    1504. 

  1504.     set color3 $::C(23c)
    1505. 

  1505. 

  1506.     set xy {185 623 253 650}			;# Block
    1507. 

  1507.     $w.c create rect $xy -fill black -outline $::C(fg) -width 2 -tag I23a
    1508. 

  1508.     set xy {187 592 241 623}			;# Balloon
    1509. 

  1509.     $w.c create oval $xy -outline {} -fill $color -tag I23b
    1510. 

  1510.     $w.c create arc $xy -outline $::C(fg) -width 3 -tag I23b \
    1511. 

  1511. 	    -style arc -start 12 -extent 336
    1512. 

  1512.     set xy {239 604  258 589 258 625 239 610}	;# Balloon nozzle
    1513. 

  1513.     $w.c create poly $xy -outline {} -fill $color -tag I23b
    1514. 

  1514.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I23b
    1515. 

  1515. 

  1516.     set xy {285 611 250 603}			;# Dart body
    1517. 

  1517.     $w.c create oval $xy -fill $color2 -outline $::C(fg) -width 3 -tag I23d
    1518. 

  1518.     set xy {249 596 249 618 264 607 249 596}	;# Dart tail
    1519. 

  1519.     $w.c create poly $xy -fill $color3 -outline $::C(fg) -width 3 -tag I23d
    1520. 

  1520.     set xy {249 607 268 607}			;# Dart detail
    1521. 

  1521.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I23d
    1522. 

  1522.     set xy {285 607 305 607}			;# Dart needle
    1523. 

  1523.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I23d
    1524. 

  1524. }
    1525. 

  1525. proc Move23 {w {step {}}} {
    1526. 

  1526.     set step [GetStep 23 $step]
    1527. 

  1527. 

  1528.     set pos {
    1529. 

  1529. 	{277 607} {287 607} {307 607 x} {347 607} {407 607} {487 607}
    1530. 

  1530. 	{587 607} {687 607} {787 607} {-100 -100}
    1531. 

  1531.     }
    1532. 

  1532. 

  1533.     if {$step >= [llength $pos]} {
    1534. 

  1534. 	return 0
    1535. 

  1535.     }
    1536. 

  1536.     if {$step <= 1} {
    1537. 

  1537. 	$w.c scale I23b {*}[Anchor $w I23a n] .9 .5
    1538. 

  1538.     }
    1539. 

  1539.     set where [lindex $pos $step]
    1540. 

  1540.     MoveAbs $w I23d $where
    1541. 

  1541. 

  1542.     if {[lindex $where 2] eq "x"} {
    1543. 

  1543. 	return 3
    1544. 

  1544.     }
    1545. 

  1545.     return 1
    1546. 

  1546. }
    1547. 

  1547. 

  1548. # Balloon
    1549. 

  1549. proc Draw24 {w} {
    1550. 

  1550.     set color $::C(24a)
    1551. 

  1551.     set xy {366 518 462 665}			;# Balloon
    1552. 

  1552.     $w.c create oval $xy -fill $color -outline $::C(fg) -width 3 -tag I24
    1553. 

  1553.     set xy {414 666 414 729}			;# String
    1554. 

  1554.     $w.c create line $xy -fill $::C(fg) -width 3 -tag I24
    1555. 

  1555.     set xy {410 666 404 673 422 673 418 666}	;# Nozzle
    1556. 

  1556.     $w.c create poly $xy -fill $color -outline $::C(fg) -width 3 -tag I24
    1557. 

  1557. 

  1558.     set xy {387 567 390 549 404 542}		;# Reflections
    1559. 

  1559.     $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
    1560. 

  1560.     set xy {395 568 399 554 413 547}
    1561. 

  1561.     $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
    1562. 

  1562.     set xy {403 570 396 555 381 553}
    1563. 

  1563.     $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24
    1564. 

  1564.     set xy {408 564 402 547 386 545}
    1565. 

  1565.     $w.c create…
    1566.

Large files files are truncated, but you can click here to view the full file