**Intro**
[Keith Vetter] : 2006-08-24 : Have you ever wondered
how film is moved through a movie projector? <<br>>
It cannot be a continuous feed because each frame
must pause in front of the lens for 1/24 of a second.
Enter the '''Geneva Drive''', creating intermittent rotary motion
from continuous rotary motion. <<br>>
Also known as http://en.wikipedia.org/wiki/Geneva_drive%|%"Maltese Cross" Drive%|%
[WikiDbImage Geneva.jpg]
A couple of interesting technical points.
''First how do you create these complex shapes?''
The central gear could be drawn as a circle with a
pie-slice arc drawn with the background color on top of it.
But past experience has shown me that turning it into one polygon
is much better: outline and fills are simple and rotation is much simpler.
I used [Regular Polygons 2] to turn two arcs into coordinate lists
which I concatentated to form one polygon.
The upper, Maltese Cross shaped
[http://en.wikipedia.org/wiki/Maltese_cross] gear, is just the same shape,
with one arc and five lines, repeated four times each rotated 90 degrees.
So again I just concatenated several coordinate lists into one polygon.
''Second, how do you rotate the shapes?''
Now that the shapes are polygons, rotation is simple with [Canvas Rotation].
''Third, how do you figure out the (non-constant) rotation speed of
the Maltese Cross gear?''
I had naively thought that as the bottom gear sweeps out the top
90 degrees, the top gear would turn at the same rate.
Nope. I had to use vectors and the dot product to compute the angle between
the center of the gear and the driving peg, and rotate the gear to match up.
Check out wikipedia [http://en.wikipedia.org/wiki/Geneva_drive]
for more information on this cool device.
----
''Brilliant! -[jcw]''
----
[JAG] - Keith, '''very''' nice. Having a mechanical background,
I'm as fascinated with the device itself as I am with the Tcl code that models it.
Thanks for sharing.
----
[AMG]: http://kmoddl.library.cornell.edu/model.php?m=316
[AK]: Wow. That is an interesting site for all things Kinematic.
[AK]: Some pictures of real-life geneva drives:
* http://blog.makezine.com/archive/2010/01/geneva_wheels_on_thingiverse.html
* http://www.thingiverse.com/thing:1642
* http://www.thingiverse.com/thing:1616
[HJG]: See also [Scotch Yoke] and [Gear Animation]
----
[Jeff Smith] 2019-05-04 : Below is an online demo using [CloudTk]
'''Please Note''' : This demo has a run time of 2 minutes.
<<inlinehtml>>
<iframe height="650" width="600" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=Geneva-Drive" allowfullscreen></iframe>
<<inlinehtml>>
----
**Program**
======
##+##########################################################################
#
# GenevaDrive.tcl -- Animates a geneva drive
# by Keith Vetter, Aug 23, 2006
#
package require Tk
if {! [catch {package require tile}]} {
namespace import -force ::ttk::checkbutton
}
set S(help) {
How a film is moved through a movie projector? The film must
advance frame by frame with each frame pausing in front of the
lens for 1/24 of a second.
This intermittent motion is achieved using a Geneva Drive.
The name derives from the devices earliest application in mechanical
watches, Geneva being an important center of watchmaking. Other
application include pen change mechanism in plotters, automated
sampling devices, and so on.
}
array set S {title "Geneva Drive" w 500 h 500 lw 3
animate 1 aid "" delay 10 angle 0 angle2 45}
# Gear centers and radii
set V(gear1,o) {0 57}
set V(gear1,r0) 2
set V(gear1,r1) 10
set V(gear1,r2) 90
set V(gear1,r3) 161
set V(gear1,clr,r1) \#ccce34
set V(gear1,clr,r2) \#ccce34
set V(gear1,clr,r3) \#9c9a04
# Driving peg
set V(gear1,o2) {-114 0}
set V(gear1,p) 0 ;# Used for computing angles
set V(gear1,r10) 2
set V(gear1,r11) 10
set V(gear1,r12) 83
set V(gear1,clr,p) black
set V(gear1,clr,r0) black
set V(gear1,clr,r10) black
set V(gear1,clr,r11) red
set V(gear1,clr,r12) \#ccce34
set V(gear2,o) {0 -103}
set V(gear2,r0) 2
set V(gear2,r1) 10
set V(gear2,clr) \#64ce9c
set V(gear2,clr,r0) black
set V(gear2,clr,r1) \#64ce9c
proc DoDisplay {} {
global S
wm title . $S(title)
frame .top -bd 2 -relief ridge
frame .bottom -bd 0
label .title -text $S(title) -font {Times 42 bold}
button .? -text "?" -command About
catch {.? config -font "[.? cget -font] bold"}
checkbutton .anim -variable S(animate) -text Animate -command Animate
catch {.anim config -relief ridge -pady 5 -padx 5}
canvas .c -width $S(w) -height $S(h) -bd 0 -highlightthickness 0
bind .c <Configure> {ReCenter %W %h %w}
pack .title -in .top -side top -fill x
pack .c -in .top -side top -fill both -expand 1
pack .top -side top -fill both -expand 1
pack .bottom -side bottom -fill x -expand 1
pack .anim -in .bottom -side left -expand 1 -pady 10
place .? -in .bottom -relx .99 -rely .5 -anchor e
}
proc ReCenter {W h w} { ;# Called by configure event
set h2 [expr {$h / 2}] ; set w2 [expr {$w / 2}]
$W config -scrollregion [list -$w2 -$h2 $w2 $h2]
}
proc Gear1 {} {
global V S
lforeassignch {x0 y0} $V(gear1,o) x0 y0break
# Big disk and middle pin
foreach who {r3 r1 r0} {
set xy [MakeBox $x0 $y0 $V(gear1,$who)]
.c create oval $xy -tag gear1,$who -fill $V(gear1,clr,$who) \
-width $S(lw)
}
# Outer peg lforeassignch {x1 y1} $V(gear1,o2) x1 y1break
set x1 [expr {$x0 + $x1}]
set y1 [expr {$y0 + $y1}]
foreach who {p r11 r10} {
set xy [MakeBox $x1 $y1 $V(gear1,$who)]
set xy2 [eval RegularPolygon2 $xy -start 0 -extent 360]
.c create polygon $xy2 -tag [list gear1 gear1,$who] \
-fill $V(gear1,clr,$who) -width $S(lw) -outline black
}
# Rotating inner disk: concatentation of two arcs
set xy2 [eval RegularPolygon2 [MakeBox $x0 $y0 $V(gear1,r2)] -start 135 -extent 270]
set xy3 [eval RegularPolygon2 [MakeBox $x1 $y1 $V(gear1,r12)] -start -47 -extent -94]
set xy [concat $xy2 $xy3]
.c create polygon $xy -tag gear1 -fill $V(gear1,clr,r2) -outline black -width $S(lw)
.c raise gear1,r1
.c raise gear1,r0
}
proc Gear2 {} {
global V S
lforeassignch {x0 y0} $V(gear1,o) x0 y0break
lforeassignch {Gx Gy} $V(gear2,o) Gx Gybreak
set xy [MakeBox $x0 $y0 $V(gear1,r2)]
set xy0 [eval RegularPolygon2 $xy -start 135 -extent 90]
# Create one cusp and inlet lforeassignch {x1 y1} [lrange $xy0 end-1 end] x1 y1break
set dx [expr {$x1-$x0}]
set dy [expr {$y1-$y0}]
set dist [expr {hypot($dx,$dy)}]
set nx [expr {$dy}]
set ny [expr {-$dx}]
set x2 [expr {$x1 + $dx * 10 / $dist}]
set y2 [expr {$y1 + $dy * 10 / $dist}]
set x3 [expr {$x2 + $nx * 80 / $dist}]
set y3 [expr {$y2 + $ny * 80 / $dist}]
set x4 [expr {$x3 + $dx * 26 / $dist}]
set y4 [expr {$y3 + $dy * 26 / $dist}]
set x5 [expr {$x4 - $nx * 80 / $dist}]
set y5 [expr {$y4 - $ny * 80 / $dist}]
set x6 [expr {$x5 + $dx * 10 / $dist}]
set y6 [expr {$y5 + $dy * 10 / $dist}]
lappend xy0 $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4 $x5 $y5 $x6 $y6
# Rotate 3 times and join all the points
set xy1 [RotateCoords $xy0 $Gx $Gy -90]
set xy2 [RotateCoords $xy0 $Gx $Gy -180]
set xy3 [RotateCoords $xy0 $Gx $Gy -270]
set xy [concat $xy0 $xy1 $xy2 $xy3]
.c create poly $xy -tag gear2 -fill $V(gear2,clr) -outline black -width 4
foreach who {r1 r0} {
set xy [MakeBox $Gx $Gy $V(gear2,$who)]
.c create oval $xy -tag gear2,$who -fill $V(gear2,clr,$who) -width $S(lw)
}
}
proc MakeBox {x y r} {
return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
}
# from http://wiki.tcl.tk/Regular%20Polygons%202
proc RegularPolygon2 {x0 y0 x1 y1 args} {
array set V {-sides 0 -start 90 -extent 360} ;# Default values
foreach {a value} $args {
if {! [info exists V($a)]} {error "unknown option $a"}
if {$value == {}} {error "value of \"$a\" missing"}
set V($a) $value
}
if {$V(-extent) == 0} {return {}}
set xm [expr {($x0+$x1)/2.}]
set ym [expr {($y0+$y1)/2.}]
set rx [expr {$xm-$x0}]
set ry [expr {$ym-$y0}]
set n $V(-sides)
if {$n == 0} { ;# 0 sides => circle
set n [expr {round(($rx+$ry)*0.5)}]
if {$n <= 2} {set n 4}
}
set dir [expr {$V(-extent) < 0 ? -1 : 1}] ;# Extent can be negative
if {abs($V(-extent)) > 360} {
set V(-extent) [expr {$dir * (abs($V(-extent)) % 360)}]
}
set step [expr {$dir * 360.0 / $n}]
set numsteps [expr {1 + double($V(-extent)) / $step}]
set xy {}
set DEG2RAD [expr {acos(-1)*2/360}]
for {set i 0} {$i < int($numsteps)} {incr i} {
set rad [expr {($V(-start) - $i * $step) * $DEG2RAD}]
set x [expr {$rx*cos($rad)}]
set y [expr {$ry*sin($rad)}]
lappend xy [expr {$xm + $x}] [expr {$ym - $y}]
}
# Figure out where last segment should end
if {$numsteps != int($numsteps)} {
# Vecter V1 is last drawn vertext (x,y) from above
# Vector V2 is the edge of the polygon
set rad2 [expr {($V(-start) - int($numsteps) * $step) * $DEG2RAD}]
set x2 [expr {$rx*cos($rad2) - $x}]
set y2 [expr {$ry*sin($rad2) - $y}]
# Vector V3 is unit vector in direction we end at
set rad3 [expr {($V(-start) - $V(-extent)) * $DEG2RAD}]
set x3 [expr {cos($rad3)}]
set y3 [expr {sin($rad3)}]
# Find where V3 crosses V1+V2 => find j s.t. V1 + kV2 = jV3
set j [expr {($x*$y2 - $x2*$y) / ($x3*$y2 - $x2*$y3)}]
lappend xy [expr {$xm + $j * $x3}] [expr {$ym - $j * $y3}]
}
return $xy
}
# From http://wiki.tcl.tk/CanvasRotation
proc RotateItem {w tagOrId Ox Oy angle} {
set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
foreach id [$w find withtag $tagOrId] { ;# Do each component separately
set xy {}
foreach {x y} [$w coords $id] {
# rotates vector (Ox,Oy)->(x,y) by angle clockwise
set x [expr {$x - $Ox}] ;# Shift to origin
set y [expr {$y - $Oy}]
set xx [expr {$x * cos($angle) - $y * sin($angle)}] ;# Rotate
set yy [expr {$x * sin($angle) + $y * cos($angle)}]
set xx [expr {$xx + $Ox}] ;# Shift back
set yy [expr {$yy + $Oy}]
lappend xy $xx $yy
}
$w coords $id $xy
}
}
proc RotateCoords {xy Ox Oy angle} {
set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
set xy2 {}
foreach {x y} $xy {
# rotates vector (Ox,Oy)->(x,y) by angle clockwise
set x [expr {$x - $Ox}] ;# Shift to origin
set y [expr {$y - $Oy}]
set xx [expr {$x * cos($angle) - $y * sin($angle)}] ;# Rotate
set yy [expr {$x * sin($angle) + $y * cos($angle)}]
set xx [expr {$xx + $Ox}] ;# Shift back
set yy [expr {$yy + $Oy}]
lappend xy2 $xx $yy
}
return $xy2
}
proc About {} {
set msg "$::S(title)\nby Keith Vetter, August 2006\n$::S(help)"
tk_messageBox -message $msg -title "About $::S(title)"
}
proc Animate {} {
after cancel $::S(aid)
StepIt 1
if {$::S(animate)} {
set ::S(aid) [after $::S(delay) Animate]
}
}
proc StepIt {dir} {
global S V
lforeassignch {x0 y0} $V(gear1,o) x0 y0break
RotateItem .c gear1 $x0 $y0 $dir
set S(angle) [expr {($S(angle) + $dir) % 360}]
if {$S(angle) == 45} {
set S(angle2) 45
} elseif {$S(angle) > 45 && $S(angle) <= 135} { lforeassignch {Gx Gy} $V(gear2,o) Gx Gybreak
lforeassignch {x1 y1} [.c coords gear1,p] x1 y1break
set dx [expr {$x1 - $Gx}] ; set dy [expr {$y1 - $Gy}]
set degree [expr {round((acos($dy /hypot($dx,$dy))) * 180 / acos(-1))}]
set S(degree) $degree
set da [expr {-abs($degree - abs($S(angle2)))}]
if {$da != 0} {
RotateItem .c gear2 $Gx $Gy $da
incr S(angle2) $da
}
}
}
DoDisplay
Gear1
Gear2
Animate
return
======
**Comments**
<<categories>> Animation | Application | Graphics | Toys