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