Keith Vetter 2003-05-09 : back in the 70's on an Apple ][ computer I used to write basic programs to draw pretty pictures. One of those was Spirograph, another was drawing Lissajous figures.
A starkit version of this code is available on sdarchive.
##+###################################################################
#
# Lissajous.tcl -- draws Lissajous figures
# by Keith Vetter, May 09, 2003
#
# x = Rx cos(Ax t + Bx)
# y = Ry cos(Ay t + By)
package require Tk
set S(title) "Lissajous Figure"
set S(stop) 0
set C(A,x) 11
set C(A,y) 9
set C(B,x) 0
set C(B,y) 90
set C(step) 5
set C(tail) 20
set C(hasTail) 1
set C(delay) 10
set CC(t) 0
set CC(id) 0
set deg2rad [expr {atan(1) * 4 / 180}]
proc DoDisplay {} {
wm title . $::S(title)
pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
-side right -fill y -ipady 5
pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1
button .dummy
.dummy configure -font "[font actual [.dummy cget -font]] -weight bold"
option add *font [.dummy cget -font]
option add *Scale.orient horizontal
option add *Scale.showValue 0
option add *highlightThickness 0
canvas .c -relief raised -borderwidth 0 -height 500 -width 500
label .msg -textvariable S(msg) -bd 2 -bg white -relief ridge
pack .msg -in .screen -side bottom -fill both
pack .c -in .screen -side top -fill both -expand 1
button .clear -text Clear -command Clear -bd 4
button .about -text About -command \
[list tk_messageBox -message "$::S(title)\nby Keith Vetter, May 2003"]
frame .fx -relief raised -bd 2
frame .fy -relief raised -bd 2
label .lx -text "X = cos(Ax*t + Bx)"
label .ly -text "Y = cos(Ay*t + By)"
scale .ax -variable C(A,x) -from 1 -to 20
scale .ay -variable C(A,y) -from 1 -to 20
scale .bx -variable C(B,x) -from -180 -to 180 -resolution 5
scale .by -variable C(B,y) -from -180 -to 180 -resolution 5
frame .ftail -relief ridge -bd 2
checkbutton .stail -text Tail -variable C(hasTail) -anchor w
scale .tail -variable C(tail) -from 0 -to 500 -resolution 5
scale .step -variable C(step) -from 1 -to 10 -relief ridge
scale .delay -variable C(delay) -from 1 -to 100 -relief ridge
grid .clear -in .ctrl -sticky ew -row 0
grid rowconfigure .ctrl 1 -minsize 40
grid .fx -in .ctrl -sticky ew -row 10
grid .lx -in .fx -sticky ew
grid .ax -in .fx -sticky ew
grid .bx -in .fx -sticky ew
grid .fy -in .ctrl -sticky ew
grid .ly -in .fy -sticky ew
grid .ay -in .fy -sticky ew
grid .by -in .fy -sticky ew
grid rowconfigure .ctrl 19 -minsize 40
grid .ftail -in .ctrl -sticky ew -row 20
grid .stail -in .ftail -sticky ew
grid .tail -in .ftail -sticky ew
grid .step -in .ctrl -sticky ew
grid .delay -in .ctrl -sticky ew
grid rowconfigure .ctrl 50 -weight 1
grid .about -in .ctrl -row 100 -sticky ew
bind all <Alt-c> {console show}
bind .c <Configure> {ReCenter %W %h %w}
update
}
proc ReCenter {W h w} { ;# Called by configure event
set x [expr {$w / 2}] ; set y [expr {$h / 2}]
set ::C(R,x) [expr {$x - 50}] ; set ::C(R,y) [expr {$y - 50}]
$W config -scrollregion [list -$x -$y $x $y]
}
proc box {x y r} {
return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
}
proc DrawCurve {{start 0} {step 0}} {
global CC C S
foreach a [after info] {after cancel $a}
if {$start} {set S(stop) 0} ;# Turn off stop flag
if {$S(stop) && ! $step} return
# x = Rx cos(Ax t + Bx)
# y = Ry cos(Ay t + By)
set th [expr {$C(A,x)*$CC(t) + $C(B,x)}]
set x [expr {$C(R,x) * cos($th * $::deg2rad)}]
set th [expr {$C(A,y)*$CC(t) + $C(B,y)}]
set y [expr {$C(R,y) * cos($th * $::deg2rad)}]
set tag [list liss "liss$CC(id)"]
if {[info exists CC(last,xy)]} {
.c create line [concat $CC(last,xy) $x $y] -tag $tag -fill black
}
.c delete head
.c create oval [box $x $y 3] -tag head -fill yellow
if {$C(hasTail)} {.c delete "liss[expr {$CC(id) - $C(tail)}]"}
set CC(last,xy) [list $x $y]
set CC(t) [expr {$CC(t) + $C(step)/10.0}]
incr CC(id)
after $C(delay) DrawCurve
}
proc Tracer {var1 var2 op} {
global C S
if {$var2 == "hasTail"} {
if {$C(hasTail)} Clear
} elseif {$var2 != "delay" && $var2 != "step"} Clear
set X "X = cos($C(A,x)t + $C(B,x))"
set Y "Y = cos($C(A,y)t + $C(B,y))"
.lx config -text $X
.ly config -text $Y
regsub -all { \+ 0} "$X $Y" {} S(msg)
.stail config -text "Tail: $C(tail)"
.step config -label "Step: $C(step)"
.delay config -label "Delay: $C(delay)"
}
proc Clear {} {
.c delete all
catch {unset ::CC(last,xy)}
}
trace variable C w Tracer
DoDisplay
DrawCurveCategory Application | Category Mathematics | Category Graphics | Category Plotting