#!/bin/sh
# Mapster: a graphical tool for creating client-side imagemaps for Web pages
# Copyright (c) 1998  Matthew C. Gushee
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.

#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.

#  You should have received a copy of the GNU General Public License
#  along with this program; see the file COPYING.  If not, write to
#  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.

# please send comments, praise, bug reports to mgushee@geocities.com

#\
exec wish "$0" "$@"

proc init {} {
    global config mapInfo

    # don't even think about changing this
    set config(version) "0.1"

    # directory for toolbar bitmaps and the config file (if any)
    set config(mapster) "/usr/local/mapster-0.1/lib"

    # command to convert files to GIF format
    # default is the 'convert' program, part of the ImageMagick suite
    set config(converter) "convert"

    # location for saving image map files and temporary GIFs
    # make sure you have write permission for this directory
    set config(tempdir) "/tmp"

    # set this to 0 if you don't want to be prompted for a name every time
    # you create an area on the map
    set config(aname) 1

    # colors
    set config(light) white
    set config(light-act) orange
    set config(light-bg) white
    set config(dark) black
    set config(dark-act) blue
    set config(dark-bg) black
    # set to 'dark' or 'light'
    set config(colordefault) dark

    #probably not a good idea to change this
    set mapInfo(colordefault) $config(colordefault)
}

proc main {} {
    global config toolInfo mapInfo

    # create images for toolbar buttons
    image create bitmap rect -file [file join $config(mapster) "rectangl.xbm"]
    image create bitmap circ -file [file join $config(mapster) "circle.xbm"]
    image create bitmap poly -file [file join $config(mapster) "polygon.xbm"]
    image create bitmap mvobj -file [file join $config(mapster) "mvobj.xbm"]
    image create bitmap iload -file [file join $config(mapster) "load.xbm"]
    image create bitmap msave -file [file join $config(mapster) "save.xbm"]
    image create bitmap adelete -file [file join $config(mapster) "delete.xbm"]
    image create bitmap posneg -file [file join $config(mapster) "posneg.xbm"]
    image create bitmap qexit -file [file join $config(mapster) "exit.xbm"]

    ## set up the toolbar ====================
    # first the toolbar frame and the selectable tools
    # add the tag 'ToolButton' to each button
    pack [frame .tbar] -side left -fill y -padx 1 -pady 3
    foreach tool {rect circ poly adelete mvobj posneg} {
	pack [label .tbar.$tool -image $tool -relief raised -borderwidth 1] \
	    -side top -padx 1 -pady 1
	bindtags .tbar.$tool {ToolButton [bindtags .tbar.$tool]}
    }

    # a separator
    pack [frame .tbar.sep -height 12] -side top

    # buttons that perform operations
    pack [button .tbar.iload -image iload -borderwidth 1 -command \
	     image_load -highlightthickness 0] -side top -padx 1 -pady 1
    pack [button .tbar.msave -image msave -borderwidth 1 -command \
	      {map_save .disp.c} -highlightthickness 0] \
	-side top -padx 1 -pady 1
    pack [button .tbar.qexit -image qexit -borderwidth 1 -command \
	     query_exit -highlightthickness 0] -side top -padx 1 -pady 1

    # set up the display area
    pack [frame .disp] -side left -expand yes -fill both
    canvas .disp.c -background black -yscrollcommand {.disp.ybar set} \
	-xscrollcommand {.disp.xbar set}
    scrollbar .disp.ybar -orient vertical -width 14 -borderwidth 1 \
	-command {.disp.c yview}
    scrollbar .disp.xbar -orient horizontal -width 14 -borderwidth 1 \
	-command {.disp.c xview}
    grid .disp.c -row 0 -column 0 -sticky nsew
    grid .disp.ybar -row 0 -column 1 -sticky ns
    grid .disp.xbar -row 1 -column 0 -sticky ew
    grid columnconfigure .disp 0 -weight 1
    grid rowconfigure .disp 0 -weight 1

    # set up mouse bindings
    bind ToolButton <Enter> {%W configure -background "#ececec"}
    bind ToolButton <Leave> {%W configure -background "#d9d9d9"}
    bind ToolButton <ButtonPress-1> {tool_select .disp.c %W}
    .disp.c bind mapobj <Enter> {obj_activate .disp.c}
    .disp.c bind mapobj <Leave> {obj_deactivate .disp.c}

    # rectangle tool is initially selected
    tool_select .disp.c .tbar.rect

    set MapInfo(modified) 0
}

