# curves4.tcl, cr mon 15 feb 1999 by rha
# to display crit curves of a 2D map, add print button
# revised to run as Tclet (# out "puts" lines), 23 apr 2000 by rha
# deleted spurious #, 15 sept 2002 (same rev number)

###### set globals #####

# define the 2D domain of floats
set xmin -1.5
set xmax 1.5
set ymin -1.1
set ymax 1.8

# define the 2D domain of ints, etc
set hres 300
set vres 290
set numsegs 10

# define seed
set x0 0.5
set y0 0.5

# save last point of trajectory
set xnow $x0
set ynow $y0

# save current values of map params
set a 0.7
set b -0.8

# choose number of iterations in a puff (recc 500)
set puffsize 500

##### Tk widget heaven #####

# declare the first frame
frame .f1 -relief groove -borderwidth 10 \
  -background RoyalBlue
button .f1.b1  -text "Next LC" \
  -width 12 \
  -command { nextLC }
button .f1.b2  -text "Puff" \
  -width 12 \
  -command { puff }
button .f1.b3  -text "Clear" \
  -width 12 \
  -command { clearcan }
pack .f1.b1 .f1.b2 .f1.b3 -side left
pack .f1

# declare the second frame
frame .f2 -relief groove -borderwidth 10 \
  -background RoyalBlue
scale .f2.s1 -from -2.0 -to 2.0 \
  -orient horizontal \
  -tickinterval 1.0 \
  -resolution 0.01 -digits 3 \
  -length $hres -label "Parameter a" \
  -command update_a \
  -bd 3 -fg yellow -bg RoyalBlue
scale .f2.s2 -from -2.0 -to 2.0 \
  -orient horizontal \
  -tickinterval 1.0 \
  -resolution 0.01 -digits 3 \
  -length $hres -label "Parameter b" \
  -command update_b \
  -bd 3 -fg yellow -bg RoyalBlue
pack .f2.s1 .f2.s2
pack .f2

# declare the box
canvas .can -width $hres -height $vres
# pack the canvas
pack .can

# one new button at the bottom
button .b4  -text "Snap Pic" \
  -width 36 \
  -command { printcan }
pack .b4

##### widget command procs #####

# slide 1
proc update_a { value } {
  global a
  set a $value
#  puts "a is now $a"
}

# slide 2
proc update_b { value } {
  global b
  set b $value
#  puts "b is now $b"
}

# next LC button
proc nextLC {} {
  global .can hres vres xmin xmax ymin ymax a b
  global listx listy listu listv
#  puts "in nextLC, before mapit, listx is now $listx"
#  puts "in nextLC, before mapit, listy is now $listy"
  mapit
#  puts "did mapit on next button"
#  puts "listu is now $listu"
#  puts "listv is now $listv"
  drawL $listu $listv
#  puts "did the drawL"
  # now get set for next time
  set listx $listu
  set listu {}
  set listy $listv
  set listv {}
}

# puff button
proc puff {} {
  global xnow ynow puffsize 
  set xtemp $xnow
  set ytemp $ynow
  for {set k 0 } { $k < $puffsize } { incr k } {
    set utemp [ ufunc $xtemp $ytemp ]
    set vtemp [ vfunc $xtemp $ytemp ]
    set i [ eye $utemp ]
    set j [ jay $vtemp ]
    dot $i $j
#    puts "placed a dot at point ( $utemp , $vtemp )"
    set xtemp $utemp
    set ytemp $vtemp
  }
  set xnow $xtemp
  set ynow $ytemp
}

# make a dot command
proc dot { x y } {
  #.can create line $x $y $x $y -fill red
  .can create line $x $y $x [expr $y-2] -fill red  -width 2
}

# clear button
proc clearcan {} {
  global hres vres listxf listyf listx listy listu listv
  destroy .can
  canvas .can -width $hres -height $vres
  pack .can
  # recompute fundamental with current a, b
  Lf
  # now restore all lists
  set listx $listxf
  set listy $listyf
  set listu {}
  set listv {}
  # now draw the fundamental
  drawL $listx $listy
}

