##+##########################################################################
#
# cubic.tcl -- Displays the graph of some cubic equations
# by Keith Vetter, December 2006
#
# http://www.mathopenref.com/cubicexplorer.html
 
package require Tk
package require tile
 
array set S {title "Cubic Function Explorer" X 25 Y 5 bg #b4bacc eq #6466fc
    go 0 delay 75}
array set MAX {a 4 b 5 c 25 d 25}
array set DIR {a 1 b 2 c 5 d 5}
foreach who {a b c d} {
    set C($who) [expr {-$MAX($who) + int(rand()*2*$MAX($who))}]
}
 
proc DoDisplay {} {
    global S MAX
    
    wm title . $S(title)
    label .title -text $S(title) -font {Times 36 bold}
    frame .ctrl
    canvas .c -relief sunken -bd 2 -bg $::S(bg)
 
    foreach who {a b c d} {
        label .ctrl.l$who -text $who -font {Helvetica 10 italic bold} -fg $S(eq)
        label .ctrl.v$who -textvariable ::C(nice,$who) -width 3
        ::ttk::scale .ctrl.s$who -from $MAX($who) -to -$MAX($who) \
            -variable ::C($who) -orient v -command NewValue
        ::ttk::button .ctrl.z$who -image ::img::star -command [list Zero $who] \
            -takefocus 0
    }
    ::ttk::button .anim -text Animate -command StartStop
    ::ttk::button .about -text About -command About
 
    pack .title -side top -fill y
    pack .ctrl -side right -fill y -pady {10 30} -padx {0 30} 
    pack .c -side left -fill both -expand 1 -pady {10 30} -padx 30
 
    grid .ctrl.la .ctrl.lb .ctrl.lc .ctrl.ld
    grid .ctrl.va .ctrl.vb .ctrl.vc .ctrl.vd
    grid .ctrl.sa .ctrl.sb .ctrl.sc .ctrl.sd
    grid .ctrl.za .ctrl.zb .ctrl.zc .ctrl.zd
    grid .anim - - - -in .ctrl -row 100 -pady 5
    grid .about - - - -in .ctrl -row 101
    grid columnconfigure .ctrl {0 1 2 3} -weight 1
    grid rowconfigure .ctrl 99 -weight 1
 
    bind .c <Configure> {Recenter %W %h %w}
    bind all <F2> {console show}
}
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]
    DrawGrid
    Plotit
}
proc NewValue {args} {
    foreach who {a b c d} {
        set ::C(nice,$who) [format %.1f $::C($who)]
    }
    Plotit
}
proc DrawGrid {} {
    global S CLR
    
    .c delete all
    foreach {x0 y0 x1 y1} [.c cget -scrollregion] break
    set fnt {Times 8}
    
    for {set x 1} {1} {incr x} {
        set cx [expr {$x * $S(X)}]              ;# Scaled to canvas
        if {$cx > $x1} break
        .c create line $cx $y0 $cx $y1 -fill white
        .c create line -$cx $y0 -$cx $y1 -fill white
        set n [.c create text $cx 0 -text $x -fill white -anchor n -font $fnt]
        .c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
        .c raise $n
        set n [.c create text -$cx 0 -text -$x -fill white -anchor n -font $fnt]
        .c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
        .c raise $n
    }
 
    for {set y 5} {1} {incr y 5} {
        set cy [expr {$y * $S(Y)}]              ;# Scaled to canvas
        if {$cy > $y1} break
    
        .c create line $x0 $cy $x1 $cy -fill white
        .c create line $x0 -$cy $x1 -$cy -fill white
        set n [.c create text -3 $cy -text -$y -fill white -anchor e -font $fnt]
        .c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
        .c raise $n
        set n [.c create text -3 -$cy -text $y -fill white -anchor e -font $fnt]
        .c create rect [.c bbox $n] -fill $S(bg) -outline $S(bg)
        .c raise $n
    }
    .c create line $x0 0 $x1 0 -fill blue
    .c create line 0 $y0 0 $y1 -fill blue
 
    .c create text [expr {$x0+20}] [expr {17.5*$S(Y)}] -tag equation \
        -anchor w -font {Helvetica 10 bold italic} -fill $::S(eq)
}
proc Plotit {} {
    global C S
 
    .c delete plot
 
    foreach {x0 y0 x1 y1} [.c cget -scrollregion] break
    if {! [info exists x0]} return              ;# Pre-update catch
    
    set xy {}
    for {set cx [expr {int($x0)}]} {$cx <= $x1} {incr cx} {
        set x [expr {$cx / double($S(X))}]
        set y [expr {$x * ($x * ($C(a)*$x + $C(b)) + $C(c)) + $C(d)}]
        set cy [expr {-1*$y * $S(Y)}]
        lappend xy $cx $cy
    }
 
    .c create line $xy -tag plot -fill red -width 2
    .c itemconfig equation -text [GetEquation]
}
proc About {} {
    set msg "$::S(title)\nby Keith Vetter, December 2006\n\n"
    append msg "Visualization of the cubic equation"
    tk_messageBox -message $msg -title "About $::S(title)"
}
proc Zero {who} {
    set ::C($who) 0
    NewValue
}
proc GetEquation {} {
    global C
    array set super {a x\u00b3 b x\u00b2 c x d ""}
 
    set txt ""
    foreach who {a b c d} {
        set num [format %.1f $C($who)]
        if {$num == 0} continue
        set num2 [expr {int($num) == $num ? abs(int($num)) : abs($num)}]
        if {$num2 == 1 && $who ne "d"} {set num2 ""}
 
        if {$num > 0} {
            if {$txt ne ""} { append txt " + "}
        } else {
            if {$txt eq ""} { append txt "-"} else {append txt " - "}
        }
        append txt $num2 $super($who)
    }
    if {$txt eq ""} {set txt 0}
    return "y = $txt"
}
 
if {[lsearch [image names] ::img::star] == -1} {
    image create bitmap ::img::star -data {
        #define plus_width  7
        #define plus_height 7
        static char plus_bits[] = {
            0x49, 0x2a, 0x1c, 0x7f, 0x1c, 0x2a, 0x49}
    }
}
 
proc StartStop {} {
    set ::S(go) [expr {$::S(go) ? 0 : -1}]
    if {$::S(go)} Animate
}
proc Animate {{num ""}} {
    global S C MAX DIR
 
    if {$num ne ""} {set S(go) $num}
    foreach who {a b c d} {
        set next [expr {$C($who) + $DIR($who)}]
        if {abs($next) <= $MAX($who)} {
            set C($who) $next
            break
        }
        set DIR($who) [expr {-$DIR($who)}]
    }
    after idle NewValue
    if {$S(go) > 0} { incr S(go) -1 }
    if {$S(go)} { after $S(delay) Animate }
}
 
DoDisplay
update
NewValue
after 200 Animate 20
return