proc tool_select {window tool} {
    global toolInfo

    if {[info exists toolInfo(selected)]} {
	if {$toolInfo(selected) == $tool} {
	    return
	} else {
	    $toolInfo(selected) configure -relief raised
	}
    }

    set toolInfo(selected) "$tool"
    $tool configure -relief sunken

    switch -- $tool {
	.tbar.rect {
	    $window bind mapimage <ButtonPress-1> {rect_start %x %y}
	    $window bind mapimage <B1-Motion> {rect_draw .disp.c %x %y}
	    $window bind mapimage <ButtonRelease-1> {rect_set .disp.c}
	    $window bind mapimage <ButtonPress-3> {}
	    $window bind mapimage <Double-ButtonPress-1> {}
	    $window bind mapobj <ButtonPress-1> {}
	    $window bind mapobj <B1-Motion> {}
	    $window bind mapobj <ButtonRelease-1> {}
	    $window bind newobj <Double-ButtonPress-1> {}
	    bind .disp.c <ButtonPress-1> {}
	}
	.tbar.circ {
	    $window bind mapimage <ButtonPress-1> {circle_start %x %y}
	    $window bind mapimage <B1-Motion> {circle_draw .disp.c %x %y}
	    $window bind mapimage <ButtonRelease-1> {circle_set .disp.c}
	    $window bind mapimage <ButtonPress-3> {}
	    $window bind mapimage <Double-ButtonPress-1> {}
	    $window bind mapobj <ButtonPress-1> {}
	    $window bind mapobj <B1-Motion> {}
	    $window bind mapobj <ButtonRelease-1> {}
	    $window bind newobj <Double-ButtonPress-1> {}
	    bind .disp.c <ButtonPress-1> {}
	}
	.tbar.poly {
	    $window bind mapimage <ButtonPress-1> {polygon_start_or_draw .disp.c %x %y}
	    $window bind mapimage <B1-Motion> {polygon_draw .disp.c %x %y}
	    $window bind mapimage <ButtonRelease-1> {polygon_set_point .disp.c %x %y}
	    $window bind mapimage <ButtonPress-3> {polygon_cancel_point .disp.c}
	    $window bind mapimage <Double-ButtonPress-1> {polygon_set .disp.c}
	    $window bind mapobj <ButtonPress-1> {}
	    $window bind mapobj <B1-Motion> {}
	    $window bind mapobj <ButtonRelease-1> {}
	    $window bind newobj <Double-ButtonPress-1> {polygon_set .disp.c}
	    bind .disp.c <ButtonPress-1> {}
	}
	.tbar.adelete {
	    $window bind mapobj <ButtonPress-1> {obj_delete .disp.c}
	    $window bind mapobj <B1-Motion> {}
	    $window bind mapobj <ButtonRelease-1> {}
	    $window bind mapimage <B1-Motion> {}
	    $window bind mapimage <ButtonRelease-1> {}
	    $window bind mapimage <ButtonPress-3> {}
	    $window bind mapimage <Double-ButtonPress-1> {}
	    $window bind newobj <Double-ButtonPress-1> {}
	    bind .disp.c <ButtonPress-1> {}
	}
	.tbar.mvobj {
	    $window bind mapobj <ButtonPress-1> {obj_move_start %x %y}
	    $window bind mapobj <B1-Motion> {obj_move .disp.c %x %y}
	    $window bind mapobj <ButtonRelease-1> {obj_move_end}
	    $window bind mapimage <ButtonPress-1> {}
	    $window bind mapimage <B1-Motion> {}
	    $window bind mapimage <ButtonRelease-1> {}
	    $window bind mapimage <ButtonPress-3> {}
	    $window bind mapimage <Double-ButtonPress-1> {}
	    $window bind newobj <Double-ButtonPress-1> {}
	    bind .disp.c <ButtonPress-1> {}
	}
	.tbar.posneg {
	    bind .disp.c <ButtonPress-1> {pos_neg_toggle .disp.c}
	    $window bind mapobj <ButtonPress-1> {}
	    $window bind mapobj <B1-Motion> {}
	    $window bind mapobj <ButtonRelease-1> {}
	    $window bind mapimage <ButtonPress-1> {}
	    $window bind mapimage <B1-Motion> {}
	    $window bind mapimage <ButtonRelease-1> {}
	    $window bind mapimage <ButtonPress-3> {}
	    $window bind mapimage <Double-ButtonPress-1> {}
	    $window bind newobj <Double-ButtonPress-1> {}
	}
	default {
	    $window bind mapimage <ButtonPress-1> {}
	    $window bind mapimage <B1-Motion> {}
	    $window bind mapimage <ButtonRelease-1> {}
	    $window bind mapimage <ButtonPress-3> {}
	    $window bind mapimage <Double-ButtonPress-1> {}
	    $window bind mapobj <ButtonPress-1> {}
	    $window bind mapobj <B1-Motion> {}
	    $window bind mapobj <ButtonRelease-1> {}
	    $window bind newobj <Double-ButtonPress-1> {}
	    bind .disp.c <ButtonPress-1> {}
	}
    }
}

