#!/bin/sh
# Execute using simbio \
exec simbio "$0" "$@"

proc tktics {min max tic mark major orientation direction form} {
  set d [expr ($max-$min)/1000.0]
  if {$min < 0} {
    set i [expr 1-int((-$min+$d)/$tic)]
  } else {
    set i [expr 1+int(($min+$d)/$tic)]
  }
  for {} {$i*$tic <= $max-$d} {incr i} {
    set val [format $form [expr $i*$tic]]
    if {$orientation == "x"} {
      if {$direction == "-"} {
        set pos [expr int(($max-$i*$tic)/double($max-$min)*($geom::w-$geom::sb-$geom::sx))+$geom::sx]
      } else {
        set pos [expr int(($i*$tic-$min)/double($max-$min)*($geom::w-$geom::sb-$geom::sx))+$geom::sx]
      }
      if {$i % $mark == 0} {
        set geom::xtics($geom::nxtic) [.w.c create line $pos [expr $geom::h-$geom::sy] $pos [expr $geom::h-$geom::sy+10] -fill white]
        incr geom::nxtic
        set geom::xtics($geom::nxtic) [.w.c create text $pos [expr $geom::h-$geom::sy+14] -text $val -anchor n -fill white]
      } elseif {$i % $major == 0} {
        set geom::xtics($geom::nxtic) [.w.c create line $pos [expr $geom::h-$geom::sy] $pos [expr $geom::h-$geom::sy+7] -fill white]
      } else {
        set geom::xtics($geom::nxtic) [.w.c create line $pos [expr $geom::h-$geom::sy] $pos [expr $geom::h-$geom::sy+5] -fill white]
      }
      incr geom::nxtic
    } else {
      if {$direction == "-"} {
        set pos [expr int(($max-$i*$tic)/double($max-$min)*($geom::h-$geom::sb-$geom::sy))+$geom::sb]
      } else {
        set pos [expr int(($i*$tic-$min)/double($max-$min)*($geom::h-$geom::sb-$geom::sy))+$geom::sb]
      }
      if {$i % $mark == 0} {
        set geom::ytics($geom::nytic) [.w.c create line $geom::sx $pos [expr $geom::sx-10] $pos -fill white]
        incr geom::nytic
        set geom::ytics($geom::nytic) [.w.c create text [expr $geom::sx-14] $pos -text $val -anchor e -fill white]
      } elseif {$i % $major == 0} {
        set geom::ytics($geom::nytic) [.w.c create line $geom::sx $pos [expr $geom::sx-7] $pos -fill white]
      } else {
        set geom::ytics($geom::nytic) [.w.c create line $geom::sx $pos [expr $geom::sx-5] $pos -fill white]
      }
      incr geom::nytic
    }
  }
}

proc fxs {f x} {
  set np [fget $f -np]
  set ref [fget $f -ref]
  set sw [fget $f -sw]

  return [expr (($x-1)/double($np)-0.5)*$sw+$ref]
}

proc fys {f y} {
  set ni [fget $f -ni]
  set ref1 [fget $f -ref1]
  set sw1 [fget $f -sw1]

  return [expr (($y-1)/double($ni)-0.5)*$sw1+$ref1]
}

proc fxf {f x} {
  set np [fget $f -np]
  set sw [fget $f -sw]

  return [expr ($x-1)/double($sw)]
}

proc fyf {f y} {
  set ni [fget $f -ni]
  set sw1 [fget $f -sw1]

  return [expr ($y-1)/double($sw1)]
}

proc ixs {f x} {
  set np [fget $f -np]
  set ref [fget $f -ref]
  set sw [fget $f -sw]

  return [expr int((($x-$ref)/$sw + 0.5)*$np) + 1]
}

proc iys {f y} {
  set ni [fget $f -ni]
  set ref1 [fget $f -ref1]
  set sw1 [fget $f -sw1]

  return [expr int((($y-$ref1)/$sw1 + 0.5)*$ni) + 1]
}

