SpiroGraph

Keith Vetter 2002-09-30 : another little graphical program, this one simulates the kid's game of SpiroGraph.

https://www.tcl-lang.org/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 2019-08-28 : Below is an online demo using CloudTk


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

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.