# KL04.tcl, cr thu 04 feb 1999 by rha
# revised 14 may 2000 by rha as logisticKL.tcl on thunder
# revised 08 sept 2002 by rha on new ptolemy as KLlogistic.tcl
# ftp from sequoia, this is rev 2.1

### declare and init all global variables
# init size of canvas
set res 300
# init startup values for sliders
set xinit 0.5
set paraminit 2.5
# init running values of parameters
set xnow $xinit
set param $paraminit

### here are the procs ###

# draw the diagonal in blue
proc drawdiag {} {
  global res
  .fi2.can create line 0 $res $res 0 \
    -tag diag -fill blue -width 3
}

# define a function
proc myfunc { xval } {
  global param
  return [ expr  {$param * $xval - $param * $xval * $xval} ]
}

# draw the graph on the canvas
proc drawgraph {} {
  global res
  for { set i 0 } { $i < $res - 1 } { incr i } {
    set i0 [ expr {double($i)} ]
    set x0 [ expr {$i0/$res} ]
    set y0 [ myfunc $x0 ]
    set j0 [ expr {$res - $y0 * $res} ]
    set i1 [ expr {double($i+1)} ]
    set x1 [ expr {$i1/$res} ]
    set y1 [ myfunc $x1 ]
    set j1 [ expr {$res - $y1 * $res} ]
    .fi2.can create line $i0 $j0 $i1 $j1 \
	  -fill seagreen -width 3
  }
}

# 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 * $res} ]
  set m2 [ expr  {$x2 * $res} ]
  set n1 [ expr  {$res - $x1 * $res} ]
  set n2 [ expr  {$res - $x2 * $res} ]
  .fi2.can create line \
    $m1 $n1 \
    $m1 $n2 \
    $m2 $n2 \
    -tag step1 -fill red
  set xnow $x2
}

### WIDGETS ###

# frame vert slider and canvas
frame .fi2 -relief groove -borderwidth 10 \
  -background RoyalBlue

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

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

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

# frame three buttons frame and horiz slider
frame .fi1 -relief groove -borderwidth 10 \
  -background RoyalBlue

# frame three buttons in a column
frame .fi1.fa -relief groove -borderwidth 10 \
  -background RoyalBlue

# KL step button
button .fi1.fa.b1 -text "KL Step" \
  -command { KLstep $xnow } \
  -foreground black -background green -width 11

# Clear button
button .fi1.fa.b2 -text "Clear" \
  -command { clearcan } \
  -foreground black -background yellow -width 11

# Reset button
button .fi1.fa.b3 -text "Reset" \
  -command { reset } \
  -foreground black -background red -width 11

# pack the button column frame
pack .fi1.fa.b1 .fi1.fa.b2 .fi1.fa.b3 -side top
pack .fi1.fa

# add a scale (slider) for the xinit in first KL step
scale .fi1.xinit -from 0.0 -to 1.0 \
  -orient horizontal \
  -tickinterval 0.25 \
  -resolution 0.01 -digits 5 \
  -length 300 -label "Initial point" \
  -command update_xinit \
  -background RoyalBlue
pack .fi1.fa .fi1.xinit -side left
pack .fi1

# clear command
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
}

# reset command
proc reset {} {
  global res xinit xnow
  set xnow $xinit
  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
}

proc update_xinit {value} {
  global xinit
  set xinit $value
}

### MAIN BEGINS HERE ###

# set default value for param slider
.fi2.param set $paraminit
# set default value for xinit slider
.fi1.xinit set $xinit
drawdiag
drawgraph

#end: logisticKL.tcl