##################################################
####  FILE  HANDLING  ###########################
##################################################

proc image_load {} {
    global mapInfo config

    set imgfile [tk_getOpenFile -filetypes \
		     {"GIF {.gif}" "JPEG {.jpg .jpeg .jpe .pjpeg .jfif}" \
			  "PNG {.png}" "TIFF {.tif .tiff}"}]
    if {$imgfile == ""} {
	return
    }
    set basename [file rootname [file tail $imgfile]]
    set mapInfo(basename) $basename
    if {![string match *gif $imgfile] && ![string match *GIF $imgfile]} {
	set newfile [file join $config(tempdir) "$basename.gif"]
	exec $config(converter) $imgfile $newfile
	set imgfile $newfile
    }

    .disp.c delete mapimage
    # maybe this should be put into a variable and done generically
    image create photo MapImage -file $imgfile
    set dispwidth [expr {[image width MapImage] + 8}]
    set mapheight [image height MapImage]
    # don't want this number hard coded ... have to figure out how to
    # get the height of the toolbar
    if {$mapheight < 202} {
	set dispheight 210
    } else {
	set dispheight [expr {$mapheight + 8}]
    }
    set xctr [expr {$dispwidth/2}]
    set yctr [expr {$dispheight/2}]

    .disp.c configure -width $dispwidth -height $dispheight

    .disp.c create image $xctr $yctr -anchor center \
	-image MapImage -tags mapimage

    set mapInfo(imgcoords) [.disp.c bbox mapimage]

    set mapInfo(modified) 0
}

proc map_save {win} {
    global mapInfo config

    set mapname [get_string "Image Map Name" \
		   "Enter a name for your image map.\nThis will be the name that appears\nin the HTML <map> tag. Press Cancel\nto save the map with no name."]
    set outputlist \
	{"<!-- Image map generated by mapster v. $config(version) -->" \
	     "<map name=\"$mapname\">"}
    
    foreach objID $mapInfo(objects) {
	set type [$win type $objID]
	switch -- $type {
	    rectangle {
		set type rect
	    }
	    polygon {
		set type poly
	    }
	    oval {
		set type circle
	    }
	}
	set coords ""
	set xdelta [lindex $mapInfo(imgcoords) 0]
	set ydelta [lindex $mapInfo(imgcoords) 1]
	foreach {xval yval} [$win coords $objID] {
	    if {$coords != ""} {
		append coords ","
	    }
	    append coords [expr round($xval) - $xdelta]
	    append coords ","
	    append coords [expr round($yval) - $ydelta]
	}
	set alttext $mapInfo(aname-$objID)
	lappend outputlist \
	    "<area shape=\"$type\" coords=\"$coords\" alt=\"$alttext\">"
    }
    
    set mapfile [file join $config(tempdir) "$mapInfo(basename).map"]
    if {[catch {set outfile [open $mapfile "w"]}] != 0} {
	error "Unable to save file!\nYou should make sure you have write permission\nfor $config(tempdir). If that's not the problem,\nyou may have found a bug."
    }
    foreach element $outputlist {
	puts $outfile $element
    }
    puts $outfile "</map>"
    close $outfile
    set mapInfo(modified) 0
}


proc pos_neg_toggle {win} {
    global config mapInfo
    set objID [$win find withtag current]
    set taglist [$win gettags $objID]
    if {[lsearch $taglist mapobj] >= 0} {
	if {$mapInfo(color-$objID) == "dark"} {
	    set mapInfo(color-$objID) "light"
	    $win itemconfigure current -fill $config(light-act) \
		-outline $config(light-act)
	} else {
	    set mapInfo(color-$objID) "dark"
	    $win itemconfigure current -fill $config(dark-act) \
		-outline $config(dark-act)
	}
    } else {
	if {$mapInfo(colordefault) == "dark"} {
	    set mapInfo(colordefault) "light"
	    $win configure -background $config(light-bg)
	} else {
	    set mapInfo(colordefault) "dark"
	    $win configure -background $config(dark-bg)
	}
    }
}
	    

