## Intro

Keith Vetter : 2006-08-24 : Have you ever wondered how film is moved through a movie projector?
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.
Also known as "Maltese Cross" Drive 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 [1 ] 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 [2 ] 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.

AK: Wow. That is an interesting site for all things Kinematic.

AK: Some pictures of real-life geneva drives:

Jeff Smith 2019-05-04 : Below is an online demo using CloudTk

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

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

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

foreach {x0 y0} \$V(gear1,o) break

# 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
foreach {x1 y1} \$V(gear1,o2) break
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

foreach {x0 y0} \$V(gear1,o) break
foreach {Gx Gy} \$V(gear2,o) break
set xy [MakeBox \$x0 \$y0 \$V(gear1,r2)]
set xy0 [eval RegularPolygon2 \$xy -start 135 -extent 90]

# Create one cusp and inlet
foreach {x1 y1} [lrange \$xy0 end-1 end] break
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 https://wiki.tcl-lang.org/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 {}

for {set i 0} {\$i < int(\$numsteps)} {incr i} {
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 x2 [expr {\$rx*cos(\$rad2) - \$x}]
set y2 [expr {\$ry*sin(\$rad2) - \$y}]

# Vector V3 is unit vector in direction we end at

# 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 https://wiki.tcl-lang.org/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
}
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

foreach {x0 y0} \$V(gear1,o) break
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} {
foreach {Gx Gy} \$V(gear2,o) break
foreach {x1 y1} [.c coords gear1,p] break
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```