uniquename 2013aug18For those readers who do not have the time/opportunity/facilities/whatever to run the code below, here is an image that shows the nice-looking, nice-performing GUI that the code produces.
##+##########################################################################
#
# 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
returnUK you can find another implementation of this using BLT vector and graph in http://wiki.tcl.tk/15000
Example 3 ;-)KPV don't know how I missed it :)UK BLT is under appreciated, but for me it is still the first stop for rich plotting, vector math and tabsets.