

proc IME_Init { {toplevel .} {file {}} } {
    global ime

    array set ime {
	    version "1.1 2/27/96"
	    dirty	0
	    imagedir images
	    ismapdir {}
	    config	~/.ime
	    format ncsa
	    objectset	{}
    }
    foreach x {library html images} {
	if ![info exists ime($x)] {
	    global WebTk
	    set ime($x) $WebTk($x)
	}
    }
    set ime(help) file:[file join $ime(html) imagemap.html]
    catch {source $ime(config)}

    if {"$toplevel" != "."} {
	if [winfo exists $toplevel] {
	    raise $toplevel
	    if [string length $file] {
		IME_Load $file
	    }
	    return
	}
	set t [toplevel $toplevel]
    } else {
	set t {}
    }
    set ime(toplevel) $toplevel
    wm iconname $toplevel imagemap
    wm title $toplevel "Sun Labs' Image Map Editor"
    wm protocol $toplevel WM_DELETE_WINDOW [list IME_Quit $toplevel]

    frame $t.rim -border 10 -relief flat
    set ime(can) [canvas $t.imedit -width 200 -height 200 \
	-highlightthickness 0 -border 0 -background white]

    IMEBindings $ime(can)

    set f [frame $t.buttons -class Buttons]
    pack $f -side top -fill x
    pack $t.rim -side top -fill both -expand true
    pack $ime(can) -in $t.rim -side top -expand true

    menubutton $t.file -text File -menu $t.file.m
    set m [menu $t.file.m]
    $m add command -label Open -command IME_Open
    $m add command -label Save -command IME_Save
    $m add command -label "Save As..." -command IME_SaveAs
    $m add separator
    $m add cascade -label "Help" -menu $m.help
    $m add command -label "Configuration..." -command IME_Config
    $m add separator
    $m add command -label Quit -command [list IME_Quit $toplevel]

    set m [menu $t.file.m.help]
    $m add command -label "Load Help URL into Netscape" -command [list Netscape $ime(help)]
    $m add command -label "Load Help URL into Mosaic" -command [list Mosaic $ime(help)]
    $m add command -label "Load Help URL into WebTk" -command [list Browse_WebTk $ime(help)]


    menubutton $t.edit -text Edit -menu $t.edit.m
    set m [menu $t.edit.m]

    set ime(shape) rect
    $m add radio -label Circle \
	-value circle -variable ime(shape)
    $m add radio -label Rect \
	-value rect -variable ime(shape)
    $m add radio -label Poly  \
	-value poly -variable ime(shape)
    $m add separator
    $m add command -label "Bring to front" -command IME_Raise
    $m add command -label "Push to back" -command IME_Lower
    $m add separator
    $m add command -label "Url Set" -command IME_UrlEdit

    radiobutton $t.circle -bitmap @[file join $ime(images) oval.xbm] \
	-value circle -variable ime(shape)
    radiobutton $t.rect -bitmap @[file join $ime(images) rect.xbm] \
	-value rect -variable ime(shape)
    radiobutton $t.poly -bitmap @[file join $ime(images) poly.xbm] \
	-value poly -variable ime(shape) \

    pack $t.file $t.edit -in $f -side left
    pack $t.circle $t.rect $t.poly -in $f -side right

    set ime(status) "Version $ime(version)"
    entry $t.status -textvariable ime(status) -relief flat
    pack $t.status -in $f -side top -fill x -expand true

    if [string length $file] {
	IME_Load $file
    } else {
	set ime(dirty) 0
    }
}
proc IMEBindings {can} {
    bind $can <Button-1> {IME_Start %W %x %y}
    bind $can <Motion> {IME_Motion %W %x %y}
    bind $can <ButtonRelease-1> {IME_End %W %x %y}
    bind $can <Any-Button-3> {
	if [info exists ime(active)] {
	    IME_Cancel %W
	} else {
	    IME_Edit %W %x %y
	}
    }

    $can bind map <Motion> {IME_Feedback %W %x %y}
    $can bind map <Leave> {IME_Message ""}
}
proc IMEConfigDir {key label} {
    global ime
    set new [fileselect "Set $label" {} dir]
    if [string length $new] {
	set ime(key) $new
    }
}
proc IME_Config {} {
    global ime
    set t .imeconfig
    if ![winfo exists $t] {
	toplevel $t -bd 10 -relief flat
	message $t.msg
	pack $t.msg -side top -fill x

	foreach {key label} {
	    imagedir "Image Dir"
	    ismapdir "Ismap Dir"
	} {
	    set f [frame $t.$key]
	    pack $f -side top -fill x
	    button $f.label -text "$label:" -command [list IMEConfigDir $key $label]
	    entry $f.entry -width 40 -textvariable ime($key)
	    pack $f.label -side left
	    pack $f.entry -side top -fill x
	}

	set r [frame $t.choice]
	pack $t.choice -side top
	label $r.label -text "Map Format:"
	radiobutton $r.ncsa -variable ime(format) -text NCSA -value ncsa
	radiobutton $r.cern -variable ime(format) -text CERN -value cern
	pack $r.label $r.ncsa $r.cern -side left

	frame $t.buttons
	pack $t.buttons -side bottom -fill x
	button $t.quit -text OK -command {set ime(configdone) 1}
	button $t.cancel -text Cancel -command {set ime(configdone) 0}
	pack $t.quit -in $t.buttons -side left
	pack $t.cancel -in $t.buttons -side right
    } else {
	raise $t
    }
    $t.msg config -aspect 1500 -text "Image Map Editor Configuration
Define the directory that contains your images,
and the directory for the map information.
If your maps go in the same directory as the images,
either leave the map directory blank or make it the
same as the image directory.
If the image file is foo.gif, then
the map file is foo.map"
    set ime(configdone) {}
    set olddir $ime(imagedir)
    set oldmap $ime(ismapdir)
    tkwait variable ime(configdone)
    if {! $ime(configdone)} {
	set ime(imagedir) $olddir
	set ime(ismapdir) $oldmap
	after 200
    } else {
	if [catch {open $ime(config) w} out] {
	    IME_Message $out
	} else {
	    puts $out "# Image Map Editor Configuration"
	    foreach x {config imagedir ismapdir format} {
		puts $out [list set ime($x) $ime($x)]
	    }
	    close $out
	}
    }
    destroy $t
}
proc IMEUrlEditEntry {parent i label variable} {
    global ime
    set f [frame $parent.$i]
    pack $f -side top -fill x
    if {$i >= 1} {
	button $f.label -text "$label:" -width 10 -anchor w \
	    -command [list IMEHighlight $i] \
	    -padx 1 -pady 1 -takefocus 0
    } else {
	label $f.label -text "$label:" -width 10 -anchor w \
	    -bd 1 -padx 1 -pady 1
    }
    entry $f.entry -width 40 -textvariable $variable
    bind $f.entry <Return> [list IMEHighlightReset]
    pack $f.label -side left
    pack $f.entry -side top -fill x
}
proc IME_UrlEdit {} {
    global ime
    set t .imeurledit
    if ![winfo exists $t] {
	toplevel $t -bd 10 -relief flat
	message $t.msg
	frame $t.urls
	pack $t.msg $t.urls -side top -fill x

	frame $t.buttons
	pack $t.buttons -side bottom -fill x
	button $t.quit -text OK -command {set ime(urldone) 1}
	button $t.cancel -text Cancel -command {set ime(urldone) 0}
	pack $t.quit -in $t.buttons -side left
	pack $t.cancel -in $t.buttons -side right
    } else {
	raise $t
	catch {eval destroy [winfo children $t.urls]}
    }
    $t.msg config -aspect 1500 -text "Image Map URLS"
    IMEUrlEditEntry $t.urls 0 "Default URL" ime(default)
    set oldurl(default) $ime(default)
    set i 1
    foreach x $ime(objectset) {
	IMEUrlEditEntry $t.urls $i [lindex $x 1] ime(url,[lindex $x 0])
	set oldurl(url,[lindex $x 0]) $ime(url,[lindex $x 0])
	incr i
    }
    set ime(urldone) {}
    tkwait variable ime(urldone)
    if {! $ime(urldone)} {
	array set ime [array get oldurl]
    } else {
	set ime(dirty) 1
    }
    IMEHighlightReset
    catch {destroy $t}
}
proc IMEHighlight {i} {
    global ime
    set j 1
    foreach x $ime(objectset) {
	set id [lindex $x 0]
	if {$j == $i} {
	    $ime(can) itemconfig $id -fill red
	} else {
	    if [string length $ime(url,$id)] {
		$ime(can) itemconfig $id -fill green
	    } else {
		$ime(can) itemconfig $id -fill blue
	    }
	}
	incr j
    }
}
proc IMEHighlightReset {} {
    IMEHighlight 0
}
proc IME_Dialog {shape item urlVar commentVar points} {
    global ime
    set t .imedialog
    if ![winfo exists $t] {
	toplevel $t -bd 10 -relief flat
	message $t.msg
	frame $t.url
	label $t.label -text URL:
	entry $t.entry -width 40
	bind $t.entry <Return> {set ime(editdone) 1 ; break}
	set g [frame $t.x]
	label $t.label2 -text Comment:
	entry $t.comment -width 40
	bind $t.comment <Return> {set ime(editdone) 1 ; break}
	pack $t.msg $t.url $g -side top -fill x
	pack $t.label -in $t.url -side left
	pack $t.entry -in $t.url -side top -fill x
	pack $t.label2 -in $g -side left
	pack $t.comment -in $g -side top -fill x

	frame $t.buttons
	pack $t.buttons -side top -fill x
	button $t.quit -text OK -command {set ime(editdone) 1}
	button $t.delete -text Delete -command {set ime(editdone) -1}
	button $t.cancel -text Cancel -command {set ime(editdone) 0}
	button $t.show
	pack $t.quit $t.show -in $t.buttons -side left
	pack $t.cancel $t.delete -in $t.buttons -side right

    } else {
	if {[info exists ime(editdone)] && 
		([string length $ime(editdone)] == 0)} {
	    set ime(editdone) 0
	    return
	}
	wm deiconify $t
	raise $t
	destroy $t.points
    }

    $t.show config -text "Show Points" -command [list IMEDialogShowPoints $t]
    $t.msg config -text "Edit $shape"
    $t.entry config -textvariable $urlVar
    $t.comment config -textvariable $commentVar
    upvar #0 $urlVar url $commentVar comment
    set oldurl $url
    set oldcomment $comment

    global tpoints
    catch {unset tpoints}
    set f [frame $t.points -bd 4 -relief ridge]
    set i  1
    foreach {x y} $points {
	set g [frame $f.$i]
	label $g.l1 -text "Point $i X:"
	label $g.l2 -text " Y:"
	set tpoints($i,x) $x
	entry $g.x -textvariable tpoints($i,x) -width 5
	bind $g.x <Return> [list IMEUpdateCoords $shape $item]
	set tpoints($i,y) $y
	entry $g.y -textvariable tpoints($i,y) -width 5
	bind $g.y <Return> [list IMEUpdateCoords $shape $item]
	pack $g -side top -fill x
	pack $g.l1 $g.x $g.l2 $g.y -side left
	incr i
    }
    set tpoints(n) $i
    array set oldpoints [array get tpoints]
    set ime(editdone) {}
    tkwait variable ime(editdone)
    wm withdraw $t
    if {$ime(editdone) == 0} {
	set url $oldurl
	set comment $oldcomment
	array set tpoints [array get oldpoints]
    } elseif {$ime(editdone) < 0} {
	IMEDelete $item
	catch {unset url}
	return
    }
    IMEUpdateCoords $shape $item
}

proc IMEDialogShowPoints {t} {
    pack $t.points -side top -pady 10
    $t.show config -text "Hide Points" -command [list IMEDialogHidePoints $t]
}
proc IMEDialogHidePoints {t} {
    pack forget $t.points
    $t.show config -text "Show Points" -command [list IMEDialogShowPoints $t]
}
proc IME_Load {file} {
    global ime
    IME_Message "Loading [file tail $file] ..."
    if {[file extension $file] == ".map"} {
	set map $file
	set file [file root $file].gif
    } else {
	set map [IME_MapName $file]
    }
    if [catch {
	set image [image create photo -file $file]
    } err] {
	IME_Message "Cannot load GIF $file"
	return
    }
    catch {image delete $ime(image)}
    catch {$ime(can) delete all}
    set ime(objectset) {}
    foreach x [array names ime url,*] {unset ime($x)}
    foreach x [array names ime points,*] {unset ime($x)}
    foreach x [array names ime comment,*] {unset ime($x)}
    set ime(dirty) 0
    set ime(imagefile) $file
    set ime(image) $image
    set ime(canimg) [$ime(can) create image 0 0 -anchor nw -image $ime(image)]
    set bb [$ime(can) bbox $ime(canimg)]
    $ime(can) config -width [lindex $bb 2]
    $ime(can) config -height [lindex $bb 3]
    IME_Message [file tail $file]
    IME_LoadMap $map
}
proc IME_MapName {imagefile} {
    global ime
    if {[string length [string trim $ime(ismapdir)]] == 0} {
	return [file root $imagefile].map
    } else {
	return $ime(ismapdir)/[file root [file tail $imagefile]].map
    }
}
proc IME_LoadMap {mapname} {
    global ime
    if [catch {open $mapname} in] {
	IME_Message "Cannot open Map Info: $mapname"
	return
    }
    set comment {}
    foreach line [split [read $in] \n] {
	if [regexp {^[ 	]*(#.*)?$} $line] {
	    set comment $line
	    continue
	}
	regexp {^[ 	]*([^ 	]+)[ 	]*([^ 	].+)?$} $line \
	    all key rest
	if [regexp {^\(} $rest] {
	    # CERN format
	    # shape (x,y) (x,y) ...  url
	    set ime(format) cern
	    regexp {^(.+)([ 	]+([^ 	]+))$} $rest \
		all points junk url
	    regsub -all {[\(\)]} $points {} points
	} else {
	    # NCSA format
	    # shape url x,y x,y x,y ...
	    set ime(format) ncsa
	    regexp {^([^ 	]+)([ 	]+(.+))?$} $rest \
		all url junk points
	}
	set key [string tolower $key]
	set coords {}
	if [string length $points] {
	    regsub -all {[ 	]+} $points { } points
	    foreach pair [split $points] {
		foreach {x y} [split $pair ,] { break }
		lappend coords $x $y
	    }
	}
	if {[string compare $key "default"] == 0} {
	    set ime(default) $url
	    continue
	}
	if [catch {
	    switch -glob -- $key {
		r* { set id [IME.rectCreate $coords] ; set key rect }
		c* { set id [IME.circleCreate $coords] ; set key circle }
		p* { set id [IME.polyCreate $coords] ; set key poly}
		default {error "Unknown shape $key"}
	    }
	    lappend ime(objectset) [list $id $key]
	    set ime(points,$id) $coords
	    set ime(url,$id) $url
	    set ime(comment,$id) $comment
	    set comment {}
	} err] {
	    IME_Message "Bad map info: $line \n$err"
	}
    }
}

proc IME_Destroy {} {
    eval destroy [winfo children .]
    eval image delete [image names]
}
proc IME_Open {} {
    global ime
    if [IMEDirty] {
	DialogConfirm $ime(toplevel) .dirty \
	    "Save changes to current map?" IME_Save { } \
	    "Save" "Do Not Save"
    }
    set file [fileselect "Open an Image File" $ime(imagedir) file]
    if [string length $file] {
	IME_Load $file
    }
}

proc IMEDirty {} {
    global ime
    return $ime(dirty)
}
proc IME_SaveAs {} {
    global ime
    set new [fileselect "Image Map File" [IME_MapName $ime(imagefile)] {}]
    if [string length $new] {
	IME_Save $new
    }
}
proc IME_Save {{where {}}} {
    global ime
    if {[string length $where] == 0} {
	set ime(mapfile) [IME_MapName $ime(imagefile)]
    } else {
	set ime(mapfile) $where
    }
    foreach obj $ime(objectset) {
	foreach {id shape} $obj {break}	;# list assignment
	if {![info exists ime(url,$id)] || [string length $ime(url,$id)] == 0} {
	    lappend nourl $id
	}
    }
    if [info exists nourl] {
	foreach id $nourl {
	    $ime(can) itemconfig $id -fill blue
	}
	DialogInfo $ime(toplevel) \
"Please assign URLs to blue hot spots.
Right click on a hot spot to edit its properties."
	return
    }
    if [catch {open $ime(mapfile) w} out] {
	DialogInfo $ime(toplevel) "Cannot create $ime(mapfile)\n$out"
	return
    }
    puts $out "# Map for $ime(imagefile)"
    foreach obj $ime(objectset) {
	foreach {id shape} $obj {break}	;# list assignment
	set coords $ime(points,$id)
	if {[info exists ime(comment,$id)] && 
		[string length $ime(comment,$id)]} {
	    if ![string match #* $ime(comment,$id)] {
		set ime(comment,$id) #$ime(comment,$id)
	    }
	    puts $out $ime(comment,$id)
	}
	puts -nonewline $out "$shape"
	if {$ime(format) == "ncsa"} {
	    puts -nonewline $out " $ime(url,$id)"
	    set format " %d,%d"
	} else {
	    set format " (%d,%d)"
	}
	foreach {fx fy} $coords {
	    scan $fx %d x
	    scan $fy %d y
	    puts -nonewline $out [format $format [expr round($x)] [expr round($y)]]
	}
	if {$ime(format) == "cern"} {
	    puts -nonewline $out " $ime(url,$id)"	    
	}
	puts $out ""
    }
    if {[info exist ime(default)] && [string length $ime(default)]} {
	puts $out "default $ime(default)"
    }
    close $out
    set ime(dirty) 0
    DialogInfo $ime(toplevel) "Saved Map\n$ime(mapfile)"
}

proc IME_Start {can x y} {
    global ime
    if ![info exists ime(canimg)] {
	IME_Message "Open an image, please"
	return
    }
    set ime(active) 1
    set ime(x) $x
    set ime(y) $y
    IME.$ime(shape)Start $can
}
proc IME_Motion {can x y} {
    global ime
    if ![info exists ime(active)] {
	return
    }
    IME.$ime(shape)Motion $can $x $y
}
proc IME_End {can x y} {
    global ime
    if ![info exists ime(active)] {
	return
    }
    if [IME.$ime(shape)End $can $x $y] {
	set ime(dirty) 1
	unset ime(active)
	if [winfo exists .imeurledit] {
	    # Keep the dialog with all URLs up-to-date
	    IME_UrlEdit
	}
    }
}
proc IME_Cancel {can} {
    global ime
    IME.$ime(shape)Cancel $can
    unset ime(active)
}

proc IME_Edit {can x y} {
    global ime
    set it [$ime(can) find overlapping \
	[expr $x -2] [expr $y -2] [expr $x+2] [expr $y+2]]
    foreach x $it {
	if {$x != $ime(canimg)} {
	    set item $x
	    # Continue and find last, uppermost shape
	}
    }
    if [info exists item] {
	set i 0
	foreach x $ime(objectset) {
	    if {[lindex $x 0] == $item} {
		set ime(activeshape) [lindex $x 1]
		set points $ime(points,$item)
		set ime(activeitem) $item
		$ime(can) itemconfig $item -fill red
		IME_ShowPoints $item $points
		IME_Dialog $ime(activeshape) $item ime(url,$item) \
			ime(comment,$item) $points
		IME_HidePoints $item
		$ime(can) itemconfig $item -fill green
		catch {unset ime(activeitem)}
		return
	    }
	    incr i
	}
    }
}
proc IME_Feedback {can x y} {
    global ime
    set it [$ime(can) find overlapping \
	[expr $x -2] [expr $y -2] [expr $x+2] [expr $y+2]]
    foreach x $it {
	if [info exists ime(url,$x)] {
	    set item $x
	}
    }
    if [info exists item] {
	IME_Message $ime(url,$item)
    }
}
proc IMEUpdateCoords {shape item} {
    global ime tpoints
    set points {}
    for {set j 1} {$j < $tpoints(n)} {incr j} {
	lappend points $tpoints($j,x) $tpoints($j,y)
    }
    set ime(points,$item) [IME.${shape}Coords $item $points]
}
proc IMEDelete {item} {
    global ime
    set i 0
    foreach x $ime(objectset) {
	if {[lindex $x 0] == $item} {
	    set ime(objectset) [lreplace $ime(objectset) $i $i]
	    catch {unset ime(url,$item)}
	    catch {unset ime(comment,$item)}
	    catch {unset ime(points,$item)}
	    break
	}
	incr i
    }
    $ime(can) delete $item
    set ime(dirty) 1
}

proc IME.rectStart {can} {
    return
}
proc IME.rectMotion {can x y} {
    global ime
    catch {$ime(can) delete $ime(rect)}
    set ime(rect) [$ime(can) create rect $ime(x) $ime(y) $x $y]
}
proc IME.rectEnd {can x y} {
    global ime
    if [info exists ime(rect)] {
	$ime(can) itemconfig $ime(rect) -tag map -fill blue -stipple gray50
	lappend ime(objectset) [list $ime(rect) rect]
	set ime(points,$ime(rect)) [$ime(can) coords $ime(rect)]
	# Lower to just above the image - below eariler shapes.
	$ime(can) raise $ime(rect) $ime(canimg)
	unset ime(rect)
	return 1
    } else {
	return 0
    }
}
proc IME.rectCreate {coords} {
    global ime
    set id [eval {$ime(can) create rect} $coords {-fill green -stipple gray50 -tag map}]
    $ime(can) raise $id $ime(canimg)
    return $id
}
proc IME.rectCoords {item points} {
    global ime
    eval {$ime(can) coords $item} $points
    return $points
}
proc IME.rectCancel {can} {
    global ime
    if [info exists ime(rect)] {
	$can delete $ime(rect)
	unset ime(rect)
    }
}

proc IME.circleStart {can} {
    return
}
proc IME.circleMotion {can x y} {
    global ime
    catch {$ime(can) delete $ime(circle)}

    set dx [expr $x - $ime(x)]
    set dy [expr $y - $ime(y)]
    set r [expr sqrt($dx*$dx + $dy*$dy)]

    set x1 [expr $ime(x)-$r]
    set x2 [expr $ime(x)+$r]
    set y1 [expr $ime(y)-$r]
    set y2 [expr $ime(y)+$r]
    set ime(circle) [$ime(can) create oval $x1 $y1 $x2 $y2 \
	-tag map]
}
proc IME.circleEnd {can x y} {
    global ime
    if [info exists ime(circle)] {
	$ime(can) itemconfig $ime(circle) -tag map -fill blue -stipple gray50
	set points [eval IMErect2polar [$ime(can) coords $ime(circle)]]
	lappend ime(objectset) [list $ime(circle) circle]
	set ime(points,$ime(circle)) $points
	$ime(can) raise $ime(circle) $ime(canimg)
	unset ime(circle)
	return 1
    } else {
	return 0
    }
}
proc IME.circleCancel {can} {
    global ime
    if [info exists ime(circle)] {
	$can delete $ime(circle)
	unset ime(circle)
    }
}
# Map from Tk corner coords to center,edge point
# The atan2 call is to get radians for a 45 degree angle
proc IMErect2polar {x1 y1 x2 y2} {
    set x [expr ($x1+$x2)/2.0]
    set y [expr ($y1+$y2)/2.0]
    set r [expr ($x2-$x)]
    return [list $x $y [expr $x+$r*cos(atan2(1,1))] [expr $y+$r*sin(atan2(1,1))] ]
}
# Map from center,edge points to the Tk corner coords
proc IMEpolar2rect {x1 y1 x2 y2} {
    set dx [expr $x1 - $x2]
    set dy [expr $y1 - $y2]
    set r [expr sqrt($dx*$dx + $dy*$dy)]
    return [list [expr $x1-$r] [expr $y1-$r] [expr $x1+$r] [expr $y1+$r] ]
}
proc IME.circleCreate {points} {
    global ime
    set coords [eval IMEpolar2rect $points]
    set id [eval {$ime(can) create oval} $coords \
	    {-fill green -stipple gray50 -tag map}]
    $ime(can) raise $id $ime(canimg)
    return $id
}
proc IME.circleCoords {item points} {
    global ime
    set coords [eval IMEpolar2rect $points]
    eval {$ime(can) coords $item} $coords
    return $points
}

proc IME.polyStart {can} {
    global ime
    if ![info exists ime(polyset)] {
	set anchor [$can create rect \
	    [expr $ime(x)-3] [expr $ime(y)-3]\
	    [expr $ime(x)+3] [expr $ime(y)+3] -fill white]
	set ime(polyset) [list $anchor $ime(x) $ime(y)]
    }
    return
}
proc IME.polyMotion {can x y} {
    global ime
    catch {$ime(can) delete $ime(line)}
    set ime(line) [$ime(can) create line $ime(x) $ime(y) $x $y -width 2]
}
proc IME.polyEnd {can x y} {
    global ime
    if [info exists ime(line)] {
	lappend ime(polyset) $ime(line) $x $y
	unset ime(line)
	set ime(x) $x
	set ime(y) $y
	if {[llength $ime(polyset)] > 3} {
	    # See if we are close to the first point
	    lassign {z x0 y0} $ime(polyset)
	    if {abs($x-$x0) <=3 && abs($y-$y0) <= 3} {
		IME.polyFinish $can $x $y
		return 1
	    }
	}
    }
    return 0
}
proc IME.polyFinish {can x y} {
    global ime
    set points {}
    catch {$can delete $ime(line) ; unset ime(line)}
    set anchor [lindex $ime(polyset) 0]
    $can delete $anchor
    foreach {cid x y} [lrange $ime(polyset) 3 end] {
	append points " $x $y"
	$ime(can) delete $cid
    }
    catch {
	set cid [eval {$ime(can) create poly} $points \
	    {-fill blue -stipple gray50 -tag map -width 2}]
	lappend ime(objectset) [list $cid poly]
	set ime(points,$cid) $points
	$ime(can) raise $cid $ime(canimg)
    }
    unset ime(polyset)
}
proc IME.polyCreate {coords} {
    global ime
    set id [eval {$ime(can) create poly} $coords {-fill green -stipple gray50 -tag map}]
    $ime(can) raise $id $ime(canimg)
    return $id
}
proc IME.polyCoords {item points} {
    global ime
    eval {$ime(can) coords $item} $points
    return $points
}


proc IME.polyCancel {can} {
    global ime
    catch {$can delete $ime(line)}
    if [info exists ime(polyset)] {
	foreach {cid x y} $ime(polyset) {
	    $ime(can) delete $cid
	}
	unset ime(polyset)
    }
}

proc IME.editStart {can} {
    global ime
    set it [$ime(can) find overlapping \
	[expr $ime(x) -2] [expr $ime(y) -2] [expr $ime(x)+2] [expr $ime(y)+2]]
    catch {unset ime(activepoint)}
    foreach item $it {
	set tag [$ime(can) itemcget $item -tag]
	if [regexp {point=([0-9]+)} $tag x n] {
	    set ime(activepoint) $item
	    set ime(pointindex) $n
	    $ime(can) itemconfig $item -fill red
	    return
	}
    }
}
proc IME.editMotion {can x y} {
    global ime tpoints
    if [info exists ime(activepoint)] {
	set dx [expr $x - $ime(x)]
	set dy [expr $y - $ime(y)]
	$ime(can) move $ime(activepoint) $dx $dy
	set ime(x) [set tpoints($ime(pointindex),x) $x]
	set ime(y) [set tpoints($ime(pointindex),y) $y]
	IMEUpdateCoords $ime(activeshape) $ime(activeitem)
    }
}
proc IME.editEnd {can x y} {
    global ime
    if [info exists ime(activepoint)] {
	$ime(can) itemconfig $ime(activepoint) -fill white
	unset ime(activepoint)
    }
    return 1
}
proc IME.editCancel {can} {
    return
}
proc IME_ShowPoints {item points} {
    global ime
    set i 1
    foreach {x y} $points {
	$ime(can) create rect [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
	    -tag "point=$i point" -fill white
	incr i
    }
    set ime(lastshape) $ime(shape)
    set ime(shape) edit
}
proc IME_HidePoints {item} {
    global ime
    $ime(can) delete point
    set ime(shape) $ime(lastshape)
}

proc IME_Raise {} {
    global ime
    if [info exists ime(activeitem)] {
	# Move up to just below the control points
	$ime(can) lower $ime(activeitem) point
    }
}
proc IME_Lower {} {
    global ime
    if [info exists ime(activeitem)] {
	# Move down to just above the image
	$ime(can) raise $ime(activeitem) $ime(canimg)
    }
}

proc IME_Quit {{toplevel .}} {
    global ime
    if [IMEDirty] {
	DialogConfirm $ime(toplevel) .dirty "Save changes to current map?" \
	    IME_Save { } "Save & Exit" "Exit w/out Saving"
    }
    if {$toplevel == "."} {
	exit
    } else {
	catch {destroy .imeconfig}
	catch {destroy .imeurledit}
	catch {destroy .imedialog}
	destroy $toplevel
    }
}
proc IME_Message {string} {
    global ime
    set ime(status) $string
    update idletasks
}
# For browser.tcl
proc LogUser {string} {
    IME_Message $string
}

