#!/opt/local/bin/wish8.0 -f

set APPMAPDIR $env(HOME)/bits/tkdraw

set GREYMAPDIR $env(HOME)/bits/grey

lappend auto_path $env(HOME)/tcl/lib

#  The above lines may require changes, see the included README
#  MAKE NO CHANGES BELOW THIS LINE

#Things To Do:
#
#Better interface for nailing down
#  is it item under cursor, or current item???
#  to confusing to use both
#  see below, about differentiation between current and selected
#
#shared clipboard
# clipboard append -type ttkdraw "canvas command string"
# selection get -selection CLIPBOARD -type ttkdraw
#
#use bindtags to improve binding handling
#
#improve options window
#  only show relevant options for selected item
#  font options
#  image options
#
#better differentiation between current and selected
#  the following operate on current, but unselected, items:
#    finish_addpoint		menu only
#    finish_deletepoint		menu only
#    selectungroup		kbd only
#    unnail                     kbd only
#    togglenail                 kbd only
#would a menu help?  control-rightbutton -> unnail, nail, ungroup, info
#and add/del point options would appear only if appropriate?
#could also have options changing via menu?
#
#tcl/tk command window
#
#setting of default options for each type
#undos (of lots of things)
#window scrolling, zooming
#oval-rectangle conversions
#sketch curve fitting
#interface lock-outs where appropriate (e.g. moving points while adding points
#  or using menus while adding an object or turning off reshape for groups)
#    (I think this is all done???)
#error messages (e.g. failure to add or delete a point)
#
#options window that dynamically hides/disables unneeded attributes
#more options for various things (arrow heads)
#options for text
#fonts
#rc file, to make easier to deal with different "installs" (majel vs. bedbugs)
#deal with gridlines on "Open" - set variables
#don't save control points???

option add *[tk appname]*HighlightThickness 0 90

#set APPDIR $env(HOME)/tcl
if [file exists ~/.tkdrawrc] { source ~/.tkdrawrc }

#source $APPDIR/color_widget
#source $APPDIR/color_palette
package require tomsCompletionLib
  namespace import ::tomsCompletionLib::*
package require tomsColorPaletteLib
  namespace import ::tomsColorPaletteLib::*

wm minsize . 100 100
wm maxsize . 1000 1200

frame .top1 -relief raised -bd 2
frame .top2 -relief raised -bd 2
canvas .canvas -relief raised -bd 2 -width 600 -height 350 -background white \
	       -closeenough 5
scrollbar .vscroll
pack append . .top1 {top fillx}
pack append . .top2 {top fillx}
pack append . .vscroll {right filly}
pack append . .canvas {top padx 2 pady 2 fillx filly expand}
.vscroll set 100 30 0 30

menubutton .top1.file -text File -menu .top1.file.menu
menu .top1.file.menu
.top1.file.menu add command -label About -command "help about"
.top1.file.menu add command -label New -command new
.top1.file.menu add command -label Open -command {onentry myopen}
.top1.file.menu add command -label Insert -command {onentry load}
.top1.file.menu add command -label "Load Image" -command {wm deiconify .image}
.top1.file.menu add command -label Save -command {dosave $currfile}
.top1.file.menu add command -label "Save As" -command {onentry dosave $currfile}
.top1.file.menu add command -label Revert -state disabled
.top1.file.menu add command -label Print -command {onentry print "|lpr"}
.top1.file.menu add separator
.top1.file.menu add command -label Quit -command "destroy ."

menubutton .top1.edit -text Edit -menu .top1.edit.menu
menu .top1.edit.menu
.top1.edit.menu add command -label Cut -command cutselected \
      -accelerator ^X
.top1.edit.menu add command -label Copy -command copyselected \
      -accelerator ^C
.top1.edit.menu add command -label Paste -command paste \
      -accelerator ^V
.top1.edit.menu add separator
.top1.edit.menu add command -label "Add Point" -command addpoint \
      -accelerator KP+
.top1.edit.menu add command -label "Delete Point" -command deletepoint \
      -accelerator KP-
.top1.edit.menu add separator
.top1.edit.menu add command -label "Ungroup" -command ungroupselected \
      -accelerator KP/
.top1.edit.menu add separator
.top1.edit.menu add command -label "Nail down" -command nailselected \
      -accelerator !
.top1.edit.menu add command -label "Pry up" -command unnail \
      -accelerator !
.top1.edit.menu add separator
.top1.edit.menu add command -label "Raise 1 layer" -command raiseby1 \
      -accelerator Up
.top1.edit.menu add command -label "Lower 1 layer" -command lowerby1 \
      -accelerator Down
.top1.edit.menu add command -label "Raise to Top" -command raiseselected \
      -accelerator Home
.top1.edit.menu add command -label "Lower to Bottom" -command lowerselected \
      -accelerator End
.top1.edit.menu add separator
.top1.edit.menu add command -label "Rotate ccw 5\260" \
      -command "rotateselected 5 +" -accelerator ,
.top1.edit.menu add command -label "Rotate cw 5\260" \
      -command "rotateselected 5 -" -accelerator .
.top1.edit.menu add command -label "Rotate ccw 15\260" \
      -command "rotateselected 15 +" -accelerator <
.top1.edit.menu add command -label "Rotate cw 15\260" \
      -command "rotateselected 15 -" -accelerator >
.top1.edit.menu add separator
.top1.edit.menu add command -label "Shrink to 95%" \
      -command "scaleselected 0.95" -accelerator -
.top1.edit.menu add command -label "Enlarge to 105%" \
      -command "scaleselected 1.05" -accelerator =
.top1.edit.menu add command -label "Shrink to 50%" \
      -command "scaleselected 0.5" -accelerator _
.top1.edit.menu add command -label "Enlarge to 200%" \
      -command "scaleselected 2.00" -accelerator +

pack append .top1 .top1.file left
pack append .top1 .top1.edit left

menubutton .top1.options -text Options -menu .top1.options.menu
menu .top1.options.menu
.top1.options.menu add checkbutton -variable grid(snap) -label "Snap to Grid"
.top1.options.menu add checkbutton -variable grid(show) -label "Show Grid" \
      -command showgrid
.top1.options.menu add cascade -label Grouping -menu .top1.options.menu.sel
.top1.options.menu add cascade -label Grid -menu .top1.options.menu.grid
.top1.options.menu add cascade -label CloseEnough -menu .top1.options.menu.close
menu .top1.options.menu.sel
.top1.options.menu.sel add radio -label overlapping -variable seltype
.top1.options.menu.sel add radio -label enclosed -variable seltype
menu .top1.options.menu.grid
for {set i 2} {$i<=20} {incr i} {
  .top1.options.menu.grid add radio -label $i -variable grid(space) \
	-command showgrid
}
menu .top1.options.menu.close
for {set i 1} {$i<=20} {incr i} {
  .top1.options.menu.close add radio -label $i \
		     -command ".canvas config -closeenough $i"
}
unset i
pack append .top1 .top1.options left

menubutton .top1.reshape -text Reshape -menu .top1.reshape.menu1
menu .top1.reshape.menu1
.top1.reshape.menu1 add command -command {convert 0 0 0} \
	-bitmap @$APPMAPDIR/multiline.xbm
.top1.reshape.menu1 add command -command {convert 1 0 0} \
	-bitmap @$APPMAPDIR/curve.xbm
.top1.reshape.menu1 add command -command {convert 0 1 0} \
	-bitmap @$APPMAPDIR/polygon.xbm
.top1.reshape.menu1 add command -command {convert 1 1 0} \
	-bitmap @$APPMAPDIR/polyspline.xbm
.top1.reshape.menu1 add command -command {convert 0 1 1} \
	-bitmap @$APPMAPDIR/solid_polygon.xbm
.top1.reshape.menu1 add command -command {convert 1 1 1} \
	-bitmap @$APPMAPDIR/solid_polyspline.xbm

menu .top1.reshape.menu2
.top1.reshape.menu2 add command -command {convert2pt line} \
	-bitmap @$APPMAPDIR/line.xbm
.top1.reshape.menu2 add command -command {convert2pt rectangle} \
	-bitmap @$APPMAPDIR/rectangle.xbm
.top1.reshape.menu2 add command -command {convert2pt oval} \
	-bitmap @$APPMAPDIR/oval.xbm
.top1.reshape.menu2 add command -command {convert2pt arc arc} \
	-bitmap @$APPMAPDIR/arc.xbm
.top1.reshape.menu2 add command -command {convert2pt arc chord} \
	-bitmap @$APPMAPDIR/chord.xbm
.top1.reshape.menu2 add command -command {convert2pt arc pieslice} \
	-bitmap @$APPMAPDIR/pie.xbm

menu .top1.reshape.menu3
.top1.reshape.menu3 add command -label "<None>"

tk_menuBar .top1 .top1.file .top1.edit .top1.options .top1.reshape
pack append .top1 .top1.reshape left

menubutton .top1.fonts -text Fonts
pack append .top1 .top1.fonts left

menubutton .top1.help -text Help -menu .top1.help.menu
menu .top1.help.menu
.top1.help.menu add command -label General -command "help general"
.top1.help.menu add command -label Modes -command "help modes"
.top1.help.menu add command -label Mouse -command "help mouse"
.top1.help.menu add command -label Keyboard -command "help keybd"
.top1.help.menu add command -label Menus -command "help menus"
.top1.help.menu add command -label Palette -command "help palette"
.top1.help.menu add separator
.top1.help.menu add command -label About -command "help about"
pack append .top1 .top1.help right

set currfile "NoName"
message .top1.filename -textvar currfile -aspect 10000
pack append .top1 .top1.filename right

#message .top1.len -text "" -aspect 10000 -width 120
label .top1.len -text "" -width 12 -anchor w
pack append .top1 .top1.len right
#message .top1.mousey -text "" -aspect 10000 -width 50
label .top1.mousey -text "" -width 8 -anchor w
pack append .top1 .top1.mousey right
#message .top1.mousex -text "" -aspect 10000 -width 50
label .top1.mousex -text "" -width 8 -anchor w
pack append .top1 .top1.mousex right

button .top2.sketch -command "changemode sketch" \
	-bitmap @$APPMAPDIR/sketch.xbm
button .top2.line -command "changemode line" \
	-bitmap @$APPMAPDIR/line.xbm
button .top2.multiline -command "changemode multiline" \
	-bitmap @$APPMAPDIR/multiline.xbm
button .top2.curve -command "changemode curve" \
	-bitmap @$APPMAPDIR/curve.xbm
button .top2.polyline -command "changemode polyline" \
	-bitmap @$APPMAPDIR/polygon.xbm
button .top2.polycurve -command "changemode polycurve" \
	-bitmap @$APPMAPDIR/polyspline.xbm
button .top2.polygon -command "changemode polygon" \
	-bitmap @$APPMAPDIR/solid_polygon.xbm
button .top2.polyspline -command "changemode polyspline" \
	-bitmap @$APPMAPDIR/solid_polyspline.xbm
button .top2.rectangle -command "changemode rectangle" \
	-bitmap @$APPMAPDIR/filled_rectangle.xbm
button .top2.oval -command "changemode oval" \
	-bitmap @$APPMAPDIR/filled_oval.xbm
button .top2.arc -command "changemode arc" \
	-bitmap @$APPMAPDIR/arc.xbm
button .top2.chord -command "changemode chord" \
	-bitmap @$APPMAPDIR/chord.xbm
button .top2.pie -command "changemode pie" \
	-bitmap @$APPMAPDIR/pie.xbm
button .top2.dotext -command "changemode dotext" \
	-bitmap @$APPMAPDIR/text.xbm
button .top2.image -command "wm deiconify .image" \
	-bitmap @$APPMAPDIR/image.xbm
label .top2.sellabel -text "Group:"
menubutton .top2.selmenu -textvar seltype -menu .top2.selmenu.menu
menu .top2.selmenu.menu
.top2.selmenu.menu add command -label overlapping \
      -command {set seltype overlapping}
.top2.selmenu.menu add command -label enclosed \
      -command {set seltype enclosed}

bind Scale <2> { %W set [expr [ %W get ]-1]}
bind Scale <3> { %W set [expr [ %W get ]+1]}

pack append .top2 .top2.sketch left
pack append .top2 .top2.line left
pack append .top2 .top2.multiline left
pack append .top2 .top2.curve left
pack append .top2 .top2.polyline left
pack append .top2 .top2.polycurve left
pack append .top2 .top2.polygon left
pack append .top2 .top2.polyspline left
pack append .top2 .top2.rectangle left
pack append .top2 .top2.oval left
pack append .top2 .top2.arc left
pack append .top2 .top2.chord left
pack append .top2 .top2.pie left
pack append .top2 .top2.dotext left
pack append .top2 .top2.image left
pack append .top2 .top2.selmenu right
pack append .top2 .top2.sellabel right

mkPalette .pal 12 6
wm group .pal .
wm transient .pal .

focus .canvas
bind .canvas <Configure> "showgrid %w %h"

set optionlock 0
set grid(space) 0
set grid(snap) 0
set grid(show) 0
set inline 0
set multi(smooth) 0
set multi(close) 0
set multi(shift) 0
set stipple none
set stipmap ""
set fill none
set fillcolor ""
set color black
set current 0
set copybuf(coords) ""
set copybuf(type) ""
set copybuf(config) ""
set seltype overlapping
set lastgroup 0
set mode "line"
set groupcords(0) ""
set lastx 0
set lasty 0