proc plot {} {
  set g [split [lindex [split [wm geometry .w] +] 0] x]
  set geom::w [lindex $g 0]
  set geom::h [lindex $g 1]
  
  if {$geom::w != $geom::oldw || $geom::h != $geom::oldh} {
    set geom::status "Geometry changed $geom::w $geom::h"
    set geom::contour_changed 1
    set geom::scale_changed 1
    set geom::oldw $geom::w
    set geom::oldh $geom::h
    set geom::sw [expr $geom::w-$geom::sb-$geom::sx]
    set geom::sh [expr $geom::h-$geom::sb-$geom::sy]
  }
  if {$geom::scale_changed == 1} {
    if {[fget $geom::f(1) -type] == "spe"} {
      set geom::xmin [fxs $geom::f(1) $geom::imin]
      set geom::xmax [fxs $geom::f(1) $geom::imax]
      set geom::ymin [fys $geom::f(1) $geom::jmin]
      set geom::ymax [fys $geom::f(1) $geom::jmax]
    } else {
      set geom::xmin [fxf $geom::f(1) $geom::imin]
      set geom::xmax [fxf $geom::f(1) $geom::imax]
      set geom::ymin [fyf $geom::f(1) $geom::jmin]
      set geom::ymax [fyf $geom::f(1) $geom::jmax]
    }
    set tic [expr ($geom::xmax-$geom::xmin)*10.0/$geom::w]
    set ticn [expr int(log10($tic))]
    if {$tic < 1} {incr ticn -1}
    set ticn [expr pow(10,$ticn)]
    set dtic [expr $tic/$ticn]
    if {$dtic < 2} {
      set geom::xtic [expr $ticn]
    } elseif {$dtic < 4} {
      set geom::xtic [expr 2*$ticn]
    } elseif {$dtic < 7} {
      set geom::xtic [expr 5*$ticn]
    } else {
      set geom::xtic [expr 10*$ticn]
    }
    set geom::xmajor 5
    set geom::xmark 10
    set tic [expr ($geom::ymax-$geom::ymin)*10.0/$geom::w]
    set ticn [expr int(log10($tic))]
    if {$tic < 1} {incr ticn -1}
    set ticn [expr pow(10,$ticn)]
    set dtic [expr $tic/$ticn]
    if {$dtic < 2} {
      set geom::ytic [expr $ticn]
    } elseif {$dtic < 4} {
      set geom::ytic [expr 2*$ticn]
    } elseif {$dtic < 7} {
      set geom::ytic [expr 5*$ticn]
    } else {
      set geom::ytic [expr 10*$ticn]
    }
    set geom::ymajor 5
    set geom::ymark 10
    
    for {set dec 0} {$dec < 10} {incr dec} {
      set x1 [expr $geom::xtic*$geom::xmark*pow(10,$dec)]
      set x2 [expr int($geom::xtic*$geom::xmark*pow(10,$dec))]
      if {abs($x1-$x2) < 1e-6} {
        break
      }
    }
    set geom::xform "%.${dec}f"
    for {set dec 0} {$dec < 10} {incr dec} {
      set x1 [expr $geom::ytic*$geom::ymark*pow(10,$dec)]
      set x2 [expr int($geom::ytic*$geom::ymark*pow(10,$dec))]
      if {abs($x1-$x2) < 1e-6} {
        break
      }
    }
    set geom::yform "%.${dec}f"
    set geom::scale_changed 0
    for {set i 0} {$i < $geom::nxtic} {incr i} {
      if [info exists geom::xtics($i)] {.w.c delete $geom::xtics($i)}
    }
    set geom::nxtic 0
    for {set i 0} {$i < $geom::nytic} {incr i} {
      if [info exists geom::ytics($i)] {.w.c delete $geom::ytics($i)}
    }
    set geom::nytic 0
    if {[fget $geom::f(1) -type] == "spe"} {
      tktics $geom::xmin $geom::xmax $geom::xtic $geom::xmark $geom::xmajor x - $geom::xform
      tktics $geom::ymin $geom::ymax $geom::ytic $geom::ymark $geom::ymajor y + $geom::yform
    } else {
      tktics $geom::xmin $geom::xmax $geom::xtic $geom::xmark $geom::xmajor x + $geom::xform
      tktics $geom::ymin $geom::ymax $geom::ytic $geom::ymark $geom::ymajor y - $geom::yform
    }
  }
  if {$geom::contour_changed == 1} {
    if [info exists geom::f(1)] {
      if {[fget $geom::f(1) -type] == "spe"} {
        set d [fcontour $geom::f(1) -nlevels 10 -skiplevels 0 -posneg -type gif -xmin $geom::imin -xmax $geom::imax -ymin $geom::jmin -ymax $geom::jmax -width $geom::sw -height $geom::sh]
      } else {
        set d [fcontour $geom::f(1) -nlevels 10 -skiplevels 1 -xreverse -yup -posneg -type gif -xmin $geom::imin -xmax $geom::imax -ymin $geom::jmin -ymax $geom::jmax -width $geom::sw -height $geom::sh]
      }
      set geom::status "Spectrum drawn"
      $geom::img configure -data $d
      if [info exists geom::frame] {.w.c delete $geom::frame}
      set geom::frame [.w.c create rectangle $geom::sx $geom::sb [expr $geom::sw+$geom::sx] [expr $geom::sb+$geom::sh] -outline white]
    }
    set geom::contour_changed 0
  }
}
proc mousepress {n x y} {
#  if {$spectrum::n < 1} {return}
  if {$n == 1} {
    if [info exists geom::moverectangle] {
      .w.c delete $geom::moverectangle
      unset geom::moverectangle
    }
    if {$x < $geom::sx || $x > $geom::w-$geom::sb || \
        $y < $geom::sb || $y > $geom::h-$geom::sy} {return}
    set geom::firstcorner_x $x
    set geom::firstcorner_y $y
  } elseif {$n == 3} {
    set geom::imin 1
    set geom::imax [fget $geom::f(1) -np]
    set geom::jmin 1
    set geom::jmax [fget $geom::f(1) -ni]
    set geom::scale_changed 1
    set geom::contour_changed 1
    plot
  }
}
proc mousemove {n x y} {
#  if {$spectrum::n < 1} {return}
  if ![info exists geom::firstcorner_x] {return}
  if {$n == 1} {
    if {$x < $geom::sx} {set x $geom::sx}
    if {$x > $geom::w-$geom::sb} {set x [expr $geom::w-$geom::sb]}
    if {$y < $geom::sb} {set y $geom::sb}
    if {$y > $geom::h-$geom::sy} {set y [expr $geom::h-$geom::sy]}
    if ![info exists geom::moverectangle] {
      set geom::moverectangle [.w.c create rectangle $geom::firstcorner_x $geom::firstcorner_y $x $y -outline white]
    } else {
      .w.c coords $geom::moverectangle $geom::firstcorner_x $geom::firstcorner_y $x $y
    }
    if {abs($x-$geom::firstcorner_x) < 10 && abs($y-$geom::firstcorner_y)} {
      .w.c itemconfigure $geom::moverectangle -outline red
    } else {
      .w.c itemconfigure $geom::moverectangle -outline white
    }
  }
}
proc mouserelease {n x y} {
#  if {$spectrum::n < 1} {return}
  if ![info exists geom::moverectangle] {return}
  if {$n == 1} {
    .w.c delete $geom::moverectangle
    if {$x < $geom::sx} {set x $geom::sx}
    if {$x > $geom::w-$geom::sb} {set x [expr $geom::w-$geom::sb]}
    if {$y < $geom::sb} {set y $geom::sb}
    if {$y > $geom::h-$geom::sy} {set y [expr $geom::h-$geom::sy]}
    if {abs($x-$geom::firstcorner_x) < 10 && abs($y-$geom::firstcorner_y)} {return}
    if {[fget $geom::f(1) -type] == "spe"} {
      set x1 [expr ($geom::w-$geom::sb - $geom::firstcorner_x)/double($geom::w-$geom::sb-$geom::sx)]
      set x2 [expr ($geom::w-$geom::sb - $x)/double($geom::w-$geom::sb-$geom::sx)]
      set y1 [expr ($geom::firstcorner_y-$geom::sb)/double($geom::h-$geom::sb-$geom::sy)]
      set y2 [expr ($y-$geom::sb)/double($geom::h-$geom::sb-$geom::sy)]
    } else {
      set x1 [expr ($geom::firstcorner_x - $geom::sx)/double($geom::w-$geom::sb-$geom::sx)]
      set x2 [expr ($x - $geom::sx)/double($geom::w-$geom::sb-$geom::sx)]
      set y1 [expr ($geom::h-$geom::sy - $geom::firstcorner_y)/double($geom::h-$geom::sb-$geom::sy)]
      set y2 [expr ($geom::h-$geom::sy - $y)/double($geom::h-$geom::sb-$geom::sy)]
    }
    if {$x1 > $x2} {
      set imin [expr $x2*($geom::imax-$geom::imin)+$geom::imin]
      set imax [expr $x1*($geom::imax-$geom::imin)+$geom::imin]
    } else {
      set imin [expr $x1*($geom::imax-$geom::imin)+$geom::imin]
      set imax [expr $x2*($geom::imax-$geom::imin)+$geom::imin]
    }
    if {$y1 > $y2} {
      set jmin [expr $y2*($geom::jmax-$geom::jmin)+$geom::jmin]
      set jmax [expr $y1*($geom::jmax-$geom::jmin)+$geom::jmin]
    } else {
      set jmin [expr $y1*($geom::jmax-$geom::jmin)+$geom::jmin]
      set jmax [expr $y2*($geom::jmax-$geom::jmin)+$geom::jmin]
    }
    set geom::imin $imin
    set geom::imax $imax
    set geom::jmin $jmin
    set geom::jmax $jmax
    set geom::contour_changed 1
    set geom::scale_changed 1
    unset geom::moverectangle
    plot
  }
}

