#!/usr/local/bin/wish -f
#Interactive spline drawing - Monty Stein 12/25/97 (from an original from '95)

#These need to be defined for their globalism more than being initialized
set point_list {}
set cursor_max_x 0
set cursor_max_y 0

#creates the tagged cursor graphics object when the pointer enters the canvas
proc cursorcreate { w x y } {
  global cursor_max_x
  global cursor_max_y

  set cursor_max_x [lindex [$w configure -width] 4]
  set cursor_max_y [lindex [$w configure -height] 4]

  $w create line 0 $y $cursor_max_x $y -fill red -tag cursorx
  $w create line $x 0 $x $cursor_max_y -fill red -tag cursory
}

#destroys the cursor when the pointer leaves the canvas
proc cursordestroy { w } {
  $w delete cursorx cursory
}

#all mouse movement passes through here, just move the cursor to where the
#   pointer is
proc cursormove { w x y } {
  global cursor_max_x
  global cursor_max_y

  $w coords cursorx 0 $y $cursor_max_x $y 
  $w coords cursory $x 0 $x $cursor_max_y 
}

#handle resizing of the window - be careful to not have the cursor displayed
#  when the rescale takes place so it can be the right size
proc cursorresize { w width height x y } {
  global cursor_max_x
  global cursor_max_y

  set border [$w cget -bd]
  set width [expr $width-4-(2*$border)]
  set height [expr $height-4-(2*$border)]

  set cursortags [$w gettags cursorx]

  if {$width!=$cursor_max_x || $height!=$cursor_max_y} {
    if {$cursortags!=""} {
      cursordestroy $w
    }
    $w configure -width $width -height $height
    if {$cursortags!=""} {
      cursorcreate $w $x $y
      cursormove $w $x $y
    }
  }
}

#place a spline control point on the canvas, manage the list of points
proc droppoint { w x y } {
  global point_list

  lappend point_list [list $x $y]
  $w create rectangle [expr $x-2] [expr $y-2] \
      [expr $x+2] [expr $y+2] -fill black -tag temppoint
  if {[llength $point_list]>1} {
    set lasttemppoint [lindex $point_list [expr [llength $point_list]-2]]
    $w create line [lindex $lasttemppoint 0] [lindex $lasttemppoint 1] \
          $x $y -tag temppoint -fill black
  }
}

#convert the list of points into a spline, calls the cancel routine to erase
#  the construction lines
proc finishpoint { w x y } {
  global point_list

  set tempstr "$w create line "
  foreach i $point_list {
    set tempstr "$tempstr [lindex $i 0] [lindex $i 1]"
  }
  set tempstr "$tempstr -smooth 1 -fill black"
  eval $tempstr
  cancelpoint $w
}

#abort the current spline, erases the drawn lines and resets the list of points
proc cancelpoint { w } {
  global point_list

  set point_list {}
  $w delete temppoint
}

canvas .c -relief groove -bd 5
button .quit -text Quit -command exit

#all the functions other than quit are handled through bindings
bind .c <Motion> "cursormove %W %x %y"
bind .c <Enter> "cursorcreate %W %x %y"
bind .c <Leave> "cursordestroy %W"
bind .c <Configure> "cursorresize %W %w %h %x %y"
bind .c <Button-1> "droppoint %W %x %y"
bind .c <Button-2> "cancelpoint .c"
bind .c <Button-3> "finishpoint %W %x %y"

pack .c -fill both -expand 1
pack .quit -fill x