set default(sketch) {1 #000000 {none 128 ""} {none #ffffff}}
set default(line) {1 #000000 {none 128 @} {none #ffffff}}
set default(multiline) {1 #000000 {none 128 ""} {none #ffffff}}
set default(curve) {1 #000000 {none 128 ""} {none #ffffff}}
set default(polyline) {1 #000000 {none 128 ""} {none #ffffff}}
set default(polycurve) {1 #000000 {none 128 ""} {none #ffffff}}
set default(polygon) {1 #000000 {none 128 ""} {none #ffffff}}
set default(polyspline) {1 #000000 {none 128 ""} {none #ffffff}}
set default(rectangle) {1 #000000 {none 128 ""} {none #ffffff}}
set default(oval) {1 #000000 {none 128 ""} {none #ffffff}}

if [llength $argv] {
  set currfile [lindex $argv 0]
} else {
  set currfile ""
}

proc changemode {m} {
  global mode
  .top2.$mode config -relief raised
  set mode $m
  .top2.$mode config -relief sunken
  $m
}

proc sketch {} {
  resetall
  #this routine doesn't need to worry about other bindings, because the
  #B1-modifier avoids conflicts (it will still conflict with the
  #"Any-" modifier or the "B1-" modifier, but I don't use them anywhere (yet)).
  bind .canvas <1> "start_multiline %x %y"
  bind .canvas <ButtonRelease-1> "end_multiline %x %y"
  bind .canvas <B1-Motion> "add_multiline %x %y"
}

proc dotext {} {
  resetall
  bind .canvas <1> "add_text %x %y"
  bind .canvas <KeyPress> {.canvas insert [.canvas focus] insert %A}
  bind .canvas <Shift-KeyPress> {.canvas insert [.canvas focus] insert %A}
  bind .canvas <Return> {.canvas insert [.canvas focus] insert \n}
  bind .canvas <BackSpace> {textBs .canvas}
  bind .canvas <Control-h> {textBs .canvas}
  bind .canvas <Delete> {textBs .canvas}
  bind .canvas <Escape> {.canvas focus ""}
  bind .canvas <Left> {textLeft .canvas}
  bind .canvas <Right> {textRight .canvas}
  bind .canvas <comma> {}
  bind .canvas <period> {}
  bind .canvas <less> {}
  bind .canvas <greater> {}
  bind .canvas <minus> {}
  bind .canvas <equal> {}
  bind .canvas <underscore> {}
  bind .canvas <plus> {}
  bind .canvas <v> {}
  bind .canvas <Control-x> {}
  bind .canvas <Control-c> {}
  bind .canvas <Control-v> {.canvas insert [.canvas focus] insert [selection get]}
}

proc line {} {
  resetall
  #this routine doesn't need to worry about other bindings, because the
  #B1-modifier avoids conflicts (it will still conflict with the
  #"Any-" modifier or the "B1-" modifier, but I don't use them anywhere (yet)).
  bind .canvas <1> "add_multiline %x %y"
  bind .canvas <ButtonRelease-1> "end_multiline %x %y"
  bind .canvas <B1-Motion> "change_multiline %x %y"
  bind .canvas <Shift-1> "set multi(shift) 1; add_multiline %x %y"
  bind .canvas <Shift-ButtonRelease-1> "end_multiline %x %y; set multi(shift) 0"
  bind .canvas <Shift-B1-Motion> "change_multiline %x %y"
}

proc multiline {} {
  resetall
  bind .canvas <1> {
    clearbindings
    bind .canvas <ButtonRelease-1> {add_multiline %%x %%y}
    bind .canvas <Motion> {change_multiline %%x %%y}
    bind .canvas <3> {end_multiline %%x %%y; $mode}
  }
  bind .canvas <Shift-1> {
    set multi(shift) 1
    clearbindings
    bind .canvas <ButtonRelease-1> {add_multiline %%x %%y}
    bind .canvas <Motion> {change_multiline %%x %%y}
    bind .canvas <3> {end_multiline %%x %%y; set multi(shift) 0; $mode}
  }
}

proc curve {} {
  global multi
  resetall
  set multi(smooth) 1
  bind .canvas <1> {
    clearbindings
    bind .canvas <ButtonRelease-1> {add_multiline %%x %%y}
    bind .canvas <Motion> {change_multiline %%x %%y}
    bind .canvas <3> {end_multiline %%x %%y; $mode}
  }
}

proc polyline {} {
  global multi
  resetall
  set multi(close) 1
  bind .canvas <1> {
    clearbindings
    bind .canvas <ButtonRelease-1> {add_multiline %%x %%y}
    bind .canvas <Motion> {change_multiline %%x %%y}
    bind .canvas <3> {end_multiline %%x %%y; $mode}
  }
}

proc polycurve {} {
  global multi
  resetall
  set multi(close) 1
  set multi(smooth) 1
  bind .canvas <1> {
    clearbindings
    bind .canvas <ButtonRelease-1> {add_multiline %%x %%y}
    bind .canvas <Motion> {change_multiline %%x %%y}
    bind .canvas <3> {end_multiline %%x %%y; $mode}
  }
}

proc polygon {} {
  resetall
  bind .canvas <1> {
    clearbindings
    bind .canvas <ButtonRelease-1> {add_polygon %%x %%y}
    bind .canvas <Motion> {change_polygon %%x %%y}
    bind .canvas <3> {end_polygon %%x %%y; $mode}
  }
}

proc polyspline {} {
  global multi
  resetall
  set multi(smooth) 1
  bind .canvas <1> {
    clearbindings
    bind .canvas <ButtonRelease-1> {add_polygon %%x %%y}
    bind .canvas <Motion> {change_polygon %%x %%y}
    bind .canvas <3> {end_polygon %%x %%y; $mode}
  }
}

proc start_multiline {x y} {
  global inline current cords multi
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  #if in a line already, don't start a new one
  if $inline {return}
  .canvas config -cursor crosshair
  grab .canvas
  set current [.canvas create line $x $y $x $y]
  .canvas delete control
  if $multi(smooth) { .canvas itemconfig $current -smooth 1 }
  set cords [list $x $y $x $y]
  set inline 1
  setoptions
}

proc end_multiline {x y} {
  global inline current cords multi
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  if !$inline {return}
  change_multiline $x $y
  if $multi(close) { add_multiline [lindex $cords 0] [lindex $cords 1]}
  set inline 0
  grab release .canvas
  .canvas config -cursor ""
  drawcontrols $current
}

proc add_multiline {x y} {
  global inline current cords
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  if !$inline {
    start_multiline $x $y
  } else {
    eval .canvas coords $current $cords $x $y
    lappend cords $x $y
  }
}

proc change_multiline {x y} {
  global inline current cords multi
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  showcoords $x $y
  if !$inline {return}
  if $multi(shift) {
    set lx [lindex $cords [expr [llength $cords]-4]]
    set ly [lindex $cords [expr [llength $cords]-3]]
    set dx [expr $x-$lx]
    set dy [expr $y-$ly]
    if [expr abs($dx)>2*(abs($dy))] {
      #horizontal
      set y $ly
    } elseif [expr abs($dy)>2*(abs($dx))] {
      #vertical
      set x $lx
    } else {
      #diagonal
      if ($dy>0&&$dx<0)||($dx>0&&$dy<0) { set sign -1 } else { set sign 1 }
      if [expr abs($dx)>abs($dy)] {
	set x [expr $lx+$sign*$dy]
      } else {
	set y [expr $ly+$sign*$dx]
      }
    }
    set cords [lrange $cords 0 [expr [llength $cords]-3]]
    eval .canvas coords $current $cords $x $y
    lappend cords $x $y
  } else {
    set cords [lrange $cords 0 [expr [llength $cords]-3]]
    eval .canvas coords $current $cords $x $y
    lappend cords $x $y
  }
#  if (1) {
#    set len [expr sqrt(pow([lindex $cords [expr [llength $cords]-4]]-$x,2)+pow([lindex $cords [expr [llength $cords]-3]]-$y,2))]
#    .top1.filename config -text $len -textvar ""
#  }
  showlen [expr sqrt(pow([lindex $cords [expr [llength $cords]-4]]-$x,2)+pow([lindex $cords [expr [llength $cords]-3]]-$y,2))]
}

proc multi_length {id} {
  set cords [.canvas coords $id]
  set ox [lindex $cords 0]
  set oy [lindex $cords 1]
  set total 0.0
  for {set i 2} {$i<[llength $cords]} {incr i 2} {
    set x [lindex $cords $i]
    set y [lindex $cords [expr $i+1]]
    set len [expr sqrt(pow($ox-$x,2)+pow($oy-$y,2))]
    set total [expr $total+$len]
    set ox $x
    set oy $y
  }
  return $total
}

#polygon stuff
proc start_polygon {x y} {
  global inline current cords multi
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  #if in a line already, don't start a new one
  if $inline {return}
  .canvas config -cursor crosshair
  grab .canvas
  set current [.canvas create polygon $x $y $x $y $x $y]
  .canvas delete control
  if $multi(smooth) { .canvas itemconfig $current -smooth 1 }
  set cords [list $x $y $x $y $x $y]
  set inline 1
  setoptions
}

proc end_polygon {x y} {
  global inline current cords multi
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  if !$inline {return}
  set cords [lrange $cords 2 [expr [llength $cords]-1]]
  eval .canvas coords $current $x $y $cords
  set inline 0
  grab release .canvas
  .canvas config -cursor ""
  drawcontrols $current
}

proc add_polygon {x y} {
  global inline current cords
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  if !$inline {
    start_polygon $x $y
  } else {
    eval .canvas coords $current $cords $x $y
    lappend cords $x $y
  }
}

proc change_polygon {x y} {
  global inline current cords
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  showcoords $x $y
  if !$inline {return}
  set cords [lrange $cords 0 [expr [llength $cords]-3]]
  eval .canvas coords $current $cords $x $y
  lappend cords $x $y
  showlen [expr sqrt(pow([lindex $cords [expr [llength $cords]-4]]-$x,2)+pow([lindex $cords [expr [llength $cords]-3]]-$y,2))]
}

proc change_coords {index x y} {
  global current cords
  set x [snaptogrid $x]
  set y [snaptogrid $y]

  if ($current<1) {return}

  set endind [expr [llength $cords]-2]

  if {$index=="start"} {
    set index 0
  } elseif {$index=="end"} {
    set index $endind
  }

  if ($index==0) {
    if {([lindex $cords 0]==[lindex $cords $endind]) &&
       ([lindex $cords 1]==[lindex $cords [expr $endind+1]])} {
      set cords [lreplace $cords $endind [expr $endind+1] $x $y]
      .canvas coords ind$endind [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]
    }
  } elseif ($index==$endind) {
    if {([lindex $cords 0]==[lindex $cords $endind]) &&
       ([lindex $cords 1]==[lindex $cords [expr $endind+1]])} {
      set cords [lreplace $cords 0 1 $x $y]
      .canvas coords ind0 [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]
    }
  }
  set cords [lreplace $cords $index [expr $index+1] $x $y]

  eval .canvas coords $current $cords
  .canvas coords ind$index [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]
}

#rectangle stuff
proc rectangle {} {
  resetall
  bind .canvas <1> {.canvas delete control; set current [.canvas create rectangle [snaptogrid %x] [snaptogrid %y] [snaptogrid %x] [snaptogrid %y]]; setoptions}
  bind .canvas <B1-Motion> {
    set tmp_oval_x [snaptogrid %x]
    set tmp_oval_y [snaptogrid %y]
    showcoords $tmp_oval_x $tmp_oval_y
    .canvas coords $current \
	[lindex [.canvas coords $current] 0] \
	[lindex [.canvas coords $current] 1] \
	$tmp_oval_x $tmp_oval_y
  }
  bind .canvas <Shift-1> {.canvas delete control; set current [.canvas create rectangle [snaptogrid %x] [snaptogrid %y] [snaptogrid %x] [snaptogrid %y]]; setoptions}
  bind .canvas <Shift-B1-Motion> {
    set tmp_oval_x [snaptogrid %x]
    set tmp_oval_y [snaptogrid %y]
    showcoords $tmp_oval_x $tmp_oval_y
    set tmp_oval_diff_x [expr $tmp_oval_x-[lindex [.canvas coords $current] 0]]
    set tmp_oval_diff_y [expr $tmp_oval_y-[lindex [.canvas coords $current] 1]]
    if $tmp_oval_diff_x>0&&$tmp_oval_diff_x<=$tmp_oval_diff_y {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_oval_x [expr [lindex [.canvas coords $current] 1]+$tmp_oval_diff_x]
    } elseif $tmp_oval_diff_y>0&&$tmp_oval_diff_y<$tmp_oval_diff_x {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  [expr [lindex [.canvas coords $current] 0]+$tmp_oval_diff_y] $tmp_oval_y
    } elseif $tmp_oval_diff_y>0&&$tmp_oval_diff_x<=0 {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_oval_x [lindex [.canvas coords $current] 1]
    } elseif $tmp_oval_diff_y<=0&&$tmp_oval_diff_x>0 {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  [lindex [.canvas coords $current] 0] $tmp_oval_y
    } else {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_oval_x $tmp_oval_y
    }
  }
  bind .canvas <ButtonRelease-1> {drawcontrols $current}
}

proc oval {} {
  resetall
  bind .canvas <1> {.canvas delete control; set current [.canvas create oval [snaptogrid %x] [snaptogrid %y] [snaptogrid %x] [snaptogrid %y]]; setoptions}
  bind .canvas <B1-Motion> {
    set tmp_oval_x [snaptogrid %x]
    set tmp_oval_y [snaptogrid %y]
    showcoords $tmp_oval_x $tmp_oval_y
    .canvas coords $current \
	[lindex [.canvas coords $current] 0] \
	[lindex [.canvas coords $current] 1] \
	$tmp_oval_x $tmp_oval_y
  }
  bind .canvas <Shift-1> {.canvas delete control; set current [.canvas create oval [snaptogrid %x] [snaptogrid %y] [snaptogrid %x] [snaptogrid %y]]; setoptions}
  bind .canvas <Shift-B1-Motion> {
    set tmp_oval_x [snaptogrid %x]
    set tmp_oval_y [snaptogrid %y]
    showcoords $tmp_oval_x $tmp_oval_y
    set tmp_oval_diff_x [expr $tmp_oval_x-[lindex [.canvas coords $current] 0]]
    set tmp_oval_diff_y [expr $tmp_oval_y-[lindex [.canvas coords $current] 1]]
    if $tmp_oval_diff_x>0&&$tmp_oval_diff_x<=$tmp_oval_diff_y {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_oval_x [expr [lindex [.canvas coords $current] 1]+$tmp_oval_diff_x]
    } elseif $tmp_oval_diff_y>0&&$tmp_oval_diff_y<$tmp_oval_diff_x {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  [expr [lindex [.canvas coords $current] 0]+$tmp_oval_diff_y] $tmp_oval_y
    } elseif $tmp_oval_diff_y>0&&$tmp_oval_diff_x<=0 {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_oval_x [lindex [.canvas coords $current] 1]
    } elseif $tmp_oval_diff_y<=0&&$tmp_oval_diff_x>0 {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  [lindex [.canvas coords $current] 0] $tmp_oval_y
    } else {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_oval_x $tmp_oval_y
    }
  }
  bind .canvas <ButtonRelease-1> {drawcontrols $current}
}

proc arc {} {
  arc_real arc
}

proc chord {} {
  arc_real chord
}

proc pie {} {
  arc_real pieslice
}

proc arc_real {type} {
  resetall
  bind .canvas <1> ".canvas delete control; set current \[.canvas create arc \[snaptogrid %x\] \[snaptogrid %y\] \[snaptogrid %x\] \[snaptogrid %y\] -style $type\]; setoptions"
  bind .canvas <B1-Motion> {
    set tmp_arc_x [snaptogrid %x]
    set tmp_arc_y [snaptogrid %y]
    showcoords $tmp_arc_x $tmp_arc_y
    .canvas coords $current \
	[lindex [.canvas coords $current] 0] \
	[lindex [.canvas coords $current] 1] \
	$tmp_arc_x $tmp_arc_y
  }
  bind .canvas <Shift-1> {.canvas delete control; set current [.canvas create arc [snaptogrid %x] [snaptogrid %y] [snaptogrid %x] [snaptogrid %y] -style $type]; setoptions}
  bind .canvas <Shift-B1-Motion> {
    set tmp_arc_x [snaptogrid %x]
    set tmp_arc_y [snaptogrid %y]
    showcoords $tmp_arc_x $tmp_arc_y
    set tmp_arc_diff_x [expr $tmp_arc_x-[lindex [.canvas coords $current] 0]]
    set tmp_arc_diff_y [expr $tmp_arc_y-[lindex [.canvas coords $current] 1]]
    if $tmp_arc_diff_x>0&&$tmp_arc_diff_x<=$tmp_arc_diff_y {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_arc_x [expr [lindex [.canvas coords $current] 1]+$tmp_arc_diff_x]
    } elseif $tmp_arc_diff_y>0&&$tmp_arc_diff_y<$tmp_arc_diff_x {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  [expr [lindex [.canvas coords $current] 0]+$tmp_arc_diff_y] $tmp_arc_y
    } elseif $tmp_arc_diff_y>0&&$tmp_arc_diff_x<=0 {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_arc_x [lindex [.canvas coords $current] 1]
    } elseif $tmp_arc_diff_y<=0&&$tmp_arc_diff_x>0 {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  [lindex [.canvas coords $current] 0] $tmp_arc_y
    } else {
      .canvas coords $current \
	  [lindex [.canvas coords $current] 0] \
	  [lindex [.canvas coords $current] 1] \
	  $tmp_arc_x $tmp_arc_y
    }
  }
  bind .canvas <ButtonRelease-1> {drawcontrols $current}
}

proc showgrid {args} {
  global grid

  .canvas delete grid

  if $grid(show)&&$grid(space) {
    if [llength $args]==2 {
      set wd [lindex $args 0]
      set ht [lindex $args 1]
    } else {
      set wd [winfo width .canvas]
      set ht [winfo height .canvas]
    }
    for {set i 0} {$i<$wd} {incr i $grid(space)} {
      .canvas create line $i 0 $i $ht -fill #e0e0e0 -tags grid
    }
    for {set i 0} {$i<$ht} {incr i $grid(space)} {
      .canvas create line 0 $i $wd $i -fill #e0e0e0 -tags grid
    }
    .canvas lower grid
  }
}

proc snaptogrid {val} {
  global grid
  if ($grid(space)&&$grid(snap)) {
    #add half-grid to value to cause things to round both up and down
    incr val [expr $grid(space)/2]
    return [expr int($val-$val%$grid(space))]
  } else {
    return $val
  }
}

#text stuff
proc add_text {x y} {
  global current

  #if we clicked on text, edit it instead of creating new text
  set curr [.canvas find withtag current]
  if [string compare [.canvas type $curr] "text"]==0 {
    .canvas icursor $curr @$x,$y
    .canvas focus $curr
    if $current { .canvas delete control }
    set current $curr
  } else {
    set current [.canvas create text $x $y -anchor nw -tags "text"]
    .canvas delete control
    .canvas focus $current
  }
  drawcontrols $current
}

proc textBs {w} {
  set focus [$w focus]
  if [string length $focus]==0 return
  set char [expr {[$w index $focus insert] - 1}]
  if {$char >= 0} {$w dchar $focus $char}
}

proc textLeft {w} {
  set focus [$w focus]
  if [string length $focus]==0 return
  $w icursor $focus [expr [$w index $focus insert]-1]
}

proc textRight {w} {
  set focus [$w focus]
  if [string length $focus]==0 return
  $w icursor $focus [expr [$w index $focus insert]+1]
}

proc clearbindings {} {
  foreach b [bind .canvas] {
    bind .canvas $b ""
  }
}

proc resetall {} {
  global multi

  set multi(smooth) 0
  set multi(close) 0
  set multi(shift) 0
  bind .canvas <1> {}
  bind .canvas <Shift-1> {}
  bind .canvas <2> {selectitem %x %y}
  bind .canvas <Double-Button-2> {drawsizers $current}
  bind .canvas <Shift-2> {startgroup %x %y}
  bind .canvas <3> {}
  bind .canvas <Shift-3> {selectungroup %x %y}
  bind .canvas <ButtonRelease-1> {}
  bind .canvas <ButtonRelease-2> {resetcords}
  bind .canvas <ButtonRelease-3> {}
  bind .canvas <Motion> {highlightcontrol %x %y}
  bind .canvas <B1-Motion> {}
  bind .canvas <Shift-B1-Motion> {}
  bind .canvas <B2-Motion> {dragitem %x %y}
  bind .canvas <Shift-B2-Motion> {draggroup %x %y}
  bind .canvas <Shift-ButtonRelease-2> {endgroup %x %y}
  bind .canvas <B3-Motion> {}
  bind .canvas <Control-Motion> {selectitem %x %y}

  bind .canvas <v> {toggleselectionpointer}
  bind .canvas <Control-x> {cutselected}
  bind .canvas <Control-c> {copyselected}
  bind .canvas <Control-v> {paste}
  bind .canvas <Up> {raiseby1}
  bind .canvas <Down> {lowerby1}
  #Home key
  bind .canvas <F27> {raiseselected}
  #End key
  bind .canvas <R13> {lowerselected}
  bind .canvas <Delete> {deleteselected}
  bind .canvas <comma> {rotateselected 5 +}
  bind .canvas <period> {rotateselected 5 -}
  bind .canvas <less> {rotateselected 15 +}
  bind .canvas <greater> {rotateselected 15 -}
  bind .canvas <minus> {scaleselected 0.95}
  bind .canvas <equal> {scaleselected 1.05}
  bind .canvas <underscore> {scaleselected 0.5}
  bind .canvas <plus> {scaleselected 2.0}
  bind .canvas <KP_Add> {finish_addpoint %x %y}
  bind .canvas <KP_Subtract> {finish_deletepoint %x %y}
  bind .canvas <F24> {finish_deletepoint %x %y}
  bind .canvas <KeyPress> {}
  bind .canvas <Shift-KeyPress> {}
  bind .canvas <Return> {}
  bind .canvas <BackSpace> {}
  bind .canvas <Control-h> {}
  bind .canvas <Escape> {}
  bind .canvas <Left> {}
  bind .canvas <Right> {}
  bind .canvas <F25> {ungroupselected}
  bind .canvas <exclam> {togglenail}
}

proc resetcords {} {
  global current cords groupcords

  if [string first group $current]==0 {
    unset groupcords
    foreach item [.canvas find withtag $current] {
      set groupcords($item) [.canvas coords $item] 
    }
  } else {
    set cords [.canvas coords $current]
  }
}

proc drawcontrols {itemnum} {
  global cords

  set cords [.canvas coords $itemnum]

  for {set i 0} {$i < [llength $cords]} {incr i 2} {
    set curcoords [lrange $cords $i [expr $i+1]]
    .canvas create rectangle [expr [lindex $curcoords 0]-2] \
        [expr [lindex $curcoords 1]-2] [expr [lindex $curcoords 0]+2] \
        [expr [lindex $curcoords 1]+2] -tags "control ind$i" -fill white
  }

  setup_reshapemenu
}

proc drawsizers {grouporitem} {
  global cords sizer groupcords

  .canvas delete control

  #abbreviations:
  #ll==lower left      lr==lower right     ul==upper left      ur==upper right
  #lm==lower middle    um==upper middle    ml==middle left     mr==middle right
  #lx==left x          rx==right x         uy==upper y         ly==lower y

  if [string first group $grouporitem]==0 {
    #too slow to scan all points for everything in a group, so use less
    #accurate bbox.  Try to adjust coords inward by two to make it more
    #accurate
    set bbox [.canvas bbox $grouporitem]
    set lx [expr [lindex $bbox 0]+2]
    set uy [expr [lindex $bbox 1]+2]
    set rx [expr [lindex $bbox 2]-2]
    set ly [expr [lindex $bbox 3]-2]

    unset groupcords
    foreach item [.canvas find withtag $grouporitem] {
      set groupcords($item) [.canvas coords $item] 
    }
  } else {
    #using bbox gives a slightly oversized area, which results in redrawing
    #inconsistent with the scaled positions, so scan all points
    set cords [.canvas coords $grouporitem]
    set lx 10000000; set ly 10000000
    set rx -10000000; set uy -10000000
    for {set i 0} {$i < [llength $cords]} {incr i 2} {
      set tmpx [lindex $cords $i]
      set tmpy [lindex $cords [expr $i+1]]
      if $tmpx<$lx { set lx $tmpx }
      if $tmpx>$rx { set rx $tmpx }
      if $tmpy<$ly { set ly $tmpy }
      if $tmpy>$uy { set uy $tmpy }
    }
  }

  set mx [expr ($lx+$rx)/2]
  set my [expr ($uy+$ly)/2]

  set sizer(width) [expr $rx-$lx]
  set sizer(height) [expr $ly-$uy]

  #corner controls
  .canvas create rectangle [expr $lx-2] [expr $uy-2] [expr $lx+2] [expr $uy+2] \
      -tags "control sizer-ul" -fill white
  .canvas create rectangle [expr $rx-2] [expr $uy-2] [expr $rx+2] [expr $uy+2] \
      -tags "control sizer-ur" -fill white
  .canvas create rectangle [expr $lx-2] [expr $ly-2] [expr $lx+2] [expr $ly+2] \
      -tags "control sizer-ll" -fill white
  .canvas create rectangle [expr $rx-2] [expr $ly-2] [expr $rx+2] [expr $ly+2] \
      -tags "control sizer-lr" -fill white

  #side controls
  .canvas create rectangle [expr $mx-2] [expr $uy-2] [expr $mx+2] [expr $uy+2] \
      -tags "control sizer-um" -fill white
  .canvas create rectangle [expr $mx-2] [expr $ly-2] [expr $mx+2] [expr $ly+2] \
      -tags "control sizer-lm" -fill white
  .canvas create rectangle [expr $lx-2] [expr $my-2] [expr $lx+2] [expr $my+2] \
      -tags "control sizer-ml" -fill white
  .canvas create rectangle [expr $rx-2] [expr $my-2] [expr $rx+2] [expr $my+2] \
      -tags "control sizer-mr" -fill white

  setup_reshapemenu
}

proc convert {smooth closed filled} {
  global current cords

  if [string first group $current]==0 return
  if {"$current"=="0"} return
  set type [.canvas type $current]
  if ([string compare $type oval]==0)||([string compare $type rectangle]==0) {
    return
  }

  if $filled {
    if [string compare $type line]==0 {
      set newcurr [eval .canvas create polygon $cords]
      .canvas itemconfig $newcurr -fill [lindex [.canvas itemconfig $current -fill] 4]
      .canvas itemconfig $newcurr -stipple [lindex [.canvas itemconfig $current -stipple] 4]
      .canvas itemconfig $newcurr -smooth [lindex [.canvas itemconfig $current -smooth] 4]
      .canvas delete $current
      set current $newcurr
      #reset coords because an open line will gain an endpoint as a polygon
      set cords [.canvas coords $current]
    }
  } else {
    if [string compare $type polygon]==0 {
      set newcurr [eval .canvas create line $cords]
      .canvas itemconfig $newcurr -fill [lindex [.canvas itemconfig $current -fill] 4]
      .canvas itemconfig $newcurr -stipple [lindex [.canvas itemconfig $current -stipple] 4]
      .canvas itemconfig $newcurr -smooth [lindex [.canvas itemconfig $current -smooth] 4]
      .canvas delete $current
      set current $newcurr
    }
  }

  if $smooth {
    .canvas itemconfig $current -smooth 1
  } else {
    .canvas itemconfig $current -smooth 0
  }

  set endind [expr [llength $cords]-2]
  set curclosed 0
  if {([lindex $cords 0]==[lindex $cords $endind]) &&
     ([lindex $cords 1]==[lindex $cords [expr $endind+1]])} { set curclosed 1 }

  if $closed {
    if !$curclosed {
      lappend cords [lindex $cords 0] [lindex $cords 1]
      eval .canvas coords $current $cords
    }
  } else {
    if $curclosed {
      set cords [lreplace $cords $endind [expr $endind+1]]
      eval .canvas coords $current $cords
    }
  }
}

proc convert2pt {type args} {
  global current cords color
  set oldtype [.canvas type $current]
  switch $type {
    line {
      if {"$oldtype"=="$type"} return
      set newcurr [eval .canvas create line $cords]
      .canvas itemconfig $newcurr -width [.canvas itemcget $current -width]
      .canvas itemconfig $newcurr -stipple [.canvas itemcget $current -stipple]
      if ![catch ".canvas itemcget $current -outline" outline] {
	.canvas itemconfig $newcurr -fill $outline
      } else {
	.canvas itemconfig $newcurr -fill [.canvas itemcget $current -fill]
      }
      .canvas delete $current
      set current $newcurr
    }
    oval {
      if {"$oldtype"=="$type"} return
      set newcurr [eval .canvas create oval $cords]
      .canvas itemconfig $newcurr -width [.canvas itemcget $current -width]
      .canvas itemconfig $newcurr -fill [.canvas itemcget $current -fill]
      .canvas itemconfig $newcurr -stipple [.canvas itemcget $current -stipple]
      if ![catch ".canvas itemcget $current -outline" outline] {
	.canvas itemconfig $newcurr -outline $outline
      } else {
	.canvas itemconfig $newcurr -outline $color
      }
      .canvas delete $current
      set current $newcurr
    }
    rectangle {
      if {"$oldtype"=="$type"} return
      set newcurr [eval .canvas create rectangle $cords]
      .canvas itemconfig $newcurr -width [.canvas itemcget $current -width]
      .canvas itemconfig $newcurr -fill [.canvas itemcget $current -fill]
      .canvas itemconfig $newcurr -stipple [.canvas itemcget $current -stipple]
      if ![catch ".canvas itemcget $current -outline" outline] {
	.canvas itemconfig $newcurr -outline $outline
      } else {
	.canvas itemconfig $newcurr -outline $color
      }
      .canvas delete $current
      set current $newcurr
    }
    arc {
      set style $args
      if {"$oldtype"=="$type"} {
	.canvas itemconfig $current -style $style
      } else {
	set newcurr [eval .canvas create arc $cords -style $style]
	.canvas itemconfig $newcurr -width [.canvas itemcget $current -width]
	.canvas itemconfig $newcurr -fill [.canvas itemcget $current -fill]
	.canvas itemconfig $newcurr -stipple [.canvas itemcget $current -stipple]
	if ![catch ".canvas itemcget $current -outline" outline] {
	  .canvas itemconfig $newcurr -outline $outline
	} else {
	  .canvas itemconfig $newcurr -outline $color
	}
	.canvas itemconfig $newcurr -start [.options.startangle.scale get]
	.canvas itemconfig $newcurr -extent [.options.extent.scale get]
	.canvas delete $current
	set current $newcurr
      }
    }
  }
}

proc cutselected {} {
  global copybuf current cords

  if [string compare $current 0]==0 return
  if [string first group $current]==0 {
    set copybuf(type) group
    set counter 0
    set copybuf(subgroups) ""
    foreach item [.canvas find withtag $current] {
      set copybuf(type.$counter) [.canvas type $item]
      set copybuf(coords.$counter) [.canvas coords $item]
      set copybuf(config.$counter) ""
      foreach option [.canvas itemconfig $item] {
	if [string length [lindex $option 4]] {
	  lappend copybuf(config.$counter) [lindex $option 0]
	  lappend copybuf(config.$counter) [lindex $option 4]
	}
      }
      #we need a list of every group number used in the items in the group
      #for when we do the paste, and have to replace all those numbers
      foreach tag [.canvas gettags $item] {
	if [string first group $tag]==0 {
	  set gn [string trimleft $tag group]
	  if [lsearch -exact $copybuf(subgroups) $gn]<0 {
	    lappend copybuf(subgroups) $gn
	  }
	}
      }
      incr counter
    }
    set copybuf(groupcount) $counter
    set copybuf(subgroups) [lsort $copybuf(subgroups)]
  } else {
    set copybuf(type) [.canvas type $current]
    set copybuf(coords) $cords
    set copybuf(config) ""
    foreach option [.canvas itemconfig $current] {
      if [string length [lindex $option 4]] {
	lappend copybuf(config) [lindex $option 0]
	lappend copybuf(config) [lindex $option 4]
      }
    }
  }
  .canvas delete $current
  .canvas delete control
  set current 0
}

proc copyselected {} {
  global copybuf current cords

  if [string compare $current 0]==0 return
  if [string first group $current]==0 {
    set copybuf(type) group
    set counter 0
    set copybuf(subgroups) ""
    foreach item [.canvas find withtag $current] {
      set copybuf(type.$counter) [.canvas type $item]
      set copybuf(coords.$counter) [.canvas coords $item]
      set copybuf(config.$counter) ""
      foreach option [.canvas itemconfig $item] {
	if [string length [lindex $option 4]] {
	  lappend copybuf(config.$counter) [lindex $option 0]
	  lappend copybuf(config.$counter) [lindex $option 4]
	}
      }
      #we need a list of every group number used in the items in the group
      #for when we do the paste, and have to replace all those numbers
      foreach tag [.canvas gettags $item] {
	if [string first group $tag]==0 {
	  set gn [string trimleft $tag group]
	  if [lsearch -exact $copybuf(subgroups) $gn]<0 {
	    lappend copybuf(subgroups) $gn
	  }
	}
      }
      incr counter
    }
    set copybuf(groupcount) $counter
    set copybuf(subgroups) [lsort $copybuf(subgroups)]
  } else {
    set copybuf(type) [.canvas type $current]
    set copybuf(coords) $cords
    set copybuf(config) ""
    foreach option [.canvas itemconfig $current] {
      if [string length [lindex $option 4]] {
	lappend copybuf(config) [lindex $option 0]
	lappend copybuf(config) [lindex $option 4]
      }
    }
  }
}

proc paste {} {
  global copybuf current cords lastgroup

  if [string length $copybuf(type)]==0 return
  if [string compare $copybuf(type) group]==0 {
    foreach oldid $copybuf(subgroups) {
      incr lastgroup
      set newid($oldid) $lastgroup
    }
    for {set i 0} {$i<$copybuf(groupcount)} {incr i} {
      #create the item
      set tmpcur [eval .canvas create $copybuf(type.$i) $copybuf(coords.$i) $copybuf(config.$i)]
      #change the group ids within the item
      foreach tag [.canvas gettags $tmpcur] {
	if [string first group $tag]==0 {
	  set gn [string trimleft $tag group]
	  .canvas dtag $tmpcur $tag
	  .canvas addtag group$newid($gn) withtag $tmpcur
	}
      }
    }
    .canvas delete control
    drawsizers $current
  } else {
    set newcur [eval .canvas create $copybuf(type) $copybuf(coords) $copybuf(config)]
    set current $newcur
    set cords [.canvas coords $current]
    .canvas delete control
    drawcontrols $current
    #need to reset options here
  }
}

proc addpoint {} {
  global current

  resetall
  bind .canvas <1> {}
  bind .canvas <B1-Motion> {}
  bind .canvas <ButtonRelease-1> "finish_addpoint %x %y"
  bind .canvas <2> {}
  bind .canvas <B2-Motion> {}
  bind .canvas <ButtonRelease-2> {}
  bind .canvas <Double-Button-2> {}
  bind .canvas <3> {}
  bind .canvas <B3-Motion> {}
  bind .canvas <ButtonRelease-3> {}
  .canvas delete control
  set current 0
  .canvas config -cursor crosshair
}

proc finish_addpoint {x y} {
  global mode current cords

  #reset the bindings to current mode
  $mode

  .canvas config -cursor ""
  set item [.canvas find withtag current]

  #don't operate on controls or grid elements
  if [lsearch -exact [.canvas gettags $item] control]>=0 return
  if [lsearch -exact [.canvas gettags $item] grid]>=0 return

  if [string length $item]==0 return
  #only work on lines and polygons
  set type [.canvas type $item]
  if {[string compare $type polygon]
      &&[string compare $type line]} return
  #NOT#only work on selected item
  #if $item!=$current return

  set clist [.canvas coords $item]

  #minimum distance is 20.  min is minimum distance squared
  set min 400
  set minindex -1
  for {set i 0} {$i < [expr [llength $clist]-2]} {incr i 2} {
    set x1 [lindex $clist $i]
    set y1 [lindex $clist [expr $i+1]]
    set x2 [lindex $clist [expr $i+2]]
    set y2 [lindex $clist [expr $i+3]]

    #the new point should be "between" the two points being compared.  If
    #it isn't, skip to the next.  We can't check for between both x values
    #and why values, because line segment could be horizontal or vertical.
    #alternative method would be within circle with segment as diameter
    set btw 0
    if ($x1<$x2) {
      if ($x>=$x1&&$x<=$x2) { incr btw }
    } else {
      if ($x>=$x2&&$x<=$x1) { incr btw }
    }
    if ($y1<$y2) {
      if ($y>=$y1&&$y<=$y2) { incr btw }
    } else {
      if ($y>=$y2&&$y<=$y1) { incr btw }
    }
    if ($btw==0) continue

    # let v1 be the vector for the line segment
    # let v2 be the vector for the first point of the line, to the clicked pnt
    # cos of angle between v1 and v2 is v1 dot v2, divided by magnituds
    # length of vector along v1 to intersection (v1prime) is cos * magv2
    # so dist from x1,y1 to intersection is known, x1,y1 to clickpoint
    # (hypotenuse) is known, find distance to line
    # length of v1:
    set magv1 [expr sqrt(($x2-$x1)*($x2-$x1) + ($y2-$y1)*($y2-$y1))]
    #magv1 will be used for division - make sure it isn't zero
    if $magv1==0.0 { set magv1 0.1 }
    # length of original v2
    set magv2 [expr sqrt(($x-$x1)*($x-$x1) + ($y-$y1)*($y-$y1))]
    # cos of angle between v1 and v2
    set magv1prime [expr (($x2-$x1)*($x-$x1) + ($y2-$y1)*($y-$y1))/$magv1]
    # we only need distance for comparison purposes, so don't take sqrt()
    set distsquared [expr $magv2*$magv2-$magv1prime*$magv1prime]

    if $distsquared<$min {
      set minindex $i
      set min $distsquared
    }
  }
  if ($minindex!=-1) {
    set x [snaptogrid $x]
    set y [snaptogrid $y]
    set cords [linsert $clist [expr $minindex+2] $x $y]
    eval .canvas coords $item $cords
    set current $item
    .canvas delete control
    drawcontrols $current
    resetoptions
  }
}

proc deletepoint {} {
  global current

  resetall
  bind .canvas <1> {}
  bind .canvas <B1-Motion> {}
  bind .canvas <ButtonRelease-1> "finish_deletepoint %x %y"
  bind .canvas <2> {}
  bind .canvas <B2-Motion> {}
  bind .canvas <ButtonRelease-2> {}
  bind .canvas <3> {}
  bind .canvas <B3-Motion> {}
  bind .canvas <ButtonRelease-3> {}
  .canvas delete control
  set current 0
  .canvas config -cursor crosshair
}

proc finish_deletepoint {x y} {
  global mode current cords

  #reset the bindings to current mode
  $mode

  .canvas config -cursor ""
  set item [.canvas find withtag current]

  #ignore grid items
  if [lsearch -exact [.canvas gettags $item] grid]>=0 return

  if [lsearch -exact [.canvas gettags $item] control]>=0 {
    if [string first group $current]==0 {
      return
    } else {
      set item $current
    }
  }

  if [string length $item]==0 return
  #only work on lines and polygons
  set type [.canvas type $item]
  if {[string compare $type polygon]
      &&[string compare $type line]} return
  #NOT#only work on selected item
  #if $item!=$current return

  set clist [.canvas coords $item]

  #minimum distance is 20.  min is minimum distance squared
  set min 400
  set minindex -1
  set len [llength $clist]
  for {set i 0} {$i < $len} {incr i 2} {
    set x1 [lindex $clist $i]
    set y1 [lindex $clist [expr $i+1]]

    set distsquared [expr ($x1-$x)*($x1-$x)+($y1-$y)*($y1-$y)]

    if $distsquared<$min {
      set minindex $i
      set min $distsquared
    }
  }
  if ($minindex!=-1) {
    #if item is a closed multiline (polyline) and deleted point is closure
    #point, then replace last (repeated closure) point with 2nd point
    if ($minindex==0)&&([string compare $type line]==0) {
      if {[lindex $clist 0]==[lindex $clist [expr $len-2]]&&
	  [lindex $clist 1]==[lindex $clist [expr $len-1]]} {
	set clist [lreplace $clist [expr $len-2] [expr $len-1] \
	    [lindex $clist 2] [lindex $clist 3] ]
      } else { puts blah }
    }
    set cords [lreplace $clist $minindex [expr $minindex+1]]
    if [string compare $type polygon]==0 {
      #polygons don't like having their point list shortened, so replace the
      #changed polygon with a new one
      foreach opt [.canvas itemconfig $item] {
	if [string compare [lindex $opt 4] ""]!=0 {
	  lappend options [lindex $opt 0]
	  lappend options [lindex $opt 4]
	}
      }
      set current [eval .canvas create polygon $cords $options]
      #make sure it stacks in the same place
      .canvas lower $current $item
      .canvas delete $item
    } else {
      eval .canvas coords $item $cords
      set current $item
    }
    .canvas delete control
    drawcontrols $current
    resetoptions
  }
}

proc raiseselected {} {
  global current

  if [string compare $current 0]==0 return
  .canvas raise $current
  #don't raise above controls
  .canvas raise control
}

proc lowerselected {} {
  global current grid

  if [string compare $current 0]==0 return
  .canvas lower $current
  #don't lower below grid
  if ($grid(space)&&$grid(show)) {
    .canvas lower grid
  }
}

proc raiseby1 {} {
  global current

  if [string compare $current 0]==0 return
  set all [.canvas find all]

  if [string first group $current]==0 {
    set glist [.canvas find withtag $current]
    #establish height based on HIGHEST item in group
    set highest [lindex $glist [expr [llength $glist]-1]]
    set currheight [lsearch -exact $all $highest]
    #if on top, return
    if ($currheight==[expr [llength $all]-1]) return
    set above [lindex $all [expr $currheight+1]]
    set gid [getmaingroupid $above]
    if $gid {
      #if the "above" item is part of a group, raise above whole group
      .canvas raise $current group$gid
    } else {
      .canvas raise $current $above
    }
  } else {
    set currheight [lsearch -exact $all $current]
    #if on top, return
    if ($currheight==[expr [llength $all]-1]) return
    set above [lindex $all [expr $currheight+1]]
    set gid [getmaingroupid $above]
    if $gid {
      #if the "above" item is part of a group, raise above whole group
      .canvas raise $current group$gid
    } else {
      .canvas raise $current $above
    }
  }
}

proc lowerby1 {} {
  global current

  if [string compare $current 0]==0 return
  set all [.canvas find all]

  if [string first group $current]==0 {
    set glist [.canvas find withtag $current]
    #establish height based on LOWEST item in group (since we're lowering)
    set lowest [lindex $glist 0]
    set currheight [lsearch -exact $all $lowest]
    #if on bottom, return
    if ($currheight==0) return
    set below [lindex $all [expr $currheight-1]]
    #don't lower below grid
    if [lsearch -exact [.canvas gettags $below] grid]>=0 return
    set gid [getmaingroupid $below]
    if $gid {
      #if the "below" item is part of a group, lower below whole group
      .canvas lower $current group$gid
    } else {
      .canvas lower $current $below
    }
  } else {
    set currheight [lsearch -exact $all $current]
    #if on bottom, return
    if ($currheight==0) return
    set below [lindex $all [expr $currheight-1]]
    set gid [getmaingroupid $below]
    if $gid {
      #if the "below" item is part of a group, lower below whole group
      .canvas lower $current group$gid
    } else {
      .canvas lower $current $below
    }
  }
}

proc rotateselected {angle direction} {
  global cords groupcords current

  if [string compare $current 0]==0 return

  set rangle [expr $angle*3.14159/180.0]

  if [string first group $current]==0 {
    .canvas delete control
    set cx 0
    set cy 0
    set count 0
    foreach item [.canvas find withtag $current] {
      for {set i 0} {$i < [llength $groupcords($item)]} {incr i 2} {
	set cx [expr $cx+[lindex $groupcords($item) $i]]
	set cy [expr $cy+[lindex $groupcords($item) [expr $i+1]]]
      }
      incr count [expr [llength $groupcords($item)]/2]
    }
    #make sure these are floats
    set cx [expr $cx/$count.0]
    set cy [expr $cy/$count.0]

    foreach item [.canvas find withtag $current] {
      rotate_item $item $cx $cy $angle $direction
      set groupcords($item) [.canvas coords $item]
    }
    drawsizers $current
  } else {
    .canvas delete control
    set cx 0
    set cy 0
    for {set i 0} {$i < [llength $cords]} {incr i 2} {
      set cx [expr $cx+[lindex $cords $i]]
      set cy [expr $cy+[lindex $cords [expr $i+1]]]
    }
    set count [expr [llength $cords]/2]
    set cx [expr $cx/$count.0]
    set cy [expr $cy/$count.0]

    rotate_item $current $cx $cy $angle $direction
    set cords [.canvas coords $current]
    drawcontrols $current
  }
}

#I thought this would be faster, using sin and cos, but not atan or sqrt,
#but it appears to be slower - about 20%.  It is based on quaternion
#rotation it also appears to be innaccurate - causing stretching.
#Also, doesn't yet account for direction
proc slow_rotate_item {item center_x center_y angle direction} {
  set itemcords [.canvas coords $item]
  if {[string compare [.canvas type $item] rectangle]==0 ||
      [string compare [.canvas type $item] oval]==0} {
    set ax [expr ([lindex $itemcords 0]+[lindex $itemcords 2])/2]
    set ay [expr ([lindex $itemcords 1]+[lindex $itemcords 3])/2]
    #do nothing if rotating about center of rectangle
    if ($ax==$center_x&&$ay==$center_y) return
    set dx [expr [lindex $itemcords 0]-$ax]
    set dy [expr [lindex $itemcords 1]-$ay]
    set itemcords [list $ax $ay]
  }
  set rangle [expr $angle*3.14159/180.0]
  set newcords ""
  for {set i 0} {$i < [llength $itemcords]} {incr i 2} {
    set x [expr [lindex $itemcords $i]-$center_x]
    set y [expr $center_y-[lindex $itemcords [expr $i+1]]]
    #use quaternion-style rotation
    set s [expr cos($rangle/2.0)]
    set axis [expr sin($rangle/2.0)]
    set vXpx [expr -$axis*$y]
    set vXpy [expr $axis*$x]
    lappend newcords [expr $s*$s*$x - 2.0*$s*$vXpx + $vXpy*$axis + $center_x]
    lappend newcords [expr $center_y - ($s*$s*$y - 2.0*$s*$vXpy + $vXpx*$axis)]
  }
  if {[string compare [.canvas type $item] rectangle]==0 ||
      [string compare [.canvas type $item] oval]==0} {
    set x1 [expr [lindex $newcords 0]-$dx]
    set x2 [expr [lindex $newcords 0]+$dx]
    set y1 [expr [lindex $newcords 1]-$dy]
    set y2 [expr [lindex $newcords 1]+$dy]
    .canvas coords $item $x1 $y1 $x2 $y2
  } else {
    eval .canvas coords $item $newcords
  }
}

proc rotate_item {item center_x center_y angle direction} {
  set itemcords [.canvas coords $item]
  if {[string compare [.canvas type $item] rectangle]==0 ||
      [string compare [.canvas type $item] arc]==0 ||
      [string compare [.canvas type $item] oval]==0} {
    set ax [expr ([lindex $itemcords 0]+[lindex $itemcords 2])/2]
    set ay [expr ([lindex $itemcords 1]+[lindex $itemcords 3])/2]
    #do nothing if rotating about center of rectangle
    if ($ax==$center_x&&$ay==$center_y) return
    set dx [expr [lindex $itemcords 0]-$ax]
    set dy [expr [lindex $itemcords 1]-$ay]
    set itemcords [list $ax $ay]
  }
  set rangle [expr $angle*3.14159/180.0]
  set newcords ""
  for {set i 0} {$i < [llength $itemcords]} {incr i 2} {
    set x [expr [lindex $itemcords $i]-$center_x]
    set y [expr $center_y-[lindex $itemcords [expr $i+1]]]
    if ($x==0) {
      if ($y==0) {
	lappend newcords [lindex $itemcords $i]
	lappend newcords [lindex $itemcords [expr $i+1]]
	continue
      } elseif ($y>0) {
	set cangle [expr 3.14159/2]
      } else {
	set cangle [expr 3.14159+3.14159/2]
      }
    } else {
      set cangle [expr atan($y/$x)]
      if ($x<0) { set cangle [expr $cangle+3.14159] }
    }
    set hyp [expr sqrt($x*$x+$y*$y)]
    lappend newcords [expr cos($cangle${direction}$rangle)*$hyp+$center_x]
    lappend newcords [expr $center_y-sin($cangle${direction}$rangle)*$hyp]
  }
  if {[string compare [.canvas type $item] rectangle]==0 ||
      [string compare [.canvas type $item] oval]==0} {
    set x1 [expr [lindex $newcords 0]-$dx]
    set x2 [expr [lindex $newcords 0]+$dx]
    set y1 [expr [lindex $newcords 1]-$dy]
    set y2 [expr [lindex $newcords 1]+$dy]
    .canvas coords $item $x1 $y1 $x2 $y2
  } else {
    eval .canvas coords $item $newcords
  }
}

proc scaleselected {amount} {
  global cords groupcords current

  if [string compare $current 0]==0 return
  
  if [string first group $current]==0 {
    .canvas delete control
    set cx 0
    set cy 0
    set count 0
    foreach item [.canvas find withtag $current] {
      for {set i 0} {$i < [llength $groupcords($item)]} {incr i 2} {
	set cx [expr $cx+[lindex $groupcords($item) $i]]
	set cy [expr $cy+[lindex $groupcords($item) [expr $i+1]]]
      }
      incr count [expr [llength $groupcords($item)]/2]
    }
    #make sure these are floats
    set cx [expr $cx/$count.0]
    set cy [expr $cy/$count.0]

    foreach item [.canvas find withtag $current] {
      .canvas scale $item $cx $cy $amount $amount
      set groupcords($item) [.canvas coords $item]
    }
    drawsizers $current
  } else {
    .canvas delete control
    set cx 0
    set cy 0
    for {set i 0} {$i < [llength $cords]} {incr i 2} {
      set cx [expr $cx+[lindex $cords $i]]
      set cy [expr $cy+[lindex $cords [expr $i+1]]]
    }
    set count [expr [llength $cords]/2]
    set cx [expr $cx/$count.0]
    set cy [expr $cy/$count.0]

    .canvas scale $current $cx $cy $amount $amount
    set cords [.canvas coords $current]
    drawcontrols $current
  }
}

proc startgroup {x y} {
  set x [expr $x+[.canvas canvasx 0]]
  set y [expr $y+[.canvas canvasy 0]]
  .canvas delete selectrect
  .canvas create rectangle $x $y $x $y -tag selectrect -width 0 -fill black \
	 -stipple gray50 -outline ""
}

proc draggroup {x y} {
  set x [expr $x+[.canvas canvasx 0]]
  set y [expr $y+[.canvas canvasy 0]]
  set coords [lrange [.canvas coords selectrect] 0 1]
  lappend coords $x
  lappend coords $y
  eval .canvas coords selectrect $coords
}

proc endgroup {x y} {
  global lastgroup current

  set x [expr $x+[.canvas canvasx 0]]
  set y [expr $y+[.canvas canvasy 0]]
  set coords [lrange [.canvas coords selectrect] 0 1]
  if [lindex $coords 0]==$x&&[lindex $coords 1]==$y {
    .canvas delete selectrect
    return
  }
  lappend coords $x
  lappend coords $y
  eval .canvas coords selectrect $coords
  #update
  if [group]==0 {
    return
  }
  set current group$lastgroup
  drawsizers group$lastgroup
}

proc group {} {
  global lastgroup seltype nailed

  #take all the selected items and tag them.
  set co [.canvas coords selectrect]
  .canvas delete selectrect
  if [string length $co]==0 {
    return 0
  }
  incr lastgroup
  set x1 [lindex $co 0]
  set y1 [lindex $co 1]
  set x2 [lindex $co 2]
  set y2 [lindex $co 3]

  set itemlist [.canvas find $seltype $x1 $y1 $x2 $y2]
  if [llength $itemlist]==0 {
    return 0
  }
  set count 0
  foreach item $itemlist {
    if [info exists nailed($item)] {
      if $nailed($item) continue
    }
    set otags [lindex [.canvas itemconfig $item -tags] 4]
    if [string length $otags]==0 {
      #no tags at all for this item
      .canvas itemconfig $item -tags group$lastgroup
      incr count
    } elseif [lsearch -exact $otags grid]>-1 {
      #don't group grid elements
      continue
    } elseif [lsearch -exact $otags group$lastgroup]>-1 {
      #this item is already in the right group
      continue
    } elseif [lsearch -glob $otags group*]>-1 {
      #this item is in other groups, but not this one
      set ingroup [getmaingroupid $item]
      .canvas addtag group$lastgroup withtag group$ingroup
      incr count
    } else {
      #this item is not in any groups
      .canvas addtag group$lastgroup withtag $item
      incr count
    }
  }
  return $count
}

proc nailselected {} {
  global current nailed
  set nailed($current) 1
  set current 0
  .canvas delete control
}

proc unnail {} {
  global current

  resetall
  bind .canvas <1> {}
  bind .canvas <B1-Motion> {}
  bind .canvas <ButtonRelease-1> "finish_unnail %x %y"
  bind .canvas <2> {}
  bind .canvas <B2-Motion> {}
  bind .canvas <ButtonRelease-2> {}
  bind .canvas <3> {}
  bind .canvas <B3-Motion> {}
  bind .canvas <ButtonRelease-3> {}
  .canvas delete control
  set current 0
  .canvas config -cursor crosshair
}

proc finish_unnail {} {
  global mode current cords nailed

  #reset the bindings to current mode
  $mode

  .canvas config -cursor ""
  set item [.canvas find withtag current]

  #ignore grid items
  if [lsearch -exact [.canvas gettags $item] grid]>=0 return

  if [lsearch -exact [.canvas gettags $item] control]>=0 {
    set item $current
  }

  if [string length $item]==0 return

  set current $item
  set nailed($current) 0

  .canvas delete control
  drawcontrols $current
  resetoptions
}

proc togglenail {} {
  global current nailed

  if ([string length $current]&&$current!=0) {
    nailselected
    return
  }
  .canvas config -cursor ""
  set item [.canvas find withtag current]

  #ignore grid items
  if [lsearch -exact [.canvas gettags $item] grid]>=0 return

  if [lsearch -exact [.canvas gettags $item] control]>=0 {
    set item $current
  }

  if [string length $item]==0 return

  if ![info exists nailed($item)] {
    set nailed($item) 1
  } elseif $nailed($item) {
    set nailed($item) 0
    .canvas delete control
    set current $item
    drawcontrols $current
  } else {
    set nailed($item) 1
  }
}

proc ungroupselected {} {
  global current
  if [string first group $current]!=0 return
  ungroup [string trimleft $current group]
  .canvas delete control
  set current 0
}

proc selectungroup {x y} {
  global current
  set curr [.canvas find withtag current]
  #return if nothing selected
  if [string length curr]==0 return
  set max [getmaingroupid $curr]
  #return if selected item is not part of a group
  if $max==0 return
  ungroup $max
  if [string compare $current group$max]==0 {
    .canvas delete control
    set current 0
  }
}

proc ungroup {groupnum} {
  #just delete the tags - if multiple groups delete specified portion
  foreach item [.canvas find withtag group$groupnum] {
    set otags [lindex [.canvas itemconfig $item -tags] 4]
    set dex [lsearch -exact $otags group$groupnum]
    set otags [lreplace $otags $dex $dex]
    .canvas itemconfig $item -tags $otags
  }
}

proc getmaingroupid {id} {
  set max 0
  foreach tag [.canvas gettags $id] {
    if [string first group $tag]==0 {
      set gn [string trimleft $tag group]
      if $max<$gn { set max $gn }
    }
  }
  return $max
}

proc deleteselected {} {
  global current

  if [string length $current]==0 return 

  .canvas delete control
  .canvas focus ""
  .canvas delete $current
  set current 0
}

proc deletecurrent {} {
  global current

  if [string length [.canvas type current]]==0 return 
  #ignore grid items
  if [lsearch -exact [.canvas gettags current] grid]>=0 return

  set otags [.canvas gettags current]
  if [lsearch $otags control]==-1 {
    if [lsearch -glob $otags group*]>-1 {
      set ingroup [getmaingroupid current]
      if [string compare "$current" "group$ingroup"]==0 {
	.canvas delete control
	set current 0
	.canvas focus ""
      }
      .canvas delete group$ingroup
    } else {
      if [string compare $current [.canvas find withtag current]]==0 {
	.canvas delete control
	set current 0
	.canvas focus ""
      }
      .canvas delete current
    }
  } else {
    #a control point was selected for deletion
    .canvas delete $current
    .canvas delete control
    set current 0
    .canvas focus ""
  }
}

proc toggleselectionpointer {} {
  if [string length [lindex [.canvas config -cursor] 4]] {
    #default is actually top_left_arrow
    .canvas config -cursor ""
  } else {
    .canvas config -cursor draft_large
  }
}

proc highlightcontrol {x y} {
  global current
  showcoords $x $y
  if {"$current"=="0"} return

  if [lsearch -exact [.canvas gettags current] currcont]>=0 return

  .canvas itemconfig currcont -fill white
  .canvas dtag currcont currcont
  if [lsearch -exact [.canvas gettags current] control]>=0 {
    .canvas itemconfig current -fill red
    .canvas addtag currcont withtag current
  }
}

proc showcoords {x y} {
  global grid
  if $grid(space)&&($grid(snap)||$grid(show)) {
    .top1.mousex config -text "x:[expr double($x)/$grid(space)]"
    .top1.mousey config -text "y:[expr double($y)/$grid(space)]"
  } else {
    .top1.mousex config -text "x:$x"
    .top1.mousey config -text "y:$y"
  }
}

proc showlen {len} {
  global grid
  if $grid(space)&&($grid(snap)||$grid(show)) {
    .top1.len config -text "length:[expr double($len)/$grid(space)]"
  } else {
    .top1.len config -text "length:$len"
  }
}

proc selectitem {x y} {
  global current lastx lasty sizer nailed

  set curr [.canvas find withtag current]
  if [info exists nailed($curr)] {
    if $nailed($curr) {
      set current 0
      .canvas delete control
      setup_reshapemenu
      return
    }
  }
  .canvas focus ""
  if [string length $curr]==0 {
    set current 0
    .canvas delete control
    #reset the options to defaults?
    setup_reshapemenu
    return
  }
  #ignore grid items
  if {[lsearch -exact [.canvas gettags $curr] grid]>=0} {
    set current 0
    .canvas delete control
    #reset the options to defaults?
    setup_reshapemenu
    return
  }

  if [string compare [lindex [.canvas gettags $curr] 0] "control"]==0 {
    if [string first ind [.canvas gettags $curr]]>=0 {
      set ind [string trimleft [lindex [.canvas gettags $curr] 1] ind]
      bind .canvas <B2-Motion> "change_coords $ind %x %y"
    } else {
      set corn [string trimleft [lindex [.canvas gettags $curr] 1] sizer-]
      set lastx $x
      set lasty $y
      set sizer(startx) $x
      set sizer(starty) $y
      bind .canvas <B2-Motion> "scale_coords $corn %x %y"
      push_binding .canvas <ButtonRelease-2> "update; drawsizers $current; pop_binding .canvas <ButtonRelease-2>"
    }
  } else {
    .canvas delete control
    set otags [lindex [.canvas itemconfig $curr -tags] 4]
    if [lsearch -glob $otags group*]>-1 {
      set ingroup [getmaingroupid $curr]
      if [info exists nailed(gropu$ingroup)] {
	if $nailed(group$ingroup) return
      }
      set current group$ingroup
      drawsizers $current
    } else {
      set current $curr
      drawcontrols $current
    }
    bind .canvas <B2-Motion> "dragitem %x %y"
    set lastx $x
    set lasty $y
    resetoptions
  }
}

proc setup_reshapemenu {} {
  global current
  if {"$current"=="0"} {
    .top1.reshape config -menu .top1.reshape.menu3
    return
  }
  switch [.canvas type $current] {
    line {
      if [llength [.canvas coords $current]]==4 {
        .top1.reshape config -menu .top1.reshape.menu2
      } else {
        .top1.reshape config -menu .top1.reshape.menu1
      }
    }
    polygon { .top1.reshape config -menu .top1.reshape.menu1 }
    oval -
    rectangle -
    arc { .top1.reshape config -menu .top1.reshape.menu2 }
    default { .top1.reshape config -menu .top1.reshape.menu3 }
  }
}

proc dragitem {x y} {
  global current lastx lasty
  set xoff [snaptogrid [expr $x-$lastx]]
  set yoff [snaptogrid [expr $y-$lasty]]
  .canvas move $current $xoff $yoff
  .canvas move control $xoff $yoff
  set lastx [expr $lastx+$xoff]
  set lasty [expr $lasty+$yoff]
}

proc scale_coords {corner x y} {
global current cords sizer lastx lasty groupcords

if [string compare $current 0]==0 return

#reset the coords to the values at the beginning of the resize operation
#this makes the scales relative to the original, rather than relative to
#the previous scale, which makes calculations easier, and lessens the
#chance of floating point drift
if [string first group $current]==0 {
  foreach item [.canvas find withtag $current] {
    eval .canvas coords $item $groupcords($item)
  }
} else {
  eval .canvas coords $current $cords
}

set lastdelx [expr $x-$lastx]
set lastdely [expr $y-$lasty]
case $corner in {
  ul {
    set tmpx [expr [lindex [.canvas coords sizer-lr] 0]+2]
    set tmpy [expr [lindex [.canvas coords sizer-lr] 1]+2]
    set xscalefact [expr $sizer(width)-$x.0+$sizer(startx)]
    set yscalefact [expr $sizer(height)-$y.0+$sizer(starty)]
    if $xscalefact==0 { set xscalefact 0.000001 }
    if $yscalefact==0 { set yscalefact 0.000001 }
    .canvas move sizer-ul $lastdelx $lastdely
    .canvas move sizer-ll $lastdelx 0
    .canvas move sizer-ur 0 $lastdely
    .canvas move sizer-ml $lastdelx [expr $lastdely/2.0]
    .canvas move sizer-um [expr $lastdelx/2.0] $lastdely
    .canvas move sizer-mr 0 [expr $lastdely/2.0]
    .canvas move sizer-lm [expr $lastdelx/2.0] 0
  }
  ur {
    set tmpx [expr [lindex [.canvas coords sizer-ll] 0]+2]
    set tmpy [expr [lindex [.canvas coords sizer-ll] 1]+2]
    set xscalefact [expr $sizer(width)+$x.0-$sizer(startx)]
    set yscalefact [expr $sizer(height)-$y.0+$sizer(starty)]
    if $xscalefact==0 { set xscalefact 0.000001 }
    if $yscalefact==0 { set yscalefact 0.000001 }
    .canvas move sizer-ur $lastdelx $lastdely
    .canvas move sizer-lr $lastdelx 0
    .canvas move sizer-ul 0 $lastdely
    .canvas move sizer-mr $lastdelx [expr $lastdely/2.0]
    .canvas move sizer-um [expr $lastdelx/2.0] $lastdely
    .canvas move sizer-ml 0 [expr $lastdely/2.0]
    .canvas move sizer-lm [expr $lastdelx/2.0] 0
  }
  ll {
    set tmpx [expr [lindex [.canvas coords sizer-ur] 0]+2]
    set tmpy [expr [lindex [.canvas coords sizer-ur] 1]+2]
    set xscalefact [expr $sizer(width)-$x.0+$sizer(startx)]
    set yscalefact [expr $sizer(height)+$y.0-$sizer(starty)]
    if $xscalefact==0 { set xscalefact 0.000001 }
    if $yscalefact==0 { set yscalefact 0.000001 }
    .canvas move sizer-ll $lastdelx $lastdely
    .canvas move sizer-ul $lastdelx 0
    .canvas move sizer-lr 0 $lastdely
    .canvas move sizer-ml $lastdelx [expr $lastdely/2.0]
    .canvas move sizer-lm [expr $lastdelx/2.0] $lastdely
    .canvas move sizer-mr 0 [expr $lastdely/2.0]
    .canvas move sizer-um [expr $lastdelx/2.0] 0
  }
  lr {
    set tmpx [expr [lindex [.canvas coords sizer-ul] 0]+2]
    set tmpy [expr [lindex [.canvas coords sizer-ul] 1]+2]
    set xscalefact [expr $sizer(width)+$x.0-$sizer(startx)]
    set yscalefact [expr $sizer(height)+$y.0-$sizer(starty)]
    if $xscalefact==0 { set xscalefact 0.000001 }
    if $yscalefact==0 { set yscalefact 0.000001 }
    .canvas move sizer-lr $lastdelx $lastdely
    .canvas move sizer-ur $lastdelx 0
    .canvas move sizer-ll 0 $lastdely
    .canvas move sizer-mr $lastdelx [expr $lastdely/2.0]
    .canvas move sizer-lm [expr $lastdelx/2.0] $lastdely
    .canvas move sizer-ml 0 [expr $lastdely/2.0]
    .canvas move sizer-um [expr $lastdelx/2.0] 0
  }
  um {
    set tmpx 0
    set xscalefact $sizer(width)
    set tmpy [expr [lindex [.canvas coords sizer-lm] 1]+2]
    set yscalefact [expr $sizer(height)-$y.0+$sizer(starty)]
    if $yscalefact==0 { set yscalefact 0.000001 }
    .canvas move sizer-um 0 $lastdely
    .canvas move sizer-ur 0 $lastdely
    .canvas move sizer-ul 0 $lastdely
    .canvas move sizer-mr 0 [expr $lastdely/2.0]
    .canvas move sizer-ml 0 [expr $lastdely/2.0]
  }
  lm {
    set tmpx 0
    set xscalefact $sizer(width)
    set tmpy [expr [lindex [.canvas coords sizer-um] 1]+2]
    set yscalefact [expr $sizer(height)+$y.0-$sizer(starty)]
    if $yscalefact==0 { set yscalefact 0.000001 }
    .canvas move sizer-lm 0 $lastdely
    .canvas move sizer-lr 0 $lastdely
    .canvas move sizer-ll 0 $lastdely
    .canvas move sizer-mr 0 [expr $lastdely/2.0]
    .canvas move sizer-ml 0 [expr $lastdely/2.0]
  }
  ml {
    set tmpy 0
    set yscalefact $sizer(height)
    set tmpx [expr [lindex [.canvas coords sizer-mr] 0]+2]
    set xscalefact [expr $sizer(width)-$x.0+$sizer(startx)]
    if $xscalefact==0 { set xscalefact 0.000001 }
    .canvas move sizer-ml $lastdelx 0
    .canvas move sizer-ul $lastdelx 0
    .canvas move sizer-ll $lastdelx 0
    .canvas move sizer-um [expr $lastdelx/2.0] 0
    .canvas move sizer-lm [expr $lastdelx/2.0] 0
  }
  mr {
    set tmpy 0
    set yscalefact $sizer(height)
    set tmpx [expr [lindex [.canvas coords sizer-ml] 0]+2]
    set xscalefact [expr $sizer(width)+$x.0-$sizer(startx)]
    if $xscalefact==0 { set xscalefact 0.000001 }
    .canvas move sizer-mr $lastdelx 0
    .canvas move sizer-ur $lastdelx 0
    .canvas move sizer-lr $lastdelx 0
    .canvas move sizer-um [expr $lastdelx/2.0] 0
    .canvas move sizer-lm [expr $lastdelx/2.0] 0
  }
}
.canvas scale $current $tmpx $tmpy [expr $xscalefact/$sizer(width)] [expr $yscalefact/$sizer(height)]

set lastx $x
set lasty $y
}

proc defaultoptions {objtype} {
  global fill stipple fillcolor stipmap

  #disable the setoptions routine
  #this is necessary because changing the option widgets will spawn
  #the widget commands
  set optionlock 1

  .options.width.scale set [lindex $defaults($objtype) 0]
  setPalettePot .options.color.pot [lindex $defaults($objtype) 1]
  set stipstuff [lindex $defaults($objtype) 2]
  set stipple [lindex stipstuff 0]
  set stipgrey [lindex stipstuff 1]
  set stipmap [lindex stipstuff 2]
  .options.stipple2.scale set $stipgrey
  .options.stipple3.end delete 0 end
  .options.stipple3.ent insert 0 [string trimleft $stipmap @]
  set fillstuff [lindex $defaults($objtype) 3]
  set fill [lindex fillstuff 0]
  set fillcolor [lindex fillstuff 1]
  setPalettePot .options.fill.pot $fillcolor

  #make events happen here before re-enabling setoptions
  #I think the events always get processed in a most-recent/highest-priority
  #fashion, so the events should win the race, and then return to the
  #line following the update
  update
  #re-enable the setoptions routine
  set optionlock 0
}

proc resetoptions {} {
global optionlock fill fillcolor stipple stipmap color current GREYMAPDIR

if [string first group $current]==0 return
#disable the setoptions routine
#this is necessary because changing the option widgets will spawn
#the widget commands
set optionlock 1

set type [.canvas type $current]
case $type in {
  line {
    set color [lindex [.canvas itemconfig $current -fill] 4]
    if [string length $color]==0 { set color black }
    set stipmap [lindex [.canvas itemconfig $current -stipple] 4]
    if [string first @$GREYMAPDIR $stipmap]>=0 {
      set stipple grey
      regsub ^@$GREYMAPDIR/grey $stipmap "" greynum
      regsub .xbm$ $greynum "" greynum
      .options.stipple2.scale set $greynum
    } elseif [string first @ $stipmap]>=0 {
      .options.stipple3.ent delete 0 end
      .options.stipple3.ent insert 0 [string trimleft $stipmap @]
      set stipple bitmap
    } else {
      set stipmap ""
      set stipple none
    }
    set fill none
    set fillcolor ""
    .options.width.scale set [lindex [.canvas itemconfig $current -width] 4]
    setPalettePot .options.color.pot $color
  }
  polygon {
    set color [lindex [.canvas itemconfig $current -fill] 4]
    if [string length $color]==0 { set color black }
    set stipmap [lindex [.canvas itemconfig $current -stipple] 4]
    if [string first @$GREYMAPDIR $stipmap]>=0 {
      set stipple grey
      regsub ^@$GREYMAPDIR/grey $stipmap "" greynum
      regsub .xbm$ $greynum "" greynum
      .options.stipple2.scale set $greynum
    } elseif [string first @ $stipmap]>=0 {
      .options.stipple3.ent delete 0 end
      .options.stipple3.ent insert 0 [string trimleft $stipmap @]
      set stipple bitmap
    } else {
      set stipmap ""
      set stipple none
    }
    set fill none
    set fillcolor ""
    .options.width.scale set 1
    setPalettePot .options.color.pot $color
  }
  rectangle {
    set color [lindex [.canvas itemconfig $current -outline] 4]
    if [string length $color]==0 { set color black }
    set stipmap [lindex [.canvas itemconfig $current -stipple] 4]
    if [string first @$GREYMAPDIR $stipmap]>=0 {
      set stipple grey
      regsub ^@$GREYMAPDIR/grey $stipmap "" greynum
      regsub .xbm$ $greynum "" greynum
      .options.stipple2.scale set $greynum
    } elseif [string first @ $stipmap]>=0 {
      .options.stipple3.ent delete 0 end
      .options.stipple3.ent insert 0 [string trimleft $stipmap @]
      set stipple bitmap
    } else {
      set stipmap ""
      set stipple none
    }
    set fillcolor [lindex [.canvas itemconfig $current -fill] 4]
    if [string length $fillcolor]==0 { set fill none } else { set fill color }
    .options.width.scale set [lindex [.canvas itemconfig $current -width] 4]
    setPalettePot .options.color.pot $color
    if [string compare $fill none]!=0 {
      setPalettePot .options.fill.pot $fillcolor
    }
  }
  oval {
    set color [lindex [.canvas itemconfig $current -outline] 4]
    if [string length $color]==0 { set color black }
    set stipmap [lindex [.canvas itemconfig $current -stipple] 4]
    if [string first @$GREYMAPDIR $stipmap]>=0 {
      set stipple grey
      regsub ^@$GREYMAPDIR/grey $stipmap "" greynum
      regsub .xbm$ $greynum "" greynum
      .options.stipple2.scale set $greynum
    } elseif [string first @ $stipmap]>=0 {
      .options.stipple3.ent delete 0 end
      .options.stipple3.ent insert 0 [string trimleft $stipmap @]
      set stipple bitmap
    } else {
      set stipmap ""
      set stipple none
    }
    set fillcolor [lindex [.canvas itemconfig $current -fill] 4]
    if [string length $fillcolor]==0 { set fill none } else { set fill color }
    .options.width.scale set [lindex [.canvas itemconfig $current -width] 4]
    setPalettePot .options.color.pot $color
    if [string compare $fill none]!=0 {
      setPalettePot .options.fill.pot $fillcolor
    }
  }
}

#make events happen here before re-enabling setoptions
#I think the events always get processed in a most-recent/highest-priority
#fashion, so the events should win the race, and then return to the
#line following the update
update
#re-enable the setoptions routine
set optionlock 0
}

proc setoptions {args} {
global optionlock fill fillcolor stipple stipmap color current GREYMAPDIR

if [string first group $current]==0 return
#resetoptions can spawn calls to setoptions when it changes the
#option widgets (resulting in triggering their commands)
#so it will set this variable to disable
if $optionlock return

  set type [.canvas type $current]
  case $type in {
    line {
      .canvas itemconfig $current -width [.options.width.scale get]
      .canvas itemconfig $current -fill $color
      if [string compare $stipple bitmap]==0 {
	.canvas itemconfig $current -stipple @[.options.stipple3.ent get]
      } elseif [string compare $stipple grey]==0 {
	.canvas itemconfig $current -stipple @$GREYMAPDIR/grey[.options.stipple2.scale get].xbm
      } else {
	.canvas itemconfig $current -stipple ""
      }
    }
    polygon {
      .canvas itemconfig $current -fill $color
      if [string compare $stipple bitmap]==0 {
	.canvas itemconfig $current -stipple @[.options.stipple3.ent get]
      } elseif [string compare $stipple grey]==0 {
	.canvas itemconfig $current -stipple @$GREYMAPDIR/grey[.options.stipple2.scale get].xbm
      } else {
	.canvas itemconfig $current -stipple ""
      }
    }
    rectangle {
      .canvas itemconfig $current -width [.options.width.scale get]
      if [string compare $fill none]==0 {
	.canvas itemconfig $current -fill ""
      } else {
	.canvas itemconfig $current -fill $fillcolor
      }
      .canvas itemconfig $current -outline $color
      if [string compare $stipple bitmap]==0 {
	.canvas itemconfig $current -stipple @[.options.stipple3.ent get]
      } elseif [string compare $stipple grey]==0 {
	.canvas itemconfig $current -stipple @$GREYMAPDIR/grey[.options.stipple2.scale get].xbm
      } else {
	.canvas itemconfig $current -stipple ""
      }
    }
    oval {
      .canvas itemconfig $current -width [.options.width.scale get]
      if [string compare $fill none]==0 {
	.canvas itemconfig $current -fill ""
      } else {
	.canvas itemconfig $current -fill $fillcolor
      }
      .canvas itemconfig $current -outline $color
      if [string compare $stipple bitmap]==0 {
	.canvas itemconfig $current -stipple @[.options.stipple3.ent get]
      } elseif [string compare $stipple grey]==0 {
	.canvas itemconfig $current -stipple @$GREYMAPDIR/grey[.options.stipple2.scale get].xbm
      } else {
	.canvas itemconfig $current -stipple ""
      }
    }
    arc {
      .canvas itemconfig $current -width [.options.width.scale get]
      if [string compare $fill none]==0 {
	.canvas itemconfig $current -fill ""
      } else {
	.canvas itemconfig $current -fill $fillcolor
      }
      .canvas itemconfig $current -outline $color
      if [string compare $stipple bitmap]==0 {
	.canvas itemconfig $current -stipple @[.options.stipple3.ent get]
      } elseif [string compare $stipple grey]==0 {
	.canvas itemconfig $current -stipple @$GREYMAPDIR/grey[.options.stipple2.scale get].xbm
      } else {
	.canvas itemconfig $current -stipple ""
      }
      .canvas itemconfig $current -start [.options.startangle.scale get]
      .canvas itemconfig $current -extent [.options.extent.scale get]
    }
  }
}


#all have stipple
#                    width color fill cap join start extent arrows font anchor
#
# line:              width color      cap                   arrows
# multiline:         width color      cap join              ??????
# closed multiline:  width color          join
# filled multiline:        color          join
# multicurve:        width color      cap                   ??????
# closed multicurve: width color
# filled multicurve:       color
# oval:              width color fill
# rectangle:         width color fill
# arc:               width color               start extent
# chord:             width color fill          start extent
# pie:               width color fill          start extent
# text:                    color                                   font anchor
# image:
#
proc mkoptions {} {
  global GREYMAPDIR
  toplevel .options
  wm group .options .
  wm transient .options .

  #
  # Line width
  #
  frame .options.width
  label .options.width.lab -text "Line Width: " -width 15 -anchor w
  scale .options.width.scale -orient horizontal -from 1 -to 50 \
      -command setoptions -relief sunken
  pack append .options .options.width {top fillx pady 5}
  pack append .options.width .options.width.lab left
  pack append .options.width .options.width.scale right

  #
  # Color
  #
  frame .options.color
  label .options.color.lab -text "Color: " -width 15 -anchor w
  mkPalettePot .options.color.pot 20 10 black handle_colorpot
  #frame .options.color.frame -bd 3 -relief sunken
  #label .options.color.frame.label -width 4
  #pack append .options.color.frame .options.color.frame.label top
  #button .options.color.set -text Set -command {set color [getPaletteCurrent]; .options.color.frame.label config -background $color; setoptions}
  pack append .options .options.color {top fillx pady 5}
  pack append .options.color .options.color.lab left
  #pack append .options.color .options.color.frame right
  pack append .options.color .options.color.pot right
  #pack append .options.color .options.color.set {right padx 5}

  #
  # Stipple
  #
  frame .options.stipple
  label .options.stipple.lab -text "Stipple: " -width 15 -anchor w
  radiobutton .options.stipple.none -text None -relief flat -variable stipple \
      -command setoptions
  pack append .options .options.stipple {top fillx pady 5}
  pack append .options.stipple .options.stipple.lab left
  pack append .options.stipple .options.stipple.none right
  #grey bitmap
  frame .options.stipple2
  radiobutton .options.stipple2.grey -text Grey: -relief flat \
      -variable stipple -value grey -command setoptions
  label .options.stipple2.greylabel -bitmap @$GREYMAPDIR/grey0.xbm
  scale .options.stipple2.scale -from 0 -to 256 -orient horizontal \
      -command {.options.stipple2.greylabel config -bitmap @$GREYMAPDIR/grey[.options.stipple2.scale get].xbm; setoptions} -relief sunken
  pack append .options .options.stipple2 {top fillx pady 5}
  pack append .options.stipple2 .options.stipple2.scale right
  pack append .options.stipple2 .options.stipple2.greylabel {right padx 5}
  pack append .options.stipple2 .options.stipple2.grey {right padx 5}
  #other bitmap
  frame .options.stipple3
  radiobutton .options.stipple3.other -text Other: -relief flat \
      -variable stipple -value bitmap -command "setoptions; focus .canvas"
  entry .options.stipple3.ent -relief sunken -width 30
  pack append .options .options.stipple3 {top fillx pady 5}
  pack append .options.stipple3 .options.stipple3.other {left padx 10}
  pack append .options.stipple3 .options.stipple3.ent left

  #
  # Fill
  #
  frame .options.fill
  label .options.fill.lab -text "Fill Color: " -width 15 -anchor w
  #frame .options.fill.frame -bd 3 -relief sunken
  #label .options.fill.frame.label -width 4
  #pack append .options.fill.frame .options.fill.frame.label top
  mkPalettePot .options.fill.pot 20 10 black handle_fillpot
  radiobutton .options.fill.color -text "" -relief flat -variable fill \
      -value color -command {set fillcolor [getPaletteCurrent]; setPalettePot .options.fill.pot $fillcolor; setoptions}
  radiobutton .options.fill.none -text None -relief flat -variable fill \
      -command setoptions
  pack append .options .options.fill {top fillx pady 5}
  pack append .options.fill .options.fill.lab left
  pack append .options.fill .options.fill.none right
  #pack append .options.fill .options.fill.frame right
  pack append .options.fill .options.fill.pot right
  pack append .options.fill .options.fill.color right

  bind .options.stipple3.ent <Return> setoptions

  #
  # start
  #
  frame .options.startangle
  label .options.startangle.lab -text "Start Angle: " -width 15 -anchor w
  scale .options.startangle.scale -orient horizontal -from 0 -to 360 \
      -length 181 -command setoptions -relief sunken
  pack append .options .options.startangle {top fillx pady 5}
  pack append .options.startangle .options.startangle.lab left
  pack append .options.startangle .options.startangle.scale right

  #
  # extent
  #
  frame .options.extent
  label .options.extent.lab -text "Extent: " -width 15 -anchor w
  scale .options.extent.scale -orient horizontal -from 0 -to 360 \
      -length 181 -command setoptions -relief sunken
  pack append .options .options.extent {top fillx pady 5}
  pack append .options.extent .options.extent.lab left
  pack append .options.extent .options.extent.scale right
  .options.extent.scale set 90
}

proc new {} {
  global currfile current
  .canvas delete all
  set currfile ""
  set current 0
  showgrid
}

proc mkbgdialog {} {
  toplevel .image

  frame .image.file;
    pack .image.file -fill x
  label .image.file.l -text File:
    pack .image.file.l -side left
  entry .image.file.e -width 50
    pack .image.file.e -side right

  frame .image.xy;
    pack .image.xy -fill x
  label .image.xy.l -text Position:
    pack .image.xy.l -side left
  entry .image.xy.x -width 4
    pack .image.xy.x -side left
  entry .image.xy.y -width 4
    pack .image.xy.y -side left

  frame .image.zoom;
    pack .image.zoom -fill x
  label .image.zoom.l -text Zoom:
    pack .image.zoom.l -side left
  entry .image.zoom.x -width 4
    pack .image.zoom.x -side left
  entry .image.zoom.y -width 4
    pack .image.zoom.y -side left

  frame .image.buttons
  pack .image.buttons -fill x
  button .image.buttons.apply -text "Apply" -command {
    set ret [loadimage [.image.file.e get] \
	  [.image.xy.x get] [.image.xy.y get] \
	  [.image.zoom.x get] [.image.zoom.y get]]
    if [string length $ret] {
      notify $ret
    }
    wm withdraw .image
  }
  button .image.buttons.cancel -text "Cancel" -command {
    wm withdraw .image
    popdownList .image.file.e
  }
  pack .image.buttons.apply -side left -padx 20
  #pack .image.buttons.delete -side left -padx 20
  pack .image.buttons.cancel -side left -padx 20
  .image.xy.x insert 0 0
  .image.xy.y insert 0 0
  .image.zoom.x insert 0 1
  .image.zoom.y insert 0 1
  bind .image.file.e <Tab> { pathExpand %W; break }
  bind .image.file.e <Any-Key> { popdownList %W }
  wm withdraw .image
}

proc loadimage {filename x y xzoom yzoom} {
  global imageinfo
  if [lsearch -exact [image names] temp]>=0 {
    image delete temp
  } 
  if [catch "image create photo temp -file $filename" err] {
    return $err
  }
  set name [image create photo]
  $name copy temp -zoom $xzoom $yzoom
  .canvas create image $x $y -anchor nw -image $name
  set imageinfo($name,file) $filename
  set imageinfo($name,xzoom) $xzoom
  set imageinfo($name,yzoom) $yzoom
  image delete temp
  return ""
}

proc myopen {openfile} {
  global currfile current nailed
  .canvas delete all
  clearPalette
  set currfile $openfile
  set current 0
  unset nailed
  load $openfile
}

proc load {loadfile} {
  global nailed
  global lastgroup
  global grid

  source $loadfile
  set max $lastgroup
  #fix the lastgroup value so it won't cause conflicts with loaded data.
  foreach item [.canvas find all] {
    if {"[.canvas type $item]"=="bitmap"} { continue }
    if {"[.canvas type $item]"=="image"} { continue }
    addPaletteColors [lindex [.canvas itemconfig $item -fill] 4]
    foreach tag [.canvas gettags $item] {
      if [string first "group" $tag]==0 {
	scan $tag group%d val
	if [info exists val] {
	  if $val>$max {set max $val}
	  unset val
	}
      }
    }
  }
  set lastgroup $max
}

proc print {pipe} {
  set pipe [open $pipe w]
  puts -nonewline $pipe [.canvas postscript -rotate 1 -pagewidth 10i]
  close $pipe
}

proc dosave {savefile} {
  global currfile
  global grid
  global nailed
  global imageinfo

  #if [string length $savefile]==0 { puts -nonewline ; flush stdout; return }
  if [string length $savefile]==0 { bell; return }

  set fd [open $savefile w]
  puts $fd "set tmpw .canvas"
  foreach img [image names] {
    puts $fd "image create photo temp -file $imageinfo($img,file)"
    puts $fd "image create photo $img"
    puts $fd "$img copy temp -zoom $imageinfo($img,xzoom) $imageinfo($img,yzoom)"
    puts $fd "image delete temp"
  }
  foreach item [.canvas find all] {
    set taglist [.canvas gettags $item]
    if [lsearch -exact $taglist grid]>=0 continue
    if [lsearch -exact $taglist control]>=0 continue
    set type [.canvas type $item]
    set coords [.canvas coords $item]
    set options ""
    foreach opt [.canvas itemconfig $item] {
      if [string compare [lindex $opt 4] ""]!=0 {
	lappend options [lindex $opt 0]
	lappend options [lindex $opt 4]
      } elseif [string compare $opt -outline]==0 {
	#always save outlines even if null (arc outlines default to same as
	#fill, not to "")
	lappend options [lindex $opt 0]
	lappend options [lindex $opt 4]
      }
    }
    if ([info exists nailed($item)]) {
      if ($nailed($item)) {
	puts $fd "set nailed(\[\$tmpw create $type $coords $options\]) 1"
      } else {
	puts $fd "\$tmpw create $type $coords $options"
      }
    } else {
      puts $fd "\$tmpw create $type $coords $options"
    }
  }
  puts $fd "set grid(snap) $grid(snap)"
  puts $fd "set grid(space) $grid(space)"
  puts $fd "set grid(show) $grid(show)"
  puts $fd "\$tmpw config -width [winfo width .canvas] -height [winfo height .canvas]"
  close $fd

  if [string length $currfile]==0 {
    set currfile $savefile
    return
  }

  if [string compare $savefile $currfile]!=0 {
    yorn "Use new name from now on?" "set currfile $savefile" "nop"
  }
}

proc handle_colorpot {c} {
  global color
  set color $c
  setoptions
}

proc handle_fillpot {c} {
  global fillcolor
  set fillcolor $c
  setoptions
}

set said 0
proc onentry {cmd args} {
  global said

  toplevel .sa$said
  wm geometry .sa$said +[expr [winfo x .]+[winfo vrootx .]+100]+[expr [winfo y .]+[winfo vrooty .]+100]
  wm transient .sa$said .
  message .sa$said.mess -text "Enter filename:" -width 300
  pack .sa$said.mess
  entry .sa$said.entry -relief sunken -bd 2 -width 50
  pack .sa$said.entry
  if {"$cmd"!="print"} {
    bind .sa$said.entry <Tab> { pathExpand %W; break }
    bind .sa$said.entry <Any-Key> { popdownList %W }
  }
  set oldfocus [focus]
  if [llength $args] {
    .sa$said.entry insert 0 [lindex $args 0]
  }
  bind .sa$said.entry <Return> "$cmd \[.sa$said.entry get\]; destroy .sa$said; focus $oldfocus"
  button .sa$said.ok -text Ok -command "$cmd \[.sa$said.entry get\]; destroy .sa$said; focus $oldfocus"
  pack .sa$said.ok -side left
  button .sa$said.cancel -text Cancel -command "destroy .sa$said; focus $oldfocus; popdownList .sa$said.entry"
  pack .sa$said.cancel -side right
  focus .sa$said.entry
}

set yornid 0
proc yorn {mess yescmd nocmd} {
  global yornid

  toplevel .yorn$yornid
  wm geometry .yorn$yornid +[expr [winfo x .]+[winfo vrootx .]+100]+[expr [winfo y .]+[winfo vrooty .]+100]
  wm transient .yorn$yornid .
  message .yorn$yornid.mess -text $mess -width 300
  pack .yorn$yornid.mess
  button .yorn$yornid.yes -text Yes -command "$yescmd; destroy .yorn$yornid"
  pack .yorn$yornid.yes -side left
  button .yorn$yornid.no -text No -command "$nocmd; destroy .yorn$yornid"
  pack .yorn$yornid.no -side right
}

set notifid 0
proc notify {mess} {
  global notifid
  toplevel .notify$notifid
  wm geometry .notify$notifid +[expr [winfo x .]+[winfo vrootx .]+100]+[expr [winfo y .]+[winfo vrooty .]+100]
  wm transient .notify$notifid .
  message .notify$notifid.mess -text $mess
  pack .notify$notifid.mess
  button .notify$notifid.ok -text OK -command "destroy .notify$notifid"
  pack .notify$notifid.ok -side left
}

proc nop {} {}

proc push_binding {widget event body} {
  global bindstack

  lappend bindstack($widget,$event) [bind $widget $event]
  bind $widget $event $body
}

proc pop_binding {widget event} {
  global bindstack

  set len [llength $bindstack($widget,$event)]
  incr len -1
  bind $widget $event [lindex $bindstack($widget,$event) $len]
  set bindstack($widget,$event) [lreplace $bindstack($widget,$event) $len $len]
}

proc help {type} {
  if [winfo exists .help] {
    wm deiconify .help
    raise .help
  } else {
    toplevel .help
    canvas .help.c -width 500 -height 350 -bg linen
    pack .help.c
    button .help.general -text General -command help_general -padx 5
    button .help.modes -text Modes -command help_modes -padx 5
    button .help.mouse -text Mouse -command help_mouse -padx 5
    button .help.keybd -text Keyboard -command help_keybd -padx 5
    button .help.menus -text Menus -command help_menus -padx 5
    button .help.palette -text Palette -command help_palette -padx 5
    button .help.about -text About -command help_about -padx 5
    button .help.done -text Done -command "wm withdraw .help" -padx 5
    pack .help.general -side left
    pack .help.modes -side left
    pack .help.mouse -side left
    pack .help.keybd -side left
    pack .help.menus -side left
    pack .help.palette -side left
    pack .help.about -side left
    pack .help.done -side right
  }

  help_$type
}

proc help_menus {} {
  .help.c delete all
  .help.c config -bg linen
  bind .help.c <1> ""
  bind .help.c <2> ""
  bind .help.c <3> ""
}

proc help_palette {} {
  .help.c delete all
  .help.c config -bg linen
  bind .help.c <1> ""
  bind .help.c <2> ""
  bind .help.c <3> ""
  .help.c create text 10 10 -anchor nw \
      -text {The color palette window allows you to select colors and build a palette
of colors for your current piece of artwork.   The sliders at the right
allow you to create different colors, and the resulting color will be
displayed in the box above the sliders.  The grid of squares to the left
is the actual palette, and raised boxes are empty palette spaces.  You
can add the slider color to the palette by clicking on an empty palette
box.  The same color can't be added twice, so if your color doesn't
appear in the palette, that's probably why.  To remove a color from the
palette, click on the palette box with the third mouse button.

Clicking on a palette color makes that color active.  The slider color
can also be made the active color.  When the "paint pots" in the
options window are clicked on, they will be set to whatever the active
color is.

Drag and drop works within the application.  Colors can be dragged to or
from the slider color, any of the palette boxes, and the paint pots in the
options window.  If you drag from one palette box to another, the colors
are swapped, allowing you to reorder the colors if you really feel the need.
If you drop a new color onto an existing palette color, the new color will
be added in the first available location.

When a file is loaded, the palette is loaded based on the colors found
in the drawing.}
}

proc help_mouse {} {
  .help.c delete all
  .help.c config -bg linen
  .help.c create arc 10 10 30 30 -start 90 -style arc -fill black
  .help.c create arc 80 10 100 30 -start 0 -style arc -fill black
  .help.c create arc 10 120 30 140 -start 180 -style arc -fill black
  .help.c create arc 80 120 100 140 -start 270 -style arc -fill black
  .help.c create line 20 10 90 10
  .help.c create line 20 140 90 140
  .help.c create line 10 20 10 130
  .help.c create line 100 20 100 130
  #
  .help.c create arc 18 21 36 39 -start 0 -extent 180 -style pieslice \
		 -fill grey -width 0 -tag button1
  .help.c create arc 18 71 36 89 -start 180 -extent 180 -style pieslice \
		 -fill grey -width 0 -tag button1
  .help.c create rectangle 18 30 36 80 -fill grey -width 0 -outline grey \
		 -tag button1

  .help.c create arc 46 21 64 39 -start 0 -extent 180 -style pieslice \
		 -fill grey -width 0 -tag button2
  .help.c create arc 46 71 64 89 -start 180 -extent 180 -style pieslice \
		 -fill grey -width 0 -tag button2
  .help.c create rectangle 46 30 64 80 -fill grey -width 0 -outline grey \
		 -tag button2

  .help.c create arc 74 21 92 39 -start 0 -extent 180 -style pieslice \
		 -fill grey -width 0 -tag button3
  .help.c create arc 74 71 92 89 -start 180 -extent 180 -style pieslice \
		 -fill grey -width 0 -tag button3
  .help.c create rectangle 74 30 92 80 -fill grey -width 0 -outline grey \
		 -tag button3
  #
  .help.c create arc 18 21 36 39 -start 0 -extent 180 -style arc -fill black
  .help.c create arc 18 71 36 89 -start 180 -extent 180 -style arc -fill black
  .help.c create line 18 30 18 80
  .help.c create line 36 30 36 80

  .help.c create arc 46 21 64 39 -start 0 -extent 180 -style arc -fill black
  .help.c create arc 46 71 64 89 -start 180 -extent 180 -style arc -fill black
  .help.c create line 46 30 46 80
  .help.c create line 64 30 64 80

  .help.c create arc 74 21 92 39 -start 0 -extent 180 -style arc -fill black
  .help.c create arc 74 71 92 89 -start 180 -extent 180 -style arc -fill black
  .help.c create line 74 30 74 80
  .help.c create line 92 30 92 80

  .help.c create text 110 60 -text "select a button" -tag helptext -anchor w

  .help.c bind button1 <Enter> help_mouse_b1
  .help.c bind button2 <Enter> help_mouse_b2
  .help.c bind button3 <Enter> help_mouse_b3
  bind .help.c <1> help_mouse_b1
  bind .help.c <2> help_mouse_b2
  bind .help.c <3> help_mouse_b3
}

proc help_mouse_b1 {} {
  .help.c itemconfig button1 -fill green -outline green
  .help.c itemconfig button2 -fill grey -outline grey
  .help.c itemconfig button3 -fill grey -outline grey
  .help.c itemconfig helptext \
  -text {Button 1 is used to create new objects.  It's use will
be slightly different depending on the mode.

Shifted button 1 will constrain the motion in certain
modes. For instance, ovals are constrained to circles,
and rectangles are constrained to squares.}
}

proc help_mouse_b2 {} {
  .help.c itemconfig button1 -fill grey -outline grey
  .help.c itemconfig button2 -fill green -outline green
  .help.c itemconfig button3 -fill grey -outline grey
  .help.c itemconfig helptext -text "Button 2 is used to select
and drag both objects and\ncontrol points.

Double-clicking button two will
draw sizer control points. 

Shifted button 2 is used to
drag out a region to select
objects for grouping."
}

proc help_mouse_b3 {} {
  .help.c itemconfig button1 -fill grey -outline grey
  .help.c itemconfig button2 -fill grey -outline grey
  .help.c itemconfig button3 -fill green -outline green
  .help.c itemconfig helptext -text "Button 3 is used to complete object\n\
creation in multi-segment modes.\n\nShifted button 3 can ungroup\nthe object \
under the mouse,\nselected or not."
}

proc help_keybd {} {
  .help.c delete all
  .help.c config -bg linen
  bind .help.c <1> ""
  bind .help.c <2> ""
  bind .help.c <3> ""

  .help.c create text 5 5 -anchor nw -text \
{ctrl-x	cut the selected object
ctrl-c	copy the selected object
ctrl-v	paste the selected object
Up	raise the selected object one layer higher
Down	lower the selected object one layer lower
Home	raise selected to top
End	lower selected to bottom
Delete	delete the selected item
!	nail down selection; nail down or pry up item under cursor
,	rotate counter-clockwise 5 degrees
.	rotate clockwise 5 degrees
<	rotate counter-clockwise 15 degrees
>	rotate clockwise 15 degrees
-	shrink by five percent
=	enlarge by five percent
_	shrink to half size
+	enlarge to double size
v	switch to alternate pointer (may make selection easier)
keypad +	add a point to the current object
keypad -	delete a point from the current object
keypad /	ungroup (same as shift-button3)}
}

proc help_modes {} {
  global APPMAPDIR
  .help.c delete all
  .help.c config -bg linen
  bind .help.c <1> ""
  bind .help.c <2> ""
  bind .help.c <3> ""

  if ![winfo exists .help.c.sketch] {
    button .help.c.sketch -command "modehelp sketch" \
	    -bitmap @$APPMAPDIR/sketch.xbm
    button .help.c.line -command "modehelp line" \
	    -bitmap @$APPMAPDIR/line.xbm
    button .help.c.multiline -command "modehelp multiline" \
	    -bitmap @$APPMAPDIR/multiline.xbm
    button .help.c.curve -command "modehelp curve" \
	    -bitmap @$APPMAPDIR/curve.xbm
    button .help.c.polyline -command "modehelp polyline" \
	    -bitmap @$APPMAPDIR/polygon.xbm
    button .help.c.polycurve -command "modehelp polycurve" \
	    -bitmap @$APPMAPDIR/polyspline.xbm
    button .help.c.polygon -command "modehelp polygon" \
	    -bitmap @$APPMAPDIR/solid_polygon.xbm
    button .help.c.polyspline -command "modehelp polyspline" \
	    -bitmap @$APPMAPDIR/solid_polyspline.xbm
    button .help.c.rectangle -command "modehelp rectangle" \
	    -bitmap @$APPMAPDIR/filled_rectangle.xbm
    button .help.c.oval -command "modehelp oval" \
	    -bitmap @$APPMAPDIR/filled_oval.xbm
    button .help.c.arc -command "modehelp arc" \
	    -bitmap @$APPMAPDIR/arc.xbm
    button .help.c.chord -command "modehelp chord" \
	    -bitmap @$APPMAPDIR/chord.xbm
    button .help.c.pieslice -command "modehelp pieslice" \
	    -bitmap @$APPMAPDIR/pie.xbm
    button .help.c.dotext -command "modehelp dotext" \
	    -bitmap @$APPMAPDIR/text.xbm
    button .help.c.image -command "modehelp image" \
	    -bitmap @$APPMAPDIR/image.xbm
  }

  set x 17
  .help.c create window $x 20 -window .help.c.sketch -tag sketch
  incr x 32
  .help.c create window $x 20 -window .help.c.line -tag line
  incr x 32
  .help.c create window $x 20 -window .help.c.multiline -tag multiline
  incr x 32
  .help.c create window $x 20 -window .help.c.curve -tag curve
  incr x 32
  .help.c create window $x 20 -window .help.c.polyline -tag polyline
  incr x 32
  .help.c create window $x 20 -window .help.c.polycurve -tag polycurve
  incr x 32
  .help.c create window $x 20 -window .help.c.polygon -tag polygon
  incr x 32
  .help.c create window $x 20 -window .help.c.polyspline -tag polyspline
  incr x 32
  .help.c create window $x 20 -window .help.c.rectangle -tag rectangle
  incr x 32
  .help.c create window $x 20 -window .help.c.oval -tag oval
  incr x 32
  .help.c create window $x 20 -window .help.c.arc -tag arc
  incr x 32
  .help.c create window $x 20 -window .help.c.chord -tag chord
  incr x 32
  .help.c create window $x 20 -window .help.c.pieslice -tag pieslice
  incr x 32
  .help.c create window $x 20 -window .help.c.dotext -tag dotext
  incr x 32
  .help.c create window $x 20 -window .help.c.image -tag image

  .help.c create text 10 140 -anchor w -tag helptext -text "Click a button"
}

proc modehelp {mode} {
  foreach m {sketch line multiline curve polyline polycurve polygon polyspline oval rectangle arc chord pieslice dotext image} {
    .help.c.$m config -relief raised
  }
  case $mode in {
    sketch {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Sketch mode allows you to sketch freehand.
Drawing begins by pressing and holding the first
mouse button, and moving the mouse.  The sketched
line is completed when the mouse button is released.

The resulting object is a multi-segmented line with
LOTS of small segments."
    }
    line {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create single line segments.  Press and hold mouse
button 1 at the starting point, drag to the end
point, and release the mouse button.

Using the shift key (BEFORE STARTING) constrains
the line to be on the nearest horizontal, vertical,
or diagonal line."
    }
    multiline {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a set of connected line segments.  Press and
release mouse button 1 at the first point, and add
more points to the segment by clicking button 1
again.  To complete the line, click mouse button 3."
    }
    curve {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a series of smooth curves.  Press and
release mouse button 1 at the first point, and add
more points to the segment by clicking button 1
again.  To complete the curve, click mouse button 3.

The curve will be created such that it will be
tangent to the lines between each point."
    }
    polyline {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create the outline of a polygon.  Press and
release mouse button 1 at the first point, and add
more points to the polygon by clicking button 1
again.  To complete the polygon, click mouse button 3;
a final segment will automatically be created to
close the polygon.

(Future: rubber band the final segment throughout
the process, so that a closed polygon is always
displayed.)"
    }
    polycurve {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create an outline of a curved object.  Press and release
mouse button 1 at the first point, and add more points to
the object by clicking button 1 again.  To complete the object,
click mouse button 3; a final curve will automatically close
the shape.

The curves will be created such that they will be tangent to
the lines between each point.

The shape won't appear until you have created the second point.

(Future: rubber band the final curve throughout the process,
so that a closed shape is always displayed.)"
    }
    polygon {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a solid polygon.  Press and
release mouse button 1 at the first point, and add
more points to the polygon by clicking button 1
again.  To complete the polygon, click mouse button 3.

The shape won't appear until you have created the
second point."
    }
    polyspline {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a solid curved object.  Press and
release mouse button 1 at the first point, and add
more points to the object by clicking button 1
again.  To complete the curve, click mouse button 3;
a final curve will automatically close the shape.

The object won't appear until you have created the
second point."
    }
    rectangle {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a rectangle.  Press and hold mouse
button 1 at the upper left corner, drag to the 
lower right corner, and release the mouse button.

Using the shift key (BEFORE STARTING) constrains
the rectangle to be a square."
    }
    oval {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create an oval.  Press and hold mouse
button 1 at the upper left corner, drag to the 
lower right corner, and release the mouse button.

Using the shift key (BEFORE STARTING) constrains
the oval to be a circle."
    }
    arc {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create an arc.  Press and hold mouse at the upper
left corner (of what would be the full oval), drag to the lower
right corner, and release the mouse button.  The arc portion is
controlled in the options window by the Start Angle and Extent
options.

Using the shift key (BEFORE STARTING) constrains
the segment to be on a circle."
    }
    chord {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a chorded arc.  Press and hold mouse at the
upper left corner (of what would be the full oval), drag to the lower
right corner, and release the mouse button.  The arc portion is
controlled in the options window by the Start Angle and Extent
options.

Using the shift key (BEFORE STARTING) constrains
the segment to be on a circle."
    }
    pieslice {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create a pieslice.  Press and hold mouse at the upper
left corner (of what would be the full oval), drag to the lower
right corner, and release the mouse button.  The arc portion is
controlled in the options window by the Start Angle and Extent
options.

Using the shift key (BEFORE STARTING) constrains
the segment to be on a circle."
    }
    dotext {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Create text.  Click and release the mouse at the
desired starting point, and type the text.
Clicking on text that already exists adds
the insertion cursor at that point.

Delete or BackSpace will delete backwards.
Left and Right arrows move forwards and
backwards.  Escape will end editing.

Most keyboard shortcuts that affect objects will
not work in text mode.  Autoselection also will
not work."
    }
    image {
      .help.c.$mode config -relief sunken
      .help.c itemconfig helptext \
	-text "Load an image.  A window will come up that lets you select
a file, the amount to zoom it, and where to place it.  Once it is placed,
it can be moved around as other ordinary objects, but not resized."
    }
  }
}

proc help_about {} {
  .help.c delete all
  .help.c config -bg white
  bind .help.c <1> ""
  bind .help.c <2> ""
  bind .help.c <3> ""
  set tmpw .help.c

$tmpw create line 430.0 220.0 430.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 420.0 210.0 420.0 340.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 410.0 220.0 410.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 400.0 190.0 400.0 340.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 390.0 210.0 390.0 340.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 380.0 210.0 380.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 370.0 190.0 370.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 360.0 180.0 360.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 350.0 190.0 350.0 340.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 340.0 190.0 340.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 330.0 190.0 330.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 320.0 190.0 320.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 310.0 180.0 310.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 300.0 190.0 300.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 290.0 190.0 290.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 280.0 200.0 280.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 450.0 220.0 450.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 440.0 220.0 440.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 460.0 220.0 460.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 490.0 250.0 490.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 470.0 230.0 470.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 270.0 210.0 270.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 260.0 210.0 260.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 250.0 210.0 250.0 300.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 240.0 180.0 240.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 230.0 180.0 230.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 220.0 170.0 220.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 210.0 180.0 210.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 200.0 180.0 200.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 550.0 240.0 550.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 180.0 180.0 180.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 160.0 180.0 160.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 150.0 180.0 150.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 140.0 320.0 140.0 180.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 130.0 180.0 130.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 120.0 170.0 120.0 250.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 570.0 260.0 120.0 260.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 170.0 170.0 170.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 510.0 250.0 510.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 120.0 270.0 590.0 270.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 120.0 290.0 590.0 290.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 540.0 250.0 540.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 520.0 240.0 520.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 480.0 230.0 480.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 530.0 250.0 530.0 300.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 190.0 180.0 190.0 330.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 500.0 240.0 500.0 320.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 130.0 280.0 600.0 280.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 250.0 310.0 530.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 100.0 190.0 250.0 190.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 100.0 250.0 590.0 250.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 90.0 240.0 490.0 240.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 560.0 250.0 560.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 80.0 230.0 450.0 230.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 60.0 210.0 380.0 210.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 60.0 220.0 400.0 220.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 70.0 200.0 410.0 200.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create polygon 120.0 220.0 120.0 210.0 210.0 210.0 210.0 220.0 180.0 220.0 180.0 290.0 150.0 290.0 150.0 220.0 120.0 220.0 -fill #000000 -smooth 0 -splinesteps 12 -tags group4 -width 1
$tmpw create polygon 240.0 210.0 220.0 210.0 220.0 290.0 240.0 290.0 240.0 270.0 260.0 290.0 270.0 290.0 270.0 280.0 260.0 270.0 270.0 260.0 260.0 250.0 250.0 260.0 240.0 260.0 240.0 210.0 -fill #000000 -smooth 0 -splinesteps 12 -tags group4 -width 1
$tmpw create polygon 340.0 210.0 270.0 210.0 280.0 220.0 280.0 290.0 340.0 290.0 350.0 280.0 350.0 220.0 340.0 210.0 -fill #000000 -smooth 0 -splinesteps 12 -tags {group2 group4} -width 1
$tmpw create polygon 370.0 290.0 370.0 260.0 360.0 250.0 370.0 240.0 380.0 250.0 410.0 250.0 420.0 260.0 410.0 270.0 400.0 260.0 390.0 260.0 390.0 290.0 370.0 290.0 -fill #000000 -smooth 0 -splinesteps 12 -tags group4 -width 1
$tmpw create polygon 310.0 280.0 310.0 220.0 320.0 220.0 320.0 280.0 310.0 280.0 -fill #ffffff -smooth 0 -splinesteps 12 -tags {group2 group4} -width 1
$tmpw create polygon 460.0 250.0 420.0 250.0 430.0 260.0 450.0 260.0 450.0 270.0 430.0 270.0 420.0 280.0 430.0 290.0 480.0 290.0 470.0 280.0 470.0 260.0 460.0 250.0 -fill #000000 -smooth 0 -splinesteps 12 -tags group4 -width 1
$tmpw create polygon 490.0 250.0 470.0 250.0 480.0 260.0 480.0 280.0 490.0 290.0 540.0 290.0 550.0 280.0 550.0 260.0 560.0 250.0 540.0 250.0 530.0 260.0 530.0 280.0 520.0 280.0 520.0 250.0 510.0 250.0 510.0 280.0 500.0 280.0 500.0 260.0 490.0 250.0 -fill #000000 -smooth 0 -splinesteps 12 -tags group4 -width 1
$tmpw create polygon 149.0 138.0 190.0 22.0 150.0 108.0 133.0 166.0 129.0 218.0 151.0 204.0 162.0 151.0 171.0 106.0 193.0 39.0 146.0 163.0 181.0 61.0 149.0 138.0 -fill #9e00b6 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 343.0 111.0 360.0 52.0 328.0 135.0 320.0 166.0 317.0 212.0 341.0 240.0 338.0 174.0 358.0 110.0 380.0 23.0 355.0 104.0 367.0 49.0 343.0 120.0 361.0 60.0 343.0 111.0 -fill #00ff00 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 453.0 100.0 470.0 42.0 432.0 144.0 420.0 208.0 436.0 239.0 444.0 198.0 447.0 153.0 473.0 65.0 451.0 118.0 482.0 24.0 453.0 100.0 -fill #ff8000 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 388.0 80.0 342.0 47.0 381.0 86.0 406.0 109.0 414.0 114.0 440.0 90.0 478.0 49.0 444.0 57.0 417.0 87.0 412.0 95.0 362.0 55.0 386.0 81.0 388.0 80.0 -fill #ffff00 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 222.0 91.0 282.0 67.0 233.0 75.0 186.0 109.0 168.0 175.0 208.0 226.0 287.0 216.0 324.0 154.0 296.0 93.0 269.0 88.0 287.0 125.0 295.0 164.0 270.0 189.0 242.0 198.0 213.0 195.0 191.0 170.0 209.0 118.0 232.0 109.0 190.0 123.0 248.0 91.0 205.0 106.0 268.0 77.0 226.0 90.0 220.0 94.0 222.0 91.0 -fill #0000f7 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 224.0 32.0 318.0 29.0 199.0 26.0 78.0 46.0 115.0 62.0 192.0 49.0 281.0 46.0 217.0 44.0 301.0 37.0 211.0 38.0 273.0 34.0 220.0 33.0 224.0 32.0 -fill #ff0000 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 511.0 95.0 529.0 73.0 502.0 97.0 483.0 103.0 475.0 120.0 495.0 122.0 523.0 101.0 541.0 88.0 510.0 103.0 548.0 77.0 514.0 97.0 543.0 74.0 516.0 94.0 547.0 63.0 511.0 95.0 -fill #9e00b6 -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 573.0 120.0 534.0 117.0 507.0 146.0 489.0 162.0 485.0 182.0 509.0 194.0 541.0 188.0 548.0 199.0 542.0 218.0 520.0 222.0 499.0 215.0 448.0 199.0 501.0 221.0 452.0 207.0 521.0 231.0 457.0 216.0 551.0 242.0 487.0 226.0 503.0 234.0 545.0 243.0 575.0 203.0 567.0 181.0 533.0 173.0 509.0 182.0 510.0 168.0 518.0 151.0 544.0 146.0 573.0 120.0 -fill #00ffff -smooth 1 -splinesteps 12 -width 1
$tmpw create polygon 560.0 197.0 548.0 185.0 560.0 201.0 556.0 211.0 542.0 222.0 558.0 212.0 561.0 205.0 560.0 197.0 -fill #ffffff -smooth 1 -splinesteps 12 -width 1
$tmpw create line 120.0 300.0 580.0 300.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 110.0 180.0 110.0 270.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 80.0 190.0 80.0 240.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 100.0 210.0 100.0 260.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1
$tmpw create line 580.0 260.0 580.0 310.0 -arrow none -arrowshape {8 10 3} -capstyle butt -fill #e0e0e0 -joinstyle round -smooth 0 -splinesteps 12 -width 1

  .help.c move all -80 -10
  set tmp [.help.c create text 50 330 -anchor nw -text "Version 1.0 Beta    "]
  set newx [lindex [.help.c bbox $tmp] 2]
  #go thru some convolutions to make the URL selectable for pasting
  set tmp2 [.help.c create text $newx 330 -anchor nw -tags URL -text "http://hea-www.harvard.edu/~fine/Tech/ttkdraw.html"]
  eval .help.c create rectangle [.help.c bbox $tmp2] -outline \"\" -width 0 -fill white -tags URLbg
  .help.c lower URLbg
  .help.c bind URL <B1-Motion> ".help.c itemconfig URLbg -fill yellow; selection handle .help.c give_url; selection own .help.c"
  .help.c bind URLbg <B1-Motion> ".help.c itemconfig URLbg -fill yellow; selection handle .help.c give_url; selection own .help.c"
  .help.c bind URL <1> ".help.c itemconfig URLbg -fill white; selection clear .help.c"
  .help.c bind URLbg <1> ".help.c itemconfig URLbg -fill white; selection clear .help.c"
}

proc give_url {i max} {
  return [string range [.help.c itemcget URL -text] $i [expr $i+$max]]
}

proc help_general {} {
  .help.c delete all
  .help.c config -bg linen
  bind .help.c <1> ""
  bind .help.c <2> ""
  bind .help.c <3> ""
  .help.c create text 20 30 -anchor nw -text {
Tom's TkDraw (ttkdraw) is an object-based drawing program.  This means that
you draw objects, and you can then manipulate them individually - move them
around, raise them above other objects, etc.  You can also select a group of
objects and combine them into a single "object".  Grouped objects can contain
other groups too.

Many drawing programs have a "selection" mode.  I've tried to have that mode
always be available, by reserving mouse button 2 for object selection
activities.  I may rearrange this in the future to provide a cleaner interface.
}
}

#proc path_expand {entry} {
#  popdown_list $entry
#  #get the path we have so far
#  set pathsofar [$entry get]
#  if [string length $pathsofar]==0 {
#    set startpath .
#    set nextpath ""
#  } else {
#    set pathels [split $pathsofar /]
#    set nextpath [lindex $pathels end]
#    set chopat [expr [llength $pathels]-2]
#    set newpathels [lrange $pathels 0 $chopat]
#    set startpath [join $newpathels /]
#  }
#  if ![file isdirectory $startpath/] {
#    bell
#    return
#  }
#  if ![file readable $startpath/] {
#    bell
#    return
#  }
#  set pattern "$nextpath*"
#  set kids [glob -nocomplain $startpath/*]
#  set good ""
#  foreach kid $kids {
#    if [string match $startpath/$pattern $kid] {
#      lappend good $kid
#    }
#  }
#  if [llength $good]==0 {    # no matches
#    bell
#    return
#  } elseif [llength $good]==1 {    # one match
#    set show [string range $good [string length $pathsofar] end]
#    if [file isdirectory $good] {
#      $entry insert end $show/
#    } else {
#      $entry insert end $show
#    }
#  } else {    # more than one match
#    $entry insert end [more_non_unique $pathsofar $good]
#    popup_list $entry $good
#    bell
#  }
#}
#
#proc popdown_list {entry} {
#  if [winfo exists .pe_popup] {
#    .pe_popup unpost
#  }
#}
#
#proc popup_list {entry list} {
#  set list [lsort $list]
#  if ![winfo exists .pe_popup] {
#    menu .pe_popup -tearoff 0
#  } else {
#    .pe_popup delete 0 end   
#  }
#  set length [llength $list]
#  set maxw 0
#  set widest 0
#  for {set i 0} {$i<$length} {incr i} {
#    set w [string length [lindex $list $i]]
#    if $w>$maxw {
#      set maxw $w
#      set widest $i
#    }
#  }
#  if ($length<10) {
#    set columns 1
#  } elseif ($length<45) {
#    set columns 2
#  } elseif ($length<80) {
#    set columns 3
#  } elseif ($length<150) {
#    set columns 4
#  } elseif ($length<240) {
#    set columns 5
#  } else {
#    set columns 6
#  }
#  set rows [expr int($length/$columns)]
#  if [expr $length%$columns] { incr rows }
#  set i 0
#  set skippath [expr [string length [file dirname [lindex $list 0]]]+1]
#  #special case for starting path of "/"
#  if $skippath==2 { set skippath 1 }
#  foreach item $list {
#    set tmp [string range $item $skippath end]
#    set type [file type $item]
#    switch $type {
#      file { if [file executable $item] { set tmp "$tmp*" } }
#      link { set tmp "$tmp@" }
#      directory { set tmp "$tmp/" }
#      fifo { set tmp "$tmp|" }
#      socket { set tmp "$tmp=" }
#      characterSpecial { set tmp "$tmp%" }
#      blockSpecial { set tmp "$tmp%" }
#    }
#    if [expr $i%$rows]==0 {
#      .pe_popup add command -label $tmp -columnbreak 1 -command "$entry delete 0 end; $entry insert end $item"
#    } else {
#      .pe_popup add command -label $tmp -command "$entry delete 0 end; $entry insert end $item"
#    }
#    incr i
#  }
#  set x [winfo rootx $entry]
#  set y [expr [winfo rooty $entry]+[winfo height $entry]]
#  .pe_popup post $x $y
#  #focus .bar
#  #grab -global .bar
#}
#
#proc more_non_unique {start matchlist} {
#  set nonunique [lindex $matchlist 0]
#  set startlen [string length $start]
#  foreach a $matchlist {
#    for {set i [string length $nonunique]} {$i>=0} {incr i -1} {
#      if {"[string range $a 0 $i]"=="[string range $nonunique 0 $i]"} {
#        set nonunique [string range $nonunique 0 $i]
#        break
#      } 
#    }
#  }
#  return [string range $nonunique $startlen end] 
#}

mkoptions
mkbgdialog
resetall
setup_reshapemenu
if [string length $currfile] { load $currfile }