proc area_delete {} {
    global mapInfo
    set mapInfo(modified) 1
}

proc query_exit {} {
    global mapInfo

    if {$mapInfo(modified)} {
	return
    } else {
	exit
    }
}

proc get_string {wintitle msg1 {msg2 ""}} {
    global result
    toplevel .getstring
    pack [frame .getstring.main] -side top -expand yes \
	-fill both -padx 4 -pady 4
    pack [frame .getstring.controls] -side top -expand yes -fill x
    pack [label .getstring.main.msg1 -text $msg1] -side top \
	-padx 8 -pady 4
    pack [entry .getstring.main.enter -borderwidth 1] \
	-side top -padx 16 -pady 4 -fill x
    if {$msg2 != ""} {
	pack [label .getstring.main.msg2 -text $msg2] -side top \
	    -padx 8 -pady 4
    }
    set okbttn \
	[button .getstring.controls.ok -text "OK" -borderwidth 1 \
 	     -command {
 		 set result [.getstring.main.enter get]
 	     }
	 ]
    set cancelbttn \
	[button .getstring.controls.cancel -text "Cancel" -borderwidth 1 \
	     -command {
		 set result ""
	     }
	 ]
    pack $cancelbttn -side right -padx 28 -pady 4
    pack $okbttn -side left -padx 28 -pady 4
    wm title .getstring $wintitle
    bind .getstring <KeyPress-Return> {.getstring.controls.ok invoke}
    bind .getstring <KeyPress-Escape> {.getstring.controls.cancel invoke}
    bind .getstring <ButtonPress> {
	wm deiconify .getstring
	raise .getstring
    }
    wm protocol .getstring WM_DELETE_WINDOW ".getstring.controls.cancel invoke"
    focus .getstring.main.enter
    raise .getstring
    grab set .getstring
    vwait result
    grab release .getstring
    destroy .getstring
    return $result
}
    

######################################################
######   MANIPULATING OBJECTS   ##########################
######################################################

proc obj_set_aname {objID} {
    global mapInfo
    set mapInfo(aname-$objID) \
	[get_string "Area Name" \
	     "Enter a brief descriptive name for this area:" \
	     "This will be the alternate text for the HTML <area> tag."]
}

proc obj_activate {win} {
    global mapInfo config

    set objID [$win find withtag current]
    if {$mapInfo(color-$objID) == "dark"} {
	$win itemconfigure $objID -fill $config(dark-act) \
	    -outline $config(dark-act)
    } else {
	$win itemconfigure $objID -fill $config(light-act) \
	    -outline $config(light-act)
    }
#    $win addtag $objID active
    $win addtag active withtag current
}

proc obj_deactivate {win} {
    global mapInfo config

    set objID [$win find withtag current]
    if {$mapInfo(color-$objID) == "dark"} {
	$win itemconfigure $objID -fill $config(dark) \
	    -outline $config(dark)
    } else {
	$win itemconfigure $objID -fill $config(light) \
	    -outline $config(light)
    }
    $win dtag $objID active
}

proc obj_delete {win} {
    global mapInfo
    if {[info exists mapInfo(objects)]} {
	set objID [$win find withtag current]
	set pos [lsearch $mapInfo(objects) $objID]
	if {$pos >= 0} {
	    set mapInfo(objects) [lreplace $mapInfo(objects) $pos $pos]
	    $win delete current
	}
    }
    set mapInfo(modified) 1
}

proc obj_move_start {x y} {
    global prevx prevy
    set prevx $x
    set prevy $y
}

proc obj_move {win x y} {
    global prevx prevy
    set xmove [expr {$x - $prevx}]
    set ymove [expr {$y - $prevy}]
    $win move current $xmove $ymove
    set prevx $x
    set prevy $y
}

proc obj_move_end {} {
    global prevx prevy
    unset prevx prevy
    set mapInfo(modified) 1
}

######################################################
######   DRAWING FUNCTIONS  #############################
######################################################

proc circle_start {x y} {
    global center
    set center [list $x $y]
}

