[Keith Vetter] : another little graphical program, this one simulates the kid's game of SpiroGraph. 

[http://mini.net/sdarchive/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 :-)

[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.


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

----
[[
[Category Graphics] 
[Category Mathematics]
]]