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

----

[Jeff Smith] Below is an online demo using [CloudTk]

<<inlinehtml>>

<iframe height="650" width="750" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=Lissajous-Figures" allowfullscreen></iframe>

<<inlinehtml>>

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

[uniquename] 2013jul29

This code could use an image to show what it produces:

[vetter_lissajousFigures_wiki8875_screenshot_615x480.jpg]

(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for
capturing the image to a PNG file, cropping the image, and converting the PNG
file to a JPEG file about 8 times smaller than the PNG. Thanks to FOSS developers
everywhere.)

This static image does not do justice to the Lissajous segment that is zipping
around on the screen. To capture this image, I changed the initial value of 20 for 
'Tail' to 245, to grab a larger portion of the constantly fading-out curve.

<<categories>> Application | Mathematics | Graphics | Plotting