proc circle_draw {win x y} {
    global mapInfo center config

    set colorspec $mapInfo(colordefault)
    set color $config($colorspec-act)

    set x0 [lindex $center 0]
    set y0 [lindex $center 1]
    set xlen [expr {$x - $x0}]
    set ylen [expr {$y - $y0}]
    set radius [expr {hypot($xlen,$ylen)}]

    set x1 [expr {$x0 - $radius}]
    set y1 [expr {$y0 - $radius}]
    set x2 [expr {$x0 + $radius}]
    set y2 [expr {$y0 + $radius}]

    $win delete newobj
    $win create oval $x1 $y1 $x2 $y2 -outline $color -tags newobj
}

proc circle_set {win} {
    global config mapInfo

    set colorspec $mapInfo(colordefault)
    set color $config($colorspec-act)

    set objID [$win find withtag newobj]
    lappend mapInfo(objects) $objID
    set mapInfo(color-$objID) $colorspec

    $win itemconfigure newobj -fill $color -stipple gray25
    $win addtag mapobj withtag newobj
    $win dtag newobj

    set mapInfo(modified) 1

    if {$config(aname)} {
	obj_set_aname $objID
    }
}

 proc polygon_start_or_draw {win x y} {
     global coords waiting firstpoint

     if {[info exists coords]} {
     } else {
 	set coords [list $x $y]
	 set firstpoint 1
     }
 }

 proc polygon_draw {win x y} {
     global mapInfo coords config firstpoint

     if {[info exists firstpoint]} {
	 unset firstpoint
     }

    set colorspec $mapInfo(colordefault)
    set color $config($colorspec-act)

     set len [llength $coords]
     set prevx [lindex $coords [expr {$len - 2}]]
     set prevy [lindex $coords [expr {$len - 1}]]
    
     $win delete templine
     $win dtag newline
     $win create line $prevx $prevy $x $y -fill $color -tags templine
     
 }

 proc polygon_set_point {win x y} {
     global mapInfo coords config firstpoint

     if {[info exists firstpoint]} {
	 unset firstpoint
     } else {

	 set colorspec $mapInfo(colordefault)
	 set color $config($colorspec-act)
	 
	 if {[info exists coords]} {
	     set len [llength $coords]
	     set prevx [lindex $coords [expr {$len - 2}]]
	     set prevy [lindex $coords [expr {$len - 1}]]
	     
	     set coords [lappend coords $x $y]
	     
	     $win delete templine
	     $win create line $prevx $prevy $x $y -fill $color \
		 -tags {newline newobj}
	 }
     }
 }

 proc polygon_cancel_point {win} {
     global coords
     if {[info exists coords]} {
 	set coords [lreplace [lreplace $coords end end] end end]
 	$win delete newline
     }
 }

 proc polygon_set {win} {
     global coords waiting config mapInfo

     if {[info exists waiting]} {
	 after cancel $waiting
     }

     if {[info exists coords]} {
	 set colorspec $mapInfo(colordefault)
	 set color $config($colorspec-act)
 	$win delete newobj
	 set objID [eval $win create polygon $coords -outline $color \
			-fill $color -stipple gray25 -tags mapobj]
	 lappend mapInfo(objects) $objID
	 set mapInfo(color-$objID) $colorspec
 	unset coords
     }
    set mapInfo(modified) 1
    
     if {$config(aname)} {
	obj_set_aname $objID
    }
 }

proc rect_start {x y} {
    global startpoint
    set startpoint [list $x $y]
}   

proc rect_draw {win x y} {
    global mapInfo startpoint config
    set colorspec $mapInfo(colordefault)
    set color $config($colorspec-act)
    foreach {startx starty} $startpoint {}
    $win delete newobj
    $win create rectangle $startx $starty $x $y -outline $color -tags newobj
}

proc rect_set {win} {
    global mapInfo config mapInfo
    set colorspec $mapInfo(colordefault)
    set color $config($colorspec-act)

    set objID  [$win find withtag newobj]
    lappend mapInfo(objects) $objID
    set mapInfo(color-$objID) $colorspec

    $win addtag mapobj withtag newobj
    $win itemconfigure newobj -fill $color -stipple gray25
    $win dtag newobj

    set mapInfo(modified) 1

    if {$config(aname)} {
	obj_set_aname $objID
    }
}


######################################################

init
main

# Local variables:
# eval: (tcl-mode)
# end: