# cubicKL.tcl, cr mon 01 may 2000 by rha on thunder

# init size of canvas
set res 300
# init param
set param 2.5

# define a function
## this is a cubic through the origin
proc myfunc { xval } {
  global param
  return [ expr  {$param * $xval - $param * $xval * $xval * $xval} ]
}

frame .fi2 -relief groove -borderwidth 10 \
  -background RoyalBlue

# declare the box
canvas .fi2.can -width $res -height $res

# now we draw in the box
# first: the diagonal in blue
proc drawdiag {} {
  global res
  .fi2.can create line 0 $res $res 0 \
    -tag diag -fill blue
}
drawdiag

# draw the graph on the canvas
proc drawgraph {} {
  global res
  for { set i 0 } { $i < $res - 1 } { incr i } {
    # 1 from 0 to res
    set i0 [ expr {double($i)} ]
	# x from -1 to +1
    set x0 [ expr {2*($i0/$res) - 1.0} ]
	# y in range -1 to +1 also, if param in 0 to 2.5980
    set y0 [ myfunc $x0 ]
	# now get jay of why
    set j0 [ expr {$res - (($y0 + 1.0)/2.0) * $res} ]
    set i1 [ expr {double($i+1)} ]
    set x1 [ expr {2*($i1/$res) - 1.0} ]
    set y1 [ myfunc $x1 ]
    set j1 [ expr {$res - (($y1 + 1.0)/2.0) * $res} ]
    .fi2.can create line $i0 $j0 $i1 $j1 -fill green
  }
}
drawgraph

set xnow 0.5
# now we do one step of the Koenigs-Lemeray process
# Vert 1, Hor 1, in red
proc KLstep { init_xval } {
  global res xnow
  set x1 $init_xval
  set x2 [ myfunc $x1 ]
  set m1 [ expr {($x1 + 1.0)/2.0 * $res} ]
  set m2 [ expr {($x2 + 1.0)/2.0 * $res} ]
  set n1 [ expr  {$res - $m1} ]
  set n2 [ expr  {$res - $m2} ]
  .fi2.can create line \
    $m1 $n1 \
    $m1 $n2 \
    $m2 $n2 \
    -tag step1 -fill red
  set xnow $x2
}

set x2now -0.5
# now we do one step of the Koenigs-Lemeray process
# Vert 1, Hor 1, in red
proc KL2step { init_xval } {
  global res x2now
  set x1 $init_xval
  set x2 [ myfunc $x1 ]
  set m1 [ expr {($x1 + 1.0)/2.0 * $res} ]
  set m2 [ expr {($x2 + 1.0)/2.0 * $res} ]
  set n1 [ expr  {$res - $m1} ]
  set n2 [ expr  {$res - $m2} ]
  .fi2.can create line \
    $m1 $n1 \
    $m1 $n2 \
    $m2 $n2 \
    -tag step1 -fill red
  set x2now $x2
}

# frame two buttons to get them on top of canvas
frame .fi -relief groove -borderwidth 10 \
  -background RoyalBlue

# KL step button on left
button .fi.b1 -text "KL Step" \
  -command { KLstep $xnow; KL2step $x2now }

# Clear button on right
button .fi.b2 -text "Clear" \
  -command { clearcan }
pack .fi.b1 .fi.b2 -side left
pack .fi

# add a scale (slider) for the param in myfunc
scale .fi2.param -from 2.6 -to 0.0 \
  -orient vertical \
  -tickinterval 1.0 \
  -resolution 0.01 -digits 5 \
  -length 300 -label "R" \
  -command update_param
pack .fi2.param

# pack the canvas and scale
pack .fi2.can .fi2.param -side left
pack .fi2 

# experiment with clearing
proc clearcan {} {
  global res
  destroy .fi2.can
  canvas .fi2.can -width $res -height $res
  drawdiag
  drawgraph
  pack .fi2.can .fi2.param -side left
  pack .fi2
}

proc update_param {value} {
  global param
  set param $value
  clearcan
# comment out next line, rha, 17 april 2000 (screws up tclet)
#  puts "#1: param is now $param"
}

# this is a test
# puts "#2: param now is $param"

#end: cubicKL.tcl