# proc for button to snap a pic
# to print to a file (look for "canvas.ps" in Tcl/Tk folder)
proc printcan {} {
  .can postscript -colormode color \
  -file canvas.ps \
   -pagex 1.i -pagey 10.i -pageanchor nw \
  -width 300 -height 300 \
  -pageheight 6.i -pagewidth 6.i
}

##### my conversion library #####

# convert xvar back to horiz index value
proc eye { x } {
  global xmin xmax hres
  set inow [ expr  int ($hres * ( $x - $xmin ) / ( $xmax - $xmin )) ]
  return $inow
}

# convert yvar back to vertical index value
proc jay { y } {
  global ymin ymax vres
  set jnow [ expr  ($vres - int ($vres * ( $y - $ymin ) / ( $ymax - $ymin ))) ]
  return $jnow
}

##### define the functions #####

# define the map for fig 4-1 of chaos in discrete dyn sys

proc ufunc { xval yval } {
  global a tempx tempy
  return [ expr  $a * $xval + $yval ]
}
proc vfunc { xval yval } {
  global b
  return [ expr  $b + $xval * $xval ]
}

##### define the procs for the critical curves #####

# create lists of x and y coords for Lf = L -1
set listxf { }
set listyf { }
proc Lf {  } {
  global .can hres vres xmin xmax ymin ymax a b listxf listyf
  global numsegs
  set smin -1.0
  set smax 1.0
  set sdelta [ expr double ($smax - $smin)/$numsegs ]
  for {set k 0 } { $k < $numsegs } { incr k } {
    set listxf [linsert $listxf end 0.0]
    set listyf [linsert $listyf end [expr $smin + $k*$sdelta]]
  }
}
# ===========

#  apply the map to the curve stored in (listx, listy) and store in (listu, listv)
set listu {}
set listv {}
proc mapit {  } {
  global .can hres vres xmin xmax ymin ymax a b numsegs
  global listx listy listu listv
  set listu {}
  set listv {}
  for {set k 0 } { $k < $numsegs } { incr k } {
    #  apply the map
    set tempx [ lindex $listx $k ]
    set tempy [ lindex $listy $k ]
#    puts "mapit step $k, tempx is $tempx, tempy is $tempy"
    set u [ ufunc $tempx $tempy ]
    set v [ vfunc $tempx $tempy ]
#    puts "mapit step $k, u is $u, v is $v"
    set listu [linsert $listu end $u]
    set listv [linsert $listv end $v]
  }
} 

# draw the critical curve segment stored in (lx, ly)
proc drawL { lx ly } {
  global .can hres vres xmin xmax ymin ymax a b 
  set smin -1.0
  set smax 1.0
  set numsegs 10
  set drawsegs [ expr $numsegs-1 ]
  set sdelta [ expr double ($smax - $smin)/$numsegs ]
  for {set k 0 } { $k < $drawsegs } { incr k } {
    set x1 [ lindex $lx $k ] 
    set y1 [ lindex $ly $k ]
    set kn [ expr int ($k + 1) ]
    set x2 [ lindex $lx $kn ]
    set y2 [ lindex $ly $kn ]
    set i1 [ eye $x1 ]
    set j1 [ jay $y1 ]
    set i2 [ eye $x2 ]
    set j2 [ jay $y2 ]
    # puts "this is step from $k to $kn"
    .can create line $i1 $j1 $i2 $j2 -fill blue
  }
}

# now do it
# create lists of x and y coords for current LC
set listx {}
set listy {}
Lf
#puts "Lf is done"
#puts "listxf: $listxf"
#puts "listyf: $listyf"
drawL $listxf $listyf
#puts "Lf is drawn"
set listx $listxf
set listy $listyf
mapit
#puts "did mapit, L0 is done"
#puts "listu: $listu"
#puts "listv: $listv"
drawL $listu $listv
# and get ready for a NextLC
set listx $listu
set $listu {}
set listy $listv
set listv {}

#end: curves3.tcl