namespace eval geom {
  variable w
  variable h
  variable oldw 0
  variable oldh 0
  variable contour_changed 0
  variable scale_changed 0
  variable xmark
  variable xmajor
  variable xform
  variable ymark
  variable ymajor
  variable yform
  variable status
  variable sx 100
  variable sb 5
  variable sy 80

  set xtics(0) 1
  set ytics(0) 1
}

proc quit {} {
  set ::neverexit 1
  exit
}


proc main {} {
  global argv
  
  wm withdraw .
  toplevel .w
  bind .w <Control-q> {exit}
  
  frame .w.b
  button .w.b.q -text "Quit" -command {quit}
  pack .w.b.q -side left
  pack .w.b -side top -fill x -padx 2 -pady 2

  frame .w.statusbar
  label .w.statusbar.label -textvariable geom::status -relief flat -bd 1 -font "Helvetica 10" -anchor w
  pack .w.statusbar.label -side left -padx 2 -expand yes -fill both
  pack .w.statusbar -side bottom -fill x -pady 2

  canvas .w.c -width 500 -height 500 -background black
  set geom::img [image create photo]
  .w.c create image $geom::sx $geom::sb -anchor nw -image $geom::img

  bind .w <Expose> plot
  bind .w <Configure> plot
  bind .w <Destroy> {exit}
  bind .w.c <1> "mousepress 1 %x %y"
  bind .w.c <3> "mousepress 3 %x %y"
  bind .w.c <B1-Motion> "mousemove 1 %x %y"
  bind .w.c <ButtonRelease-1> "mouserelease 1 %x %y"

  set geom::f(1) [fload [lindex $::argv 1]]

  set geom::imin 1
  set geom::imax [fget $geom::f(1) -np]
  set geom::jmin 1
  set geom::jmax [fget $geom::f(1) -ni]
  set geom::nxtic 0
  set geom::nytic 0
  set geom::scale_changed 1
  set geom::contour_changed 1
  
  pack .w.c -fill both -expand yes
  vwait ::neverexit
  
}
