[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 {console show} bind .c {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 DrawCurve ---- [Category Application] | [Category Mathematics] | [Category Graphics]