[Keith Vetter] 2002-09-30 : another little graphical program, this one simulates the kid's game of SpiroGraph.
[http://tcl.tk/starkits/spirograph.png]
I remember great fun as a kid playing with spirograph.
Then in high school in the late 70's I cut my programming teeth
by writing BASIC programs on Apple II's to draw these curves.
Technically, these curves are called epicycloids, epitrochoids, hypocycloids and hypotrochoids.
[Keith Vetter] : me again. I thought I'd list some parameter settings that yield pretty figures. Feel free to add more:
INNER OUTER % TYPE
50 62 100 epi
120 84 150 epi
120 54 320 epi
120 84 121 hypo
100 50 100 hypo
88 55 225 epi # pretty how the curve is tangent to itself
[AM] The code below does not work completely, because of problems with the -font option
(wish 8.3.4 complains about expecting an integer and there is a typo).
Remove the lines that cause trouble and you have a beautiful graph!
The other thing I wanted to mention is, that it is quite possible to compose ''general'' curves, not just circles. I will work out the details in a separate Wiki page :-) See [Composing Curves].
[KPV] Fixed the font problem and added epicycles to the type of curve it can draw. I'm actually running 8.3.4 and didn't see the font problem--but it could be that I'm running on windows.
----
[Jeff Smith] Below is an online demo using [CloudTk]
<<inlinehtml>>
<iframe height="6500" width="6500" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=SpiroGraph" allowfullscreen></iframe>
<<inlinehtml>>
----
======
##+##########################################################################
#
# spiro.tcl
#
# Draws Epicycloids, hypocycloids, epitrochoids and hypotrochoids.
# by Keith Vetter
#
# Revisions:
# KPV Sep 27, 2002 - initial revision
# KPV Oct 01, 2002 - added epicycle, change font emboldening
#
# 120/60/100/hypo => line
# 120/40/55/hypo => triangle
# 120/30/40/hypo => square
# 120/24/30/hypo => pentagon
# 120/20/25/hypo => hexagon
# 120/15/22/hypo => octagon
#
##+##########################################################################
#############################################################################
package require Tk
set sz(w) 600 ;# Size of canvas
set sz(h) 600
set epi(draw) 1 ;# Checkbutton vars
set epi(clear) 1
set epi(sa) 100 ;# Scale vars
set epi(sb) 70
set epi(spct) 100
set epi(stype) epicycloid ;# Radiobutton var
set epi(a) 0 ;# Working values
set epi(b) 0
set epi(step) 0 ;# Animation vars
set epi(stepsize) 5
set epi(after_delay) 20
set epi(color) black
array set epi {
epicycloid,1 "Cardiod: 1 cusp epicycloid"
epicycloid,2 "Nephroid: 2 cusp epicycloid"
epicycloid,5 "Ranunculoid: t cusp epicycloid"
hypocycloid,2 "Diameter: example of Copernicus's theorem"
hypocycloid,3 "Deltoid: 3 cusp hypocycloid"
hypocycloid,4 "Astroid: 4 cusp hypocycloid"
}
##+##########################################################################
#
# DoDisplay
#
# Sets up our GUI
#
proc DoDisplay {} {
global sz
wm title . "SpiroGraph"
pack [frame .top -relief raised -bd 2] -side top -fill x
pack [frame .bottom] -side bottom -fill x
pack [frame .bottom.right] -side right -fill y
pack [frame .bottom.mid] -side right -fill y -expand 1
pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1
canvas .c -relief raised -bd 2 -wid $::sz(w) -height $::sz(h) -highlightth 0
label .msg -textvariable epi(msg) -bd 0 -bg white
set colors {red orange yellow green blue cyan purple violet white}
lappend colors [.c cget -bg] black
foreach color $colors {
radiobutton .top.b$color -width 1 -padx 0 -pady 0 -bg $color \
-variable epi(color) -value $color
bind .top.b$color <3> [list .c config -bg $color]
}
eval pack [winfo children .top] -side left -fill y
checkbutton .draw -text "Draw It! " -command NextStep \
-variable epi(draw) -relief raised -anchor w -bd 8
.draw configure -font "[font actual [.draw cget -font]] -weight bold"
checkbutton .auto -text "Auto Clear" -variable epi(clear) \
-relief raised -anchor w
button .clear -text Clear -command {Reset 1}
button .helper -text Help -command Help
label .type -text "Curve Type" -anchor w
.type configure -font "[font actual [.type cget -font]] -weight bold"
frame .types -bd 2 -relief sunken
radiobutton .epi -text Epicycloid -variable epi(stype) \
-value epicycloid -anchor w -command NewDimensions
radiobutton .hypo -text Hypocycloid -variable epi(stype) \
-value hypocycloid -anchor w -command NewDimensions
radiobutton .epi2 -text Epicycle -variable epi(stype) \
-value epicycle -anchor w -command NewDimensions
scale .inner -orient h -var epi(sa) -from 20 -to 200 \
-label "Inner Circle" -relief ridge
scale .outer -orient h -var epi(sb) -from 2 -to 100 \
-label "Outer Circle" -relief ridge
scale .h -orient h -var epi(spct) -from 0 -to 500 \
-label "Outer Radius %" -relief ridge
pack .c -side top -fill both -expand 1 -in .screen
pack .msg -side left -fill both -expand 1 -in .screen
pack .helper -side right -in .top
pack .inner .outer .h -side left -in .bottom
pack .draw .auto .clear -side top -in .bottom.right -fill x -padx 1m
pack config .draw -expand 1 -fill both
pack .type -side top -in .bottom.mid -fill x
pack .types -in .bottom.mid -side top -fill both -expand 1
pack .epi .epi2 .hypo -side top -in .types -fill x -expand 1
bind Canvas <Button-2> [bind Text <Button-2>]
bind Canvas <B2-Motion> [bind Text <B2-Motion>]
bind .c <Alt-c> [list console show]
bind .c <Configure> {ReCenter %W %h %w}
bind .inner <ButtonRelease-1> NewDimensions
bind .outer <ButtonRelease-1> NewDimensions
bind .h <ButtonRelease-1> NewDimensions
focus .c
}
##+##########################################################################
#
# NewDimensions
#
# Called whenever we change one of the parameters of our curve.
#
proc NewDimensions {} {
global epi
;# Make sure something changed
if {$epi(a)==$epi(sa) && $epi(b)==$epi(sb) && $epi(pct)==$epi(spct)
&& $epi(stype) == $epi(type)} return
set epi(draw) 0
catch {after cancel $epi(after)}
foreach x {a b pct type} { set epi($x) $epi(s$x) }
set epi(h) [expr {$epi(b) * $epi(pct) / 100.0}]
if {$epi(type) == "epicycloid"} {
set epi(k1) [expr {double($epi(a) + $epi(b))}]
} else {
set epi(k1) [expr {double($epi(a) - $epi(b))}]
}
set epi(k2) [expr {$epi(k1) / $epi(b)}]
if {$epi(type) == "epicycle"} { set epi(k1) $epi(a) }
set epi(stepsize) [expr {$epi(pct) > 400 ? 1 : $epi(pct) > 200 ? 3 : 5}]
;# Figure out when to stop
set nhits [expr {$epi(a) / [GCD $epi(a) $epi(b)]}] ;# Hitting inner circle
set hits4rev [expr {double($epi(a)) / $epi(b)}] ;# Hits in one revolution
set revs [expr {round($nhits / $hits4rev)}] ;# Total revolutions needed
set epi(maxstep) [expr {360 * $revs}]
set type $epi(type)
if {$epi(pct) != 100} {
regsub cycloid $type trochoid type
.epi config -text Epitrochoid
.hypo config -text Hypotrochoid
} else {
.epi config -text Epicycloid
.hypo config -text Hypocycloid
}
set epi(msg) "$revs revolutions with $nhits points"
if {$revs == 1} { regsub revolutions $epi(msg) revolution epi(msg) }
if {$epi(pct) == 100 && $revs == 1 && $epi(a) >= $epi(b)} {
if {[info exists epi($epi(type),$nhits)]} {
set epi(msg) $epi($epi(type),$nhits)
}
}
Reset 0
}
##+##########################################################################
#
# NextStep
#
# Draws one segment of the curve.
#
proc NextStep {{force 0}} {
global epi
if {! $force && ! $epi(draw)} return
.c delete outer
if {$epi(step) > $epi(maxstep)} {
.c delete inner
set epi(draw) 0
.draw config -state disabled
return
}
set theta [expr {$epi(step) * 3.14159 / 180}]
set Ox [expr {$epi(k1) * cos($theta)}] ;# Outer circle's center
set Oy [expr {$epi(k1) * sin($theta)}]
set xy [MakeBox $Ox $Oy $epi(b)]
if {$epi(type) == "epicycloid"} {
set x1 [expr {$Ox - $epi(h) * cos($epi(k2) * $theta)}]
} else {
set x1 [expr {$Ox + $epi(h) * cos($epi(k2) * $theta)}]
}
set y1 [expr {$Oy - $epi(h) * sin($epi(k2) * $theta)}]
if {$epi(step) != 0} {
foreach {x0 y0} $epi(last) break
.c create line $x0 $y0 $x1 $y1 -tag {epi curve} -wid 3 -fill $epi(color)
} else {
.c create oval -$epi(a) -$epi(a) $epi(a) $epi(a) -fill {} \
-outline red -tag {epi inner} -width 5
}
.c create line 0 0 $Ox $Oy -fill red -tag {epi outer}
.c create oval $xy -tag {epi outer} -fill {} -outline red -width 5
.c create line $Ox $Oy $x1 $y1 -fill red -tag {epi outer} -width 5
.c create oval [MakeBox $x1 $y1 4] -fill $epi(color) -outline $epi(color) \
-tag {epi outer}
set epi(last) [list $x1 $y1]
incr epi(step) $epi(stepsize)
if {$epi(draw)} {
set epi(after) [after $epi(after_delay) NextStep]
}
}
##+##########################################################################
#
# Reset
#
# Resets back to start and optionally clears the screen
#
proc Reset {clear} {
global epi
if {$clear || $epi(clear)} {
.c delete epi ;# Delete everything
set epi(draw) 0
}
.c delete inner outer
set epi(step) 0
.draw config -state normal
NextStep 1
}
##+##########################################################################
#
# MakeBox
#
# Returns top left, bottom right of a box centered at x,y
#
proc MakeBox {x y n} {
set x0 [expr {$x - $n}]
set y0 [expr {$y - $n}]
set x1 [expr {$x + $n}]
set y1 [expr {$y + $n}]
return [list $x0 $y0 $x1 $y1]
}
##+##########################################################################
#
# Recenter
#
# Called when window gets resized.
#
proc ReCenter {W h w} {
set h [expr {$h / 2.0}]
set w [expr {$w / 2.0}]
$W config -scrollregion [list -$w -$h $w $h]
set h [expr {-$h * .9}]
set w [expr {-$w * .9}]
.c delete title
.c create text $w $h -anchor nw -font bold -text SpiroGraph -tag title
}
##+##########################################################################
#
# GCD
#
# Euler's algorithm for finding greatest common divisor.
#
proc GCD {a b} {
while {$b > 0} {
foreach {a b} [list $b [expr {$a % $b}]] break
}
return $a
}
##+##########################################################################
#
# Help
#
# Give very simple help.
#
proc Help {} {
catch {destroy .help}
toplevel .help
wm transient .help .
wm title .help "SpiroGraph Help"
if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
wm geom .help "+[expr {$wx+35}]+[expr {$wy+35}]"
}
set w .help.t
text $w -wrap word -width 70 -height 28 -pady 10
button .help.quit -text Dismiss -command {catch {destroy .help}}
pack .help.quit -side bottom
pack $w -side top -fill both -expand 1
$w tag config header -justify center -font bold -foreground red
$w tag config header2 -justify center -font bold
set margin [font measure [$w cget -font] " o "]
set margin2 [font measure [$w cget -font] " o - "]
$w tag config bullet -lmargin2 $margin
$w tag config bullet -font "[font actual [$w cget -font]] -weight bold"
$w tag config n -lmargin1 $margin -lmargin2 $margin2
$w insert end "SpiroGraph" header "\nby Keith Vetter\n\n" header2
$w insert end " o What are these Curves?\n" bullet
$w insert end "- I remember great fun as a kid playing with spirograph " n
$w insert end "Then in high school I cut my programming teeth by " n
$w insert end "writing BASIC programs to draw these curves. " n
$w insert end "Later I was to learn that these curves are technically " n
$w insert end "called epicycloids, epitrochoids, hypocycloids and " n
$w insert end "hypotrochoids.\n\n" n
$w insert end " o What are Epicycloids and Hypocycloids?\n" bullet
$w insert end "- An epicycloid is the path traced out by a point " n
$w insert end "on the edge of a circle rolling on the outsde of " n
$w insert end "another circle.\n" n
$w insert end "- A hypocycloid is the same but with the circle rolling " n
$w insert end "on the inside.\n\n" n
$w insert end " o What are Epitrochoids and Hypotrochoids?\n" bullet
$w insert end "- These are similar curves but with the point traced in " n
$w insert end "not exactly on the outer circle's perimeter.\n\n" n
$w insert end " o What are Epicycles?\n" bullet
$w insert end "- A related curve is an epicycle, where the center " n
$w insert end "of the outer curve follows the perimeter of the " n
$w insert end "inner curve. Mathematically, this is a less interesting " n
$w insert end "curve because the outer circle rotation speed is " n
$w insert end "arbitrary.\n" n
$w insert end "- Historically, epicycles are famous because they " n
$w insert end "were a kludge added to the Ptolemic geo-centric solar " n
$w insert end "system model to explain a planet's retrograde motion " n
$w insert end "when viewed from the earth.\n\n" n
$w config -state disabled
}
DoDisplay
NewDimensions
set epi(draw) 1
NextStep
======
----
'''[arjen] - 2013-03-28 12:10:09'''
http://mathworld.wolfram.com/GuillochePattern.html%|%MathWorld%|% presents a variation on spirographs that is used with banknotes.
This inspired me to this [Guilloche Pattern] page ...
----
[RFox] - I had one of these as a kid. I recall there was also a bar with gears on it as well as outer teeth on the 'hollow' circles.
[arjen] Me too. Drawing using the outer teeth was not that easy though. If you weren't careful the pen would slip away, ruining
the picture.
<<categories>> Application | Games | Graphics | Mathematics