#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
#  Copyright (c) 2001 Miguel Filgueiras (mig@ncc.up.pt) / Universidade do Porto
#
#    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.
#
#  File: map.tcl
#  Last change:  14 November 2001
#
# Includes contributions by Brian Baulch (baulchb@onthenet.com.au)
#  marked "BSB contribution"

## tags used:
#    waypoints: WP WP=$name forWP=$ix lab=$name sq2
#               possibly: inRT=$RTix inRT=:$number
#    labels of WP: WP WPn forWP=$ix lab=$name txt
#               possibly: inRT=$RTix inRT=:$number
#    symbols of WP: WP WPsy lab=$name syforWP=$ix
#    menubuttons assoc to WP: menuWP=$ix lab=$name
#    lines of RSs (RT stages):
#               RT forRT=$ix from=$itWP to=$itWP stno=$number (>=0) line
#    labels of RSs: RT forRT=$ix lab
#    trackpoints: TR forTR=$ix inTR=$ix lab=$ix-$number sq2
#               on first point: TRfirst TR=$ix
#    labels of TP: TR forTR=$ix inTR=$ix lab=$ix-$number txt
#    lines in TRs: TR forTR=$ix line
#    for animation:
#      - points: sq2 an=$no
#        possibly: lastfor=$no
#      - lines: line an=$no
#      - blinking image: lab an=$no anblink=$no
#    when saving map: temp
#    for RT under definition:    mkRT
#      - line from WP to cursor: mkRTfrom mkRTfrline mkRTtrans
#      - point under cursor: mkRTfrom mkRTcursor mkRTtrans
#      - line from cursor to WP (when editing RS): mkRTtoline mkRTtrans
#      - stage: mkRTedge from=$itWP to=$itWP stno=$number line
#    background images: mapimage forIm=$dx,$dy
#    when loading background image ($n in {1, 2}):
#      - WP name to place when geo-referencing map: mapfix mapfixname
#      - name of 3rd WP when adjusting map: mapfix mapfixthird
#      - temporary lines when fixing map: mapfix mapfixline=$n
#      - lines when adjusting map: mapadjust mapfixline=$n
#      - temporary points when adjusting map: mapfix mappoint=$n
##

### general bindings
#     other bindings are set in procs:
#      MapCreateWP, PutMapRTWPRS, PutMapTREls, MapStartRTEdit

proc SetMapBindings {} {
    # set cursor and initial bindings for map items and perform other
    #  initializations
    # a logo or "dummy" text is created for this purpose and then destroyed
    global Map Logo MAPTYPES MAPW2 MAPH2

    $Map configure -cursor crosshair
    bind $Map <Enter> "focus $Map ; MapCursor"
    bind $Map <Leave> { focus . ; UnMapCursor }
    bind $Map <Motion> { MapCursorMotion %x %y }
    # scrolling in N-S, E-W
    bind $Map <Key-Up> { ScrollMap y scroll -1 units ; MapCursorUpdate }
    bind $Map <Key-Delete> { ScrollMap y scroll -1 pages ; MapCursorUpdate }
    bind $Map <Key-space> { ScrollMap y scroll 1 pages ; MapCursorUpdate }
    bind $Map <Key-Down> { ScrollMap y scroll 1 units ; MapCursorUpdate }
    bind $Map <Key-Left> { ScrollMap x scroll -1 units ; MapCursorUpdate }
    bind $Map <Key-Right> { ScrollMap x scroll 1 units ; MapCursorUpdate }
    # scrolling in NE-SW, NW-SE
    bind $Map <Shift-Up> { ScrollMap y scroll -1 units
       ScrollMap x scroll 1 units ; MapCursorUpdate }
    bind $Map <Shift-Down> { ScrollMap y scroll 1 units
       ScrollMap x scroll -1 units ; MapCursorUpdate }
    bind $Map <Shift-Right> { ScrollMap y scroll -1 units
       ScrollMap x scroll -1 units ; MapCursorUpdate }
    bind $Map <Shift-Left> { ScrollMap y scroll 1 units
       ScrollMap x scroll 1 units ; MapCursorUpdate }
    # panning
    bind $Map <Button-2> "$Map scan mark %x %y"
    bind $Map <B2-Motion> "$Map scan dragto %x %y ; SetVisibleOrigin x ; \
	    SetVisibleOrigin y ; MapCursorUpdate"
    # BSB contribution: wheelmouse scrolling
    bind $Map <Button-5> { ScrollMap y scroll 25 units ; MapCursorUpdate }
    bind $Map <Button-4> { ScrollMap y scroll -25 units ; MapCursorUpdate }
    bind $Map <Shift-Button-5> { ScrollMap y scroll 1 pages
	MapCursorUpdate }
    bind $Map <Shift-Button-4> { ScrollMap y scroll -1 pages
	MapCursorUpdate }
    bind $Map <Control-Button-5> { ScrollMap x scroll 1 pages
	MapCursorUpdate }
    bind $Map <Control-Button-4> { ScrollMap x scroll -1 pages
	MapCursorUpdate }
    bind $Map <Alt-Button-5> { ScrollMap x scroll 25 units
	MapCursorUpdate }
    bind $Map <Alt-Button-4> { ScrollMap x scroll -25 units
	MapCursorUpdate }

    set ts [linsert $MAPTYPES 0 dummy]
    if { "$Logo" != "" } {
	$Map create image $MAPW2 $MAPH2 -image $Logo -anchor center -tags $ts
    } else { $Map create text 0 0 -tags $ts }
    foreach m $MAPTYPES {
	$Map bind $m <Enter> { HighLight }
	$Map bind $m <Leave> { LowLight }
    }
    after 5000 "$Map delete dummy"
    bind $Map <Button-1> { MarkMapPoint %x %y }
    bind $Map <Button-3> StopMapWPMoving
    # BSB contribution
    bind $Map <Return> { MarkMapPoint %x %y }
    return
}

proc MarkMapPoint {x y} {
    # mark point on map if map is not void
    global Map MapEmpty MapWPMoving MapMakingRT MapScale MapLoading \
	    MapLoadWPs MapLoadWPNs MapLoadPos MapLoadWait MapPFormat OVx OVy \
	    CRHAIRx CRHAIRy EdWindow Datum CREATIONDATE MESS \
	    DEFAULTSYMBOL DEFAULTDISPOPT

    set xx [expr $OVx+$x-$CRHAIRx] ; set yy [expr $OVy+$y-$CRHAIRy]
    switch -glob $MapLoading {
	0 {
	    if { ! $MapEmpty } {
		if { $MapWPMoving != -1 } {
		    MapMoveWP $x $y [MapToPosn $xx $yy $MapPFormat]
		    return
		} elseif { ! $MapMakingRT } {
		    set os [$Map find overlapping $xx $yy [expr $xx+10] \
			    [expr $yy+10]]
		    if { "$os" == "" || [OverBackImage $os] } {
			if { [winfo exists $EdWindow(WP)] } { bell ; return }
			set p [MapToPosn $xx $yy $MapPFormat]
			if { "[PosType $MapPFormat]" == "grid" && \
				"[lindex $p 2]" == "--" } {
			    set pfmt UTM/UPS
			    set p [MapToPosn $xx $yy UTM/UPS]
			} else { set pfmt $MapPFormat }
			set opts [list create revert cancel]
			if { $CREATIONDATE } {
			    GMWPoint -1 $opts \
				    [FormData WP "PFrmt Posn Datum Date" \
				    [list $pfmt $p $Datum [Now]]]
			} else {
			    GMWPoint -1 $opts \
				   [FormData WP "Commt PFrmt Posn Datum" \
				   [list [DateCommt [Now]] $pfmt $p $Datum]]
			}
		    }
		}
	    }
	} 
	NoRot=3 {
	    set MapLoadPos(origin,x) $xx ; set MapLoadPos(origin,y) $yy
	    MapCreateWP $xx $yy [lindex $MapLoadWPs 0] [lindex $MapLoadWPNs 0]
	    # get line to 3rd WP and then to 2nd WP
	    foreach a "2 1" {
		set it [$Map find withtag mapfixline=$a]
		$Map dtag $it mapfix ; $Map addtag mapadjust withtag $it
	    }
	    # $it is line to 2nd WP
	    set cs [$Map coords $it]
	    set xl0 [lindex $cs 0] ; set yl0 [lindex $cs 1]
	    set xl1 [lindex $cs 2] ; set yl1 [lindex $cs 2]
	    if { "$MapLoadPos(dir,1)" == "x" } {
		set MapLoadPos(line) [lsort -real "$xl0 $xl1"]
	    } else {
		set MapLoadPos(line) [lsort -real "$yl0 $yl1"]
	    }
	    set MapLoading NoRot=end ; set MapLoadWait 0 ; set MapScale 1e6
	    $Map delete mapfix
	    MapCursor
	}
	NoRot=end {
	    if { $MapLoadPos(scale) > 1e5 } {
		bell
	    } else {
		set MapLoadWait 1
		foreach a "1 2" {
		    set ix [lindex $MapLoadWPs $a]
		    $Map delete forWP=$ix syforWP=$ix
		    eval MapCreateWP $MapLoadPos(adj,$a) $ix \
			    {[lindex $MapLoadWPNs $a]}
		}
		set MapScale $MapLoadPos(scale)
		set MapLoadWait 0
		.wmapload.fr.bns.ok configure -state normal
	    }
	}
	Affine*=[1-3] {
	    # type of transformation and number of points to be placed
	    regexp Affine(.*)=(.*) $MapLoading z tp n
	    incr n -1
	    set MapLoadPos($n,x) $xx ; set MapLoadPos($n,y) $yy
	    MapCreateWP $xx $yy [lindex $MapLoadWPs $n] \
		    [lindex $MapLoadWPNs $n]
	    set MapLoading Affine${tp}=$n
	    $Map delete mapfixname
	    MapCursor
	    if { $n == 0 } {
		.wmapload.fr.bns.ok configure -state normal
	    }
	    # continuation to either MapLoadBkDialDone or MapLoadBkDialCancel
	}
    }
    return
}

proc MapCursor {} {
    # start following pointer on map if map is not void
    global Map MapEmpty MapMakingRT MapRTCurrent MapLoading MapLoadWPNs \
	    MapLoadPos MAPCOLOUR MapEditingRS MapRTNext

    switch -glob $MapLoading {
	Affine*=[1-3] {
	    $Map delete mapfix
	    regsub .*= $MapLoading "" n
	    incr n -1
	    $Map create text 100 100 -fill $MAPCOLOUR(mapsel) -anchor sw \
		    -text [lindex $MapLoadWPNs $n] -justify left \
		    -tags [list map mapfix mapfixname]
	}
	NoRot=3 {
	    $Map delete mapfix
	    foreach a "1 2" {
		set ts [list map mapfix mapfixline=$a]
		eval $Map create line $MapLoadPos(pos,$a) \
			-fill $MAPCOLOUR(mapsel) -width 2 -tags {$ts}
	    }
	    $Map create text 100 100 -fill $MAPCOLOUR(mapsel) -anchor sw \
		    -text [lindex $MapLoadWPNs 0] -justify left \
		    -tags [list map mapfix mapfixname]
	}
	NoRot=end {
	    $Map delete mapfix
	    # create two circles for 2nd and 3rd WPs
	    foreach a "1 2" {
		$Map create oval 100 100 105 105 -fill $MAPCOLOUR(mapsel) \
			-tags [list mapfix mappoint=$a]
	    }
	    $Map create text 100 100 -fill $MAPCOLOUR(mapsel) -anchor sw \
		    -text [lindex $MapLoadWPNs 2] -justify center \
		    -tags [list map mapfix mapfixthird]
	    $Map create text 100 100 -fill $MAPCOLOUR(mapsel) -anchor sw \
		    -text [lindex $MapLoadWPNs 1] -justify left \
		    -tags [list map mapfix mapfixname]
	}
	0 {
	    if { ! $MapEmpty && $MapMakingRT } {
		if { $MapEditingRS } {
		    set x [lindex $MapRTNext 0]
		    set y [lindex $MapRTNext 1]
		    $Map create line $x $y $x $y -fill $MAPCOLOUR(mkRT) \
			    -arrow first -smooth 0 -width 2 \
			    -tags [list mkRT mkRTtoline mkRTtrans]
		}
		set x [lindex $MapRTCurrent 0] ; set y [lindex $MapRTCurrent 1]
		$Map create line $x $y $x $y -fill $MAPCOLOUR(mkRT) \
			-arrow first -smooth 0 -width 2 \
			-tags [list mkRT mkRTfrom mkRTfrline mkRTtrans]
		$Map create oval [expr $x-3] [expr $y-3] \
			[expr $x+3] [expr $y+3] -fill $MAPCOLOUR(mkRT) \
			-tags [list mkRT mkRTfrom mkRTcursor mkRTtrans]
	    }
	}
    }
    return
}

proc UnMapCursor {} {
    # stop following pointer on map if map is not void
    global Map MapEmpty MapMakingRT MapLoading XCoord YCoord CursorPos

    switch -glob $MapLoading {
	Affine*=* -
	NoRot=* {
	    $Map delete mapfix
	    if { [winfo exists .wmapload] } { Raise .wmapload }
	}
	0 {
	    if { ! $MapEmpty } {
		catch "unset CursorPos"
		set XCoord "" ; set YCoord ""
		if { $MapMakingRT } {
		    $Map delete mkRTtrans
		    if { [winfo exists .gmRT] } { Raise .gmRT }
		}
	    }
	}
    }
    return
}

proc MapCursorMotion {x y} {
    # compute coordinates of pointer on map if map is not void
    global Map MapEmpty MapScale OVx OVy CursorPos MapMakingRT MapRTCurrent \
	    MapLoading MapLoadPos MapLoadWait MapWPMoving CRHAIRx CRHAIRy \
	    MapEditingRS MapRTNext

    set CursorPos [list $x $y]
    set xx [expr $OVx+$x-$CRHAIRx] ; set yy [expr $OVy+$y-$CRHAIRy]
    switch -glob $MapLoading {
	Affine*=[1-3] {
	    # move name of WP to be placed
	    $Map coords mapfixname $xx $yy
	}
	NoRot=3 {
	    # move name of 1st WP and lines to the other two WPs
	    $Map coords mapfixname $xx $yy
	    foreach a "1 2" {
		$Map coords mapfixline=$a $xx $yy \
		    [expr $xx+$MapLoadPos(dx,$a)] [expr $yy+$MapLoadPos(dy,$a)]
	    }
	}
	NoRot=end {
	    if { $MapLoadWait } { return }
	    # move names and positions of 2nd and 3rd WPs
	    # move 2nd on its line; then place 3rd according to scale
	    set min [lindex $MapLoadPos(line) 0]
	    set max [lindex $MapLoadPos(line) 1]
	    if { "$MapLoadPos(dir,1)" == "x" } {
		if { $xx < $min } {
		    set xx $min
		} elseif { $xx > $max } {
		    set xx $max
		}
		set yy [expr $MapLoadPos(origin,y)+($xx-$MapLoadPos(origin,x))\
			*$MapLoadPos(dy,1)*1.0/$MapLoadPos(dx,1)]
	    } else {
		if { $yy < $min } {
		    set yy $min
		} elseif { $yy > $max } {
		    set yy $max
		}
		set xx [expr $MapLoadPos(origin,x)+($yy-$MapLoadPos(origin,y))\
			*$MapLoadPos(dx,1)*1.0/$MapLoadPos(dy,1)]
	    }
	    $Map coords mappoint=1 [expr $xx-3] [expr $yy-3] \
		    [expr $xx+3] [expr $yy+3]
	    $Map coords mapfixname $xx [expr $yy-8]
	    # compute scale (m/pixel)
	    if { [set dpx [expr $xx-$MapLoadPos(origin,x)]] != 0 } {
		set sc [expr $MapLoadPos(dmx,1)*1.0/$dpx]
	    } elseif { [set dpy [expr $yy-$MapLoadPos(origin,y)]] != 0 } {
		set sc [expr $MapLoadPos(dmy,1)*1.0/$dpy]
	    } else {
		set sc 1e6
	    }
	    set x3 [expr $MapLoadPos(origin,x)+$MapLoadPos(dmx,2)/$sc]
	    set y3 [expr $MapLoadPos(origin,y)+$MapLoadPos(dmy,2)/$sc]
	    $Map coords mappoint=2 [expr $x3-3] [expr $y3-3] \
		    [expr $x3+3] [expr $y3+3]
	    $Map coords mapfixthird $x3 [expr $y3-8]
	    MapScaleChange $sc
	    set MapLoadPos(adj,1) [list $xx $yy]
	    set MapLoadPos(adj,2) [list $x3 $y3]
	    set MapLoadPos(scale) $sc
	}
	0 {
	    if { ! $MapEmpty } {
		SetMapCoords $xx $yy
		if { $MapMakingRT } {
		    set cx [lindex $MapRTCurrent 0]
		    set cy [lindex $MapRTCurrent 1]
		    $Map coords mkRTfrline $xx $yy $cx $cy
		    $Map coords mkRTcursor [expr $xx-2] [expr $yy-2] \
			    [expr $xx+2] [expr $yy+2]
		    if { $MapEditingRS } {
			set cx [lindex $MapRTNext 0]
			set cy [lindex $MapRTNext 1]
			$Map coords mkRTtoline $cx $cy $xx $yy
		    }
		}
		if { $MapWPMoving != -1 } {
		    BalloonMotion $x $y
		}
	    }
	}
    }
    return
}

proc MapCursorUpdate {} {
    # update cursor coordinates after scrolling
    global CursorPos

    if { ! [catch "set CursorPos"] } {
	eval MapCursorMotion $CursorPos
    }
    return
}

proc ScrollMapTo {x0 y0 x y} {
    # scroll map so that point at ($x0,$y0) is shown at ($x,$y),
    #  pixel coordinates relative to canvas origin
    global Map MapRange

    ScrollMap x moveto [expr [lindex [$Map xview] 0]+($x0-$x)/$MapRange(x)]
    ScrollMap y moveto [expr [lindex [$Map yview] 0]+($y0-$y)/$MapRange(y)]
    return
}

proc ScrollMap {dim args} {
    # scroll map and set corresponding coordinate of origin of visible region
    # $dim in {x, y}, $args suitable to {x,y}view command
    global Map

    eval $Map ${dim}view $args
    SetVisibleOrigin $dim
    return
}

proc SetVisibleOrigin {dim} {
    # set coordinate of origin of visible region
    # $dim in {x, y}
    global Map OV$dim MapRange

    set sc [lindex [$Map ${dim}view] 0]
    set OV$dim [expr $sc*$MapRange($dim)+$MapRange(${dim}0)]
    return
}

proc HighLightWP {ix syit} {
    # highlight WP representation
    global Map MAPCOLOUR

    $Map itemconfigure forWP=$ix -fill $MAPCOLOUR(mapsel)
    return
}

proc HighLight {} {
    # highlight mapped item where the pointer is currently on
    global Map MAPCOLOUR

    set ts [$Map itemcget [set it [$Map find withtag current]] -tags]
    if { [set i [lsearch -glob $ts {forRT=*}]] != -1 } {
	set t [lindex $ts $i]
	$Map itemconfigure $t -fill $MAPCOLOUR(mapsel)
	regsub forRT= $t "" ix
	$Map itemconfigure inRT=$ix -fill $MAPCOLOUR(mapsel)
	return
    }
    if { [set i [lsearch -glob $ts {forWP=*}]] != -1 } {
	regsub forWP= [lindex $ts $i] "" ix
	set syit [$Map find withtag syforWP=$ix]
	HighLightWP $ix $syit
	return
    }
    if { [set i [lsearch -glob $ts {syforWP=*}]] != -1 } {
	regsub syforWP= [lindex $ts $i] "" ix
	HighLightWP $ix $it
	return
    }
    if { [set i [lsearch -glob $ts {for??=*}]] != -1 } {
	$Map itemconfigure [lindex $ts $i] -fill $MAPCOLOUR(mapsel)
    }
    return
}

proc LowLight {} {
    # finish highlighting a mapped item
    global MAPCOLOUR Map

    set ts [$Map itemcget [$Map find withtag current] -tags]
    if { [set i [lsearch -glob $ts {forRT=*}]] != -1 } {
	set t [lindex $ts $i]
	$Map itemconfigure $t -fill $MAPCOLOUR(RT)
	regsub forRT= $t "" ix
	$Map itemconfigure inRT=$ix -fill $MAPCOLOUR(WP)
	return
    }
    if { [set i [lsearch -glob $ts {forWP=*}]] != -1 } {
	$Map itemconfigure [lindex $ts $i] -fill $MAPCOLOUR(WP)
	# $Map delete syframe
	## this avoids an infinite loop; don't ask me why...
	# update idletasks
	return
    }
    if { [set i [lsearch -glob $ts {syforWP=*}]] != -1 } {
	regsub syforWP= [lindex $ts $i] "" ix
	$Map itemconfigure forWP=$i -fill $MAPCOLOUR(WP)
	# cannot "$Map delete syframe": infinite loop...
	return
    }
    if { [set i [lsearch -glob $ts {forTR=*}]] != -1 } {
	set t [lindex $ts $i]
	$Map itemconfigure $t -fill $MAPCOLOUR(TR)
	regsub forTR= $t "" ix
	$Map itemconfigure inTR=$ix -fill $MAPCOLOUR(TP)
    }
    return
}

### map bounds

proc SetMapBounds {} {
    # set map bounds according to mapped items and configure map buttons
    global Map MapBounds MapEmpty MapRange MapWPMoving MapMakingRT WConf \
	    MAPW2 MAPH2 MAPWIDTH MAPHEIGHT MapTransfTitle

    set MapBounds [$Map bbox all]
    if { "[$Map find all]" != "" } {
	# enlarge bounds so that corners can be scrolled to window centre
	set mbs ""
	foreach i "0 1 2 3" d [list $MAPW2 $MAPH2 $MAPW2 $MAPH2] \
		s "-1 -1 1 1" {
	    lappend mbs [expr $s*$d+[lindex $MapBounds $i]]
	}
	set MapBounds $mbs
	foreach d "x y" i "0 1" ii "2 3" l [list $MAPWIDTH $MAPHEIGHT] {
	    set MapRange($d) \
		    [expr [lindex $MapBounds $ii]-[lindex $MapBounds $i]]
	    set MapRange(${d}0) [lindex $MapBounds $i]
	}
	set st normal
	$Map configure -scrollregion $MapBounds
	SetVisibleOrigin x ; SetVisibleOrigin y
    } else {
	set st disabled
	set MapEmpty 1 ; set MapTransfTitle ""
	foreach b $WConf(mapdatum) { $b configure -state normal }
	set MapRange(x) $MAPWIDTH ; set MapRange(y) $MAPHEIGHT
	set MapRange(x0) 0 ; set MapRange(y0) 0
	$Map configure -scrollregion [list 0 0 $MAPWIDTH $MAPHEIGHT]
	set MapMakingRT 0
	StopMapWPMoving
    }
    foreach p $WConf(mapstate) t $WConf(mapstatetype) {
	switch $t {
	    menubutton -
	    button {
		$p configure -state $st
	    }
	    menu {
		$p entryconfigure 0 -state $st
		$p entryconfigure 2 -state $st
	    }
	}
    }
    return
}

### datum

proc ChangeMapDatum {datum args} {
    # change map datum
    #  $args is not used but is needed as this is called-back from
    #  menus built by proc FillDatumMenu (geod.tcl)
    # to be called only when map is empty
    global Datum

    set Datum $datum
    return
}

### scale

proc MapScaleToShow {scale} {
    # compute distance and unit to show for map scale in metre/pixel
    global DSCALE MAPSCLENGTH DTUNIT SUBDTUNIT SUBDSCALE

    if { [set v [expr $DSCALE*$MAPSCLENGTH*$scale/1000.0]] < 0.999 } {
	set u $SUBDTUNIT ; set v [expr 1.0*$v/$SUBDSCALE]
    } else { set u $DTUNIT }
    return "[format %.2f $v] $u"
}

proc MapScaleFromDist {d} {
    # compute scale in metre/pixel from distance shown on map window
    global DSCALE MAPSCLENGTH

    return [expr $d*1000.0/$DSCALE/$MAPSCLENGTH]
}

proc MapScaleChange {value} {
    # show change in map scale
    #  $value is either a scale in metre/pixel when geo-referencing image,
    #   or distance to show on map window
    global MpW MapLoading DTUNIT SUBDTUNIT SUBDSCALE

    if { $MapLoading != 0 } {
	if { $value > 1e5 } {
	    $MpW.frm.frmap3.cv.val configure -text ?
	    update idletasks
	    return
	}
	set txt [MapScaleToShow $value]
    } else {
	if { $value < 1 } {
	    set u $SUBDTUNIT ; set value [expr 1.0*$value/$SUBDSCALE]
	    if { [expr int($value)] != $value } {
		set value [format %.2f $value]
	    }	    
	} else { set u $DTUNIT }
	set txt "$value $u"
    }
    $MpW.frm.frmap3.cv.val configure -text $txt
    update idletasks
    return
}

proc MapScaleSet {d} {
    # apply map scale change
    #  $d is number of distance units represented by $MAPSCLENGTH pixels
    global Map MapScale MAPW2 MAPH2 MapMakingRT MapRTCurrent MapLoading \
	    MapRange OVx OVy MapTransf MapEmpty MESS MapEditingRS MapRTNext

    if { $MapLoading != 0 } { return }
    set s [MapScaleFromDist $d]
    if { $s == $MapScale } { return }
    if { ! $MapEmpty && ! [MapNewScale${MapTransf}Transf $s] } {
	GMMessage $MESS(transfcantscale)
	return
    }
    SetCursor . watch
    MapScaleChange $d
    set r [expr $MapScale*1.0/$s]
    set MapScale $s
    # pixel coordinates of centre, relative to canvas origin after scaling
    set xms [expr $r*($OVx+$MAPW2)] ; set yms [expr $r*($OVy+$MAPH2)]
    # scale map items
    foreach item [$Map find withtag sq2] {
	set cs [$Map coords $item]
	# coordinates of the centre of the square
	set x0 [expr [lindex $cs 0]+1] ; set y0 [expr [lindex $cs 1]+1]
	set dx [expr ($r-1)*$x0] ; set dy [expr ($r-1)*$y0]
	set ts [$Map gettags $item]
	if { [set i [lsearch -glob $ts {lab=*}]] != -1 } {
	    set t [lindex $ts $i]
	} else { set t $item }
	$Map move $t $dx $dy
    }
    foreach item [$Map find withtag line] {
	set cs [Apply [$Map coords $item] Multiply $r]
	eval $Map coords $item $cs
    }
    foreach item [$Map find withtag lab] {
	set cs [Apply [$Map coords $item] Multiply $r]
	eval $Map coords $item $cs
    }
    if { $MapMakingRT } {
	set x [expr $r*[lindex $MapRTCurrent 0]]
	set y [expr $r*[lindex $MapRTCurrent 1]]
	set MapRTCurrent [list $x $y [lindex $MapRTCurrent 2]]
	if { $MapEditingRS } {
	    set x [expr $r*[lindex $MapRTNext 0]]
	    set y [expr $r*[lindex $MapRTNext 1]]
	    set MapRTNext [list $x $y [lindex $MapRTNext 2]]
	}
    }
    # compute new bounds and origin of visible part
    SetMapBounds
    # scroll old centre (xms,yms) to new centre
    ScrollMapTo $xms $yms [expr $OVx+$MAPW2] [expr $OVy+$MAPH2]
    ResetCursor .
    return
}

### abstract mapping procedures
## conversions between geodetic positions and map coordinates

proc MapFromPosn {latd longd datum} {
    # compute map coordinates from position
    global MapEmpty MapLoading MapScale MapProjPointProc MapProjInitProc \
	    MapTransf MAPW2 MAPH2 WConf MPData MTData Datum

    if { $MapEmpty && ! $MapLoading } {
	set MapEmpty 0
	catch "unset MPData" ; catch "unset MTData"
	foreach b $WConf(mapdatum) { $b configure -state disabled }
	set pt [$MapProjInitProc MPData $Datum \
		[list [list $latd $longd $datum]]]
	# default transformation: no rotation
	# default initial location on map: $MAPW2 $MAPH2
	eval MapInitNoRotTransf $MapScale $pt $MAPW2 $MAPH2
    } else {
	set pt [$MapProjPointProc MPData $latd $longd $datum]
    }
    return [eval MapApply${MapTransf}Transf $pt]
}

proc MapToPosn {xm ym pfmt} {
    # compute position in given format from map coordinates
    global MapProjInvertProc MapTransf

    set pt [MapInvert${MapTransf}Transf $xm $ym]
    return [eval $MapProjInvertProc MPData $pt $pfmt]
}

proc SetMapCoords {xm ym} {
    # set map cursor coordinates in selected format
    global MapProjInvUTMProc MapProjInvertProc MapTransf MapPFormat \
	    XCoord YCoord MapZone Datum ZGRID

    set pt [MapInvert${MapTransf}Transf $xm $ym]
    switch $MapPFormat {
	DMS -  DMM -  DDD {
	    set p [eval $MapProjInvertProc MPData $pt $MapPFormat]
	    set XCoord [lindex $p 2] ; set YCoord [lindex $p 3]
	    set MapZone ""
	}
	UTM/UPS {
	    set p [eval $MapProjInvUTMProc MPData $pt]
	    set XCoord [expr round([lindex $p 2])]
	    set YCoord [expr round([lindex $p 3])]
	    set MapZone [format %d%s [lindex $p 0] [lindex $p 1]]
	}
	default {
	    set p [eval $MapProjInvertProc MPData $pt DDD]
	    if { $ZGRID($MapPFormat) } {
		set p [DegreesTo$MapPFormat [lindex $p 0] [lindex $p 1] $Datum]
	    } else {
		set p [DegreesToNZGrid $MapPFormat \
			[lindex $p 0] [lindex $p 1] $Datum]
	    }
	    set XCoord [lindex $p 1] ; set YCoord [lindex $p 2]
	    set MapZone [lindex $p 0]
	}
    }
    return
}

### display

proc MapCreateWP {x y wpix name} {
    # create WP representation on map
    # return rectangle item
    global Map WPCommt WPSymbol WPDispOpt MAPCOLOUR SYMBOLIMAGE ICONHEIGHT

    set its [set it [$Map create rectangle [expr $x-1] [expr $y-1] \
	             [expr $x+1] [expr $y+1] -fill $MAPCOLOUR(WP) \
		     -outline $MAPCOLOUR(WP) \
		     -tags [list WP WP=$name forWP=$wpix lab=$name sq2]]]
    switch [set o $WPDispOpt($wpix)] {
	name -
	s_name {
	    lappend its [$Map create text $x [expr $y-6-$ICONHEIGHT/2.0] \
		    -text $name -fill $MAPCOLOUR(WP) -font fixed \
		    -justify center \
		    -tags [list WP WPn forWP=$wpix lab=$name txt]]
	}
	comment -
	s_comment {
	    set t $WPCommt($wpix)
	    lappend its [$Map create text $x [expr $y-6-$ICONHEIGHT/2.0] \
		    -text $t -fill $MAPCOLOUR(WP) -font fixed -justify center \
		    -tags [list WP WPn forWP=$wpix lab=$name txt]]
	}
    }
    if { [string first s $o] == 0 } {
	lappend its [$Map create image $x $y -anchor center \
		-image $SYMBOLIMAGE($WPSymbol($wpix)) \
		-tags [list WP WPsy syforWP=$wpix lab=$name]]
    }
    foreach m $its {
	$Map bind $m <Double-1> "OpenItem WP $wpix"
	# used to be Button-3:
	$Map bind $m <Control-Button-1> "MapWPMenu $wpix"
    }
    return $it
}

proc PutMapWP {ix} {
    # map WP with given index
    # return map item for the rectangle
    global Datum WPName WPPosn WPDatum

    set p [MapFromPosn [lindex $WPPosn($ix) 0] [lindex $WPPosn($ix) 1] \
	              $WPDatum($ix)]
    return [MapCreateWP [lindex $p 0] [lindex $p 1] $ix $WPName($ix)]
}

proc PutMapRT {ix} {
    # map RT with given index
    # return -1 if RT contains a WP either unknown or being edited,
    #   otherwise 1
    global RTWPoints RTStages

    return [PutMapRTWPRS $ix $RTWPoints($ix) $RTStages($ix) \
	    [list RT forRT=$ix] inRT=$ix]
}

proc PutMapRTWPRS {ix wps rss rttags wptag} {
    # map RT having the WPs in $wps, RSs in $rss, adding $rttags to RT
    #  elements and $wptag (unless void) to WPs
    #  $ix may be -1, in which case there will be no bindings to open
    #    the RT
    # the colour is taken to be indexed by the head of $rttags
    # return -1 if RT contains a WP either unknown or being edited,
    #   otherwise 1
    global WPDispl EdWindow GMWPIndex Map MAPCOLOUR MESS DataIndex

    SetCursor . watch
    set its ""
    foreach wp $wps {
	set wpix [IndexNamed WP $wp]
	if { "[set it [$Map find withtag WP=$wp]]" == "" } {
	    if { $wpix == -1 } {
		GMMessage "$MESS(cantmapRTunkn) $wp"
		ResetCursor .
		return -1
	    }
	    if { [winfo exists $EdWindow(WP)] && $GMWPIndex==$wpix } {
		GMMessage "$MESS(cantmapRTed): $wp"
		ResetCursor .
		return -1
	    }
	    set it [PutMapWP $wpix]
	    set WPDispl($wpix) 1
	    SetDisplShowWindow WP $wpix select
	}
	lappend its $it
	if { "$wptag" != "" } {
	    $Map addtag $wptag withtag forWP=$wpix
	}
    }
    set colour $MAPCOLOUR([lindex $rttags 0])
    set cs [$Map coords [set it0 [lindex $its 0]]]
    # coordinates of the centre of the square
    set x0 [expr [lindex $cs 0]+1] ; set y0 [expr [lindex $cs 1]+1]
    set ixlab $DataIndex(RSlabel)
    set k 0
    foreach it [lrange $its 1 end] st $rss {
	if { "$it" != "" } {
	    set cs [$Map coords $it]
	    set x [expr [lindex $cs 0]+1] ; set y [expr [lindex $cs 1]+1]
	    set ts [concat $rttags [list from=$it0 to=$it stno=$k line]]
	    set zs [$Map create line $x0 $y0 $x $y -arrow last -smooth 0 \
		    -fill $colour -width 2 -tags $ts]
	    if { "[set sl [lindex $st $ixlab]]" != "" } {
		set xl [expr ($x0+$x)/2] ; set yl [expr ($y0+$y)/2]
		set ts [linsert $rttags end lab]
		lappend zs [$Map create text $xl $yl \
		    -text $sl -fill $colour -font fixed \
		    -justify center -tags $ts]
	    }
	    if { $ix != -1 } {
		foreach l $zs {
		    $Map bind $l <Double-1> "OpenItem RT $ix"
		    $Map lower $l $it0
		}
	    } else {
		foreach l $zs { $Map lower $l $it0 }
	    }
	    set x0 $x ; set y0 $y ; set it0 $it
	    incr k
	}
    }
    ResetCursor .
    return 1
}

proc PutMapTREls {ix tps datum tags} {
    # map TR elements
    #  $ix is index of TR or -1; used for tagging
    #  $tps is list of TR points with given $datum
    #  $tags is tags to add to all created canvas items (may be void)
    global MAPCOLOUR Map TRName TRNUMBERINTVL

    SetCursor . watch
    set tags1 [linsert $tags 0 TR forTR=$ix inTR=$ix]
    set tags2 [linsert $tags 0 TR forTR=$ix line]
    set its "" ; set i 1
    if { $ix != -1 } {
	set name $TRName($ix)
    } else { set name "(???)" }
    foreach tp $tps {
	set p [MapFromPosn [lindex $tp 0] [lindex $tp 1] $datum]
	set x [lindex $p 0] ; set y [lindex $p 1]
	set it [$Map create rectangle [expr $x-1] [expr $y-1] \
		  [expr $x+1] [expr $y+1] -fill $MAPCOLOUR(TP) \
		  -outline $MAPCOLOUR(TP) \
		  -tags [linsert $tags1 0 lab=$ix-$i sq2]]
	if { $i == 1 } {
	    $Map addtag TRfirst withtag $it
	    $Map addtag TR=$ix withtag $it
	}
	$Map bind $it <Double-1> "OpenItem TR $ix"
	lappend its $it
	if { $TRNUMBERINTVL && $i%$TRNUMBERINTVL == 0 } {
	    set t [$Map create text $x [expr $y-8] -text $i \
		    -fill $MAPCOLOUR(TP) -font fixed -justify center \
		    -tags [linsert $tags1 0 lab=$ix-$i txt]]
	    $Map bind $t <Double-1> "OpenItem TR $ix"
	}
	BalloonBindings "$Map lab=$ix-$i" [list ={$name}:$i]
	incr i
    }
    set cs [$Map coords [set it0 [lindex $its 0]]]
    # coordinates of centre of the square
    set x0 [expr [lindex $cs 0]+1] ; set y0 [expr [lindex $cs 1]+1]
    foreach it [lrange $its 1 end] {
	if { "$it" != "" } {
	    set cs [$Map coords $it]
	    set x [expr [lindex $cs 0]+1] ; set y [expr [lindex $cs 1]+1]
	    set l [$Map create line $x0 $y0 $x $y -smooth 0 \
		    -fill $MAPCOLOUR(TR) -width 2 -tags $tags2]
	    $Map bind $l <Double-1> "OpenItem TR $ix"
	    $Map lower $l $it0
	    set x0 $x ; set y0 $y
	}
    }
    ResetCursor .
    return 1
}

proc PutMapTR {ix} {
    # map TR with given index
    global TRTPoints TRDatum

    PutMapTREls $ix $TRTPoints($ix) $TRDatum($ix) ""
    return 1
}

proc PutMapGREl {wh ix} {
    # map GR element of given kind and index
    # fail if the element cannot be unmapped/mapped
    global ${wh}Displ

    if { [set ${wh}Displ($ix)] } {
	if { ! [UnMap $wh $ix] } { return 0 }
    }
    return [PutMap $wh $ix]
}

proc PutMapGR {ix} {
    # map GR with given index
    # may fail if an element cannot be unmapped/mapped
    global GRConts

    set r 1
    foreach p $GRConts($ix) {
	set wh [lindex $p 0]
 	foreach e [lindex $p 1] {
	    if { [set ex [IndexNamed $wh $e]]==-1 || ![PutMapGREl $wh $ex] } {
		set r -1
	    }
 	}
    }
    return $r
}

proc PutMap {wh ix} {
    # put item with index $ix and of type $wh (in $TYPES) on map
    #  if possible
    # set map bounds and change display button in show windows
    global Map ${wh}Displ

    set r [PutMap$wh $ix]
    SetMapBounds
    if { $r == -1 } {
	set [set wh]Displ($ix) 0
	return 0
    }
    set [set wh]Displ($ix) 1
    SetDisplShowWindow $wh $ix select
    return 1
}

proc PutMapAnimPoint {mpos no centre} {
    # display point for animation $no at map position given by
    #  first two elements of $mpos; scroll to centre if $centre
    # draw line from previous point if there is one
    global Map MAPCOLOUR OVx OVy MAPW2 MAPH2 FRAMEIMAGE

    set x [lindex $mpos 0] ; set y [lindex $mpos 1]
    if { "[set itl [$Map find withtag lastfor=$no]]" != "" } {
	set cs [$Map coords $itl]
	set x1 [expr [lindex $cs 0]+1] ; set y1 [expr [lindex $cs 1]+1]
	$Map create line $x $y $x1 $y1 -smooth 0 \
		-fill $MAPCOLOUR(anim) -width 2 -tags [list an=$no line]
	$Map dtag $itl lastfor=$no
	set blit [$Map find withtag anblink=$no]
	$Map coords $blit $x $y
    } else {
	$Map create image $x $y -anchor center \
		-image $FRAMEIMAGE -tags [list lab an=$no anblink=$no]
	after 500 "MapBlink anblink=$no 1"
    }
    set it [$Map create rectangle [expr $x-1] [expr $y-1] [expr $x+1] \
	    [expr $y+1] -fill $MAPCOLOUR(anim) -outline $MAPCOLOUR(anim) \
	    -tags [list an=$no lastfor=$no sq2]]
    SetMapBounds
    if { $centre } {
	# scroll new point to centre
	ScrollMapTo $x $y [expr $OVx+$MAPW2] [expr $OVy+$MAPH2]
    }
    return
}

proc MapBlink {tag state} {
    # make items with $tag blink on map
    #  $state toggles between 1 and 0
    global Map

    set on 0
    foreach it [$Map find withtag $tag] {
	set on 1
	if { $state } { $Map lower $it } else { $Map raise $it }
    }
    if { $on } { after 500 "MapBlink $tag [expr 1-$state]" }
    return
}

proc UnMapWP {ix} {
    # delete WP with index $ix from map
    # fails if WP belongs to a mapped RT
    global Map WPName MapWPMoving

    set it [$Map find withtag WP=$WPName($ix)] ; set ts [$Map gettags $it]
    if { [lsearch -glob $ts {inRT=*}] == -1 } {
	$Map delete forWP=$ix syforWP=$ix menuWP=$ix
	if { $MapWPMoving == $ix } { StopMapWPMoving }
	return 1
    }
    return 0
}

proc UnMapRT {ix} {
    # delete RT with index $ix from map
    global Map

    $Map delete forRT=$ix
    foreach it [$Map find withtag inRT=$ix] {
	$Map dtag $it inRT=$ix
    }
    return 1
}

proc UnMapTR {ix} {
    # delete TR with index $ix from map
    global Map

    $Map delete forTR=$ix
    return 1
}

proc UnMapGR {ix} {
    # delete from map all items in GR with index $ix or in its subgroups
    # unmapping of some items may fail, but others will be unmapped
    global GRConts

    set r 1
    set wps ""
    foreach p $GRConts($ix) {
	set wh [lindex $p 0]
	if { "$wh" != "WP" } {
	    foreach e [lindex $p 1] {
		if { [set eix [IndexNamed $wh $e]]==-1 || ![UnMap $wh $eix] } {
		    set r 0
		}
	    }
	} else { set wps [concat $wps [lindex $p 1]] }
    }
    foreach wp $wps {
	if { [set eix [IndexNamed WP $wp]]==-1 || ![UnMap WP $eix] } {
	    set r 0
	}
    }
    return $r
}

proc UnMap {wh ix args} {
    # delete item with index $ix and of type $wh (in $TYPES) from map
    #  $args not used, but needed because of callback in menus
    # if possible
    global Map ${wh}Displ

    if { [set r [UnMap$wh $ix]] } { 
	set [set wh]Displ($ix) 0
	SetDisplShowWindow $wh $ix deselect
    }
    SetMapBounds
    return $r
}

proc StartMapWPMoving {ix} {
    # WP with index $ix is to be placed elsewhere on map
    global MapWPMoving MESS WPName

    after 5 "BalloonCreate 0 [list =[format $MESS(movingWP) $WPName($ix)]]"
    set MapWPMoving $ix
    return
}

proc MapMoveWP {x y posn} {
    # place WP at $x,$y changing its position to $posn
    global EdWindow GMWPIndex MapWPMoving MapPFormat WPPosn WPPFrmt WPName

    set ix $MapWPMoving
    StopMapWPMoving
    if { [winfo exists $EdWindow(WP)] && $GMWPIndex == $ix } {
	bell ; Raise $EdWindow(WP)
	return
    }
    set name $WPName($ix)
    set WPPosn($ix) $posn ; set WPPFrmt($ix) $MapPFormat
    MoveOnMap WP $ix $name 0 $name
    ChangeWPInRTWindows $name $name
    UpdateItemWindows WP $ix
    return
}

proc StopMapWPMoving {} {
    global MapWPMoving

    if { $MapWPMoving != -1 } { destroy .balloon }
    set MapWPMoving -1
    return
}

proc MoveOnMap {wh ix oldname diffname newname} {
    # change mapped item with index $ix
    #  $wh in $TYPES
    #  if $diffname is set $oldname is different from $newname
    global WPDispOpt Map WPName MapMakingRT MapRTCurrent MapEditingRS MapRTNext

    if { "$wh" != "WP" } {
	UnMap $wh $ix ; PutMap $wh $ix
    } else {
	# change WP
	set it [$Map find withtag WP=$oldname]
	set ts [$Map gettags $it]
	if { [set iz [lsearch -glob $ts {inRT=*}]] == -1 } {
	    UnMap WP $ix ; PutMap $wh $ix
	    return
	}
	$Map delete forWP=$ix syforWP=$ix
	PutMap WP $ix
	# add  inRT=*  tags
	while { 1 } {
	    set t [lindex $ts $iz]
	    regsub inRT= $t "" rx
	    $Map addtag inRT=$rx withtag forWP=$ix
	    set ts [lrange $ts [expr $iz+1] end]
	    if { [set iz [lsearch -glob $ts {inRT=*}]] == -1 } { break }
	}
	set ni [$Map find withtag WP=$WPName($ix)]
	set x [$Map coords $ni]
	set y [lindex $x 1] ; set x [lindex $x 0]
	if { $MapMakingRT } {
	    if { [lindex $MapRTCurrent 2]==$it } {
		set MapRTCurrent [list $x $y $ni]
	    }
	    if { $MapEditingRS && [lindex $MapRTNext 2]==$it } {
		set MapRTNext [list $x $y $ni]
	    }
	}
	foreach lf [$Map find withtag from=$it] {
	    $Map dtag $lf from=$it ; $Map addtag from=$ni withtag $lf
	    set cs [lreplace [$Map coords $lf] 0 1 $x $y]
	    eval $Map coords $lf $cs
	}
	foreach lt [$Map find withtag to=$it] {
	    $Map dtag $lt to=$it ; $Map addtag to=$ni withtag $lt
	    set cs [lreplace [$Map coords $lt] 2 3 $x $y]
	    eval $Map coords $lt $cs
	}
    }
    return
}

proc SaveMap {} {
    # save map as a postscript file
    global Map MapBounds

    SaveCanvas $Map $MapBounds
    return
}

proc ClearMap {} {
    # clear map after confirmation
    global MESS

    if { [GMConfirm $MESS(okclrmap)] } {
	DoClearMap
    }
    return
}

proc DoClearMap {} {
    # delete all map items even if being edited
    global MpW Map MapLoading MapScale MapScInitVal MapImageItems \
	    MapImageFile WConf XCoord YCoord MapZone \
	    EdWindow GMWPData GMWPDispl GMRTData GMRTDispl GMTRData \
	    GMGRData GMTRDispl WPDispl RTDispl TRDispl GRDispl TYPES \
	    MapMakingRT

    if { $MapMakingRT } { MapCancelRT dontask close }
    # RTs (if they exist) must be dealt with first
    if { [set i [lsearch -exact $TYPES RT]] != -1 } {
	set types [linsert [lreplace $TYPES $i $i] 0 RT]
    } else {
	set types $TYPES
    }
    foreach wh $types {
	if { [winfo exists $EdWindow($wh)] } {
	    set GM${wh}Displ 0
	    set GM${wh}Data [lreplace [set GM${wh}Data] end end 0]
	    $EdWindow($wh).fr.displayed deselect
	}
	foreach n [array names ${wh}Displ] {
	    set ${wh}Displ($n) 0
	}
    }
    eval $Map delete [$Map find all]
    set MapImageItems "" ; catch "unset MapImageFile"
    SetMapBounds
    set MapLoading 0
    StopMapWPMoving
    set XCoord "" ; set YCoord "" ; set MapZone ""
    $MpW.frm.frmap3.mn configure -state normal
    foreach b $WConf(mapdatum) { $b configure -state normal }
    MapScaleChange $MapScInitVal
    set MapScale [MapScaleFromDist $MapScInitVal]
    StatusMapBackMenu disabled
    return
}

proc MapCreateMenu {wh x y title tags} {
    # create menubutton on map for item of type $wh at $x,$y
    #  labelled $TXT($title) and with $tags
    # create menu for menubutton named "mn"
    # return path of menubutton
    global Map TXT MapBounds

    set mb $Map.m$wh
    destroy $mb
    menubutton $mb -menu $mb.mn -text $TXT($title)
    if { $x < [lindex $MapBounds 0] } {
	set x [lindex $MapBounds 0]
    } elseif { $x > [lindex $MapBounds 2] } {
	set x [lindex $MapBounds 2]
    }
    if { $y < [lindex $MapBounds 1] } {
	set y [lindex $MapBounds 1]
    } elseif { $y > [lindex $MapBounds 3] } {
	set y [lindex $MapBounds 3]
    }
    set it [$Map create window $x $y -window $mb -tags $tags]
    menu $mb.mn -tearoff 0
    return $mb
}

proc MapWPMenu {ix} {
    # create menubutton and menus to put, on map, items in relation to
    #  mapped WP with given index, or for starting making a RT from it
    global Map TXT WPName LsW MAXMENUITEMS MapBounds DSCALE EdWindow GMWPIndex

    set wp $WPName($ix)
    set mapitem [$Map find withtag WP=$wp]
    set cs [$Map coords $mapitem]
    set sx [expr [lindex $cs 0]+1] ; set sy [expr [lindex $cs 1]+1]
    set y [expr $sy+10] ; set x [expr $sx+50]
    set mbt [MapCreateMenu WP $x $y withWP [list menuWP=$ix lab=$wp]]
    if { [winfo exists $EdWindow(WP)] && $GMWPIndex == $ix } {
	set st disabled
    } else { set st normal }
    set menu $mbt.mn
    $menu add command -label $TXT(move) -state $st \
	    -command "destroy $mbt ; StartMapWPMoving $ix"
    if { [winfo exists $EdWindow(RT)] } {
	set st disabled
    } else { set st normal }
    $menu add command -label $TXT(startRT) -state $st \
	    -command "destroy $mbt ; MapMakeRT $ix $sx $sy"

    foreach f "displ clear" tg "d c" {
	set mn $menu.$tg
	$menu add cascade -label "$TXT($f) ..." -menu $mn
	menu $mn -tearoff 0
	$mn add cascade -label "$TXT(within) ..." -menu $mn.within
	menu $mn.within -tearoff 0
	foreach d "1 5 10 20 50 100 200 300 500" {
	    $mn.within add command -label $d \
		    -command "destroy $mbt ; \
		    MapWPsWithin $f [expr $d/$DSCALE] $ix"
	}
	$mn add cascade -label "$TXT(inrect) ..." -menu $mn.rect
	set mw $mn.rect
	menu $mw -tearoff 0
	set n 0 ; set m 0
	foreach it [$LsW.frlWP.frl.box get 0 end] {
	    if { "$wp" != "$it" } {
		if { $n > $MAXMENUITEMS } {
		    $mw add cascade -label "$TXT(more) ..." -menu $mw.m$m
		    set mw $mw.m$m ; menu $mw -tearoff 0
		    set n 0 ; incr m
		}
		$mw add command -label $it \
			-command "destroy $mbt ; MapWPsInRect $f $ix $it"
		incr n
	    }
	}
	$mn add cascade -label "$TXT(nameRT) ..." -menu $mn.rts
	menu $mn.rts -tearoff 0
	$mn.rts add command -label $TXT(forthisWP) \
		-command "destroy $mbt ; MapRTsFor $ix $f"
	$mn.rts add command -label $TXT(formappedWPs) \
		-command "destroy $mbt ; MapRTsForMappedWPs $f"
    }
    $menu add command -label $TXT(closemenu) -command "destroy $mbt"
    return
}

proc MapRTMenu {ix x y} {
    # create menubutton for RT on map or being built on map ($ix==-1)
    global TXT OVx OVy MapEditingRS MapEditedRS MapRTLast Map CRHAIRx CRHAIRy

    set xx [expr $OVx+$x-$CRHAIRx] ; set yy [expr $OVy+$y-$CRHAIRy]
    foreach it [$Map find overlapping $xx $yy [expr $xx+10] [expr $yy+10]] {
	set ts [$Map gettags $it]
	if { [set i [lsearch -glob $ts forWP=*]] != -1 } {
	    regsub forWP= [lindex $ts $i] "" wpix
	    MapWPMenu $wpix
	    return
	}
    }
    set xx [expr $OVx+$x+10] ; set yy [expr $OVy+$y+10]
    set mbt [MapCreateMenu RT $xx $yy route [list menuRT=$ix lab=undef]]
    set menu $mbt.mn
    $menu add separator
    if { $MapEditingRS } {
	$menu add command -label $TXT(stop) \
		-command "destroy $mbt ; MapFinishRTLastWP"
    } else {
	$menu add cascade -label $TXT(stop) -menu $menu.mnf
	menu $menu.mnf -tearoff 0
	$menu.mnf add command -label $TXT(here) -accelerator "<Button-3>" \
		-command "destroy $mbt ; MapFinishRT $x $y"
	$menu.mnf add command -label $TXT(atprevwp) \
		-command "destroy $mbt ; MapFinishRTLastWP"
    }
    $menu add command -label $TXT(cancel) -accelerator "<Shift-B2>" \
	    -command "destroy $mbt ; MapCancelRT ask close"
    if { $MapRTLast != 0 } {
	$menu add cascade -label $TXT(del) -menu $menu.mnd
	menu $menu.mnd -tearoff 0
	$menu.mnd add command -label $TXT(prevwp) -accelerator "<Shift-B1>" \
		-command "destroy $mbt ; MapDelFromRT sel"
	if { $MapEditingRS && $MapEditedRS == 0 } {
	    set st disabled
	} else { set st normal }
	$menu.mnd add command -label $TXT(firstwp) -state $st \
		-command "destroy $mbt ; MapDelFromRT 0"
    }
    if { $MapEditingRS } {
	if { $MapEditedRS != 0 } {
	    $menu add command -label $TXT(chglstrs) \
		    -accelerator "<Control-B3>" \
		    -command "destroy $mbt ; MapChangeRTLastRS"
	}
	if { $MapEditedRS != $MapRTLast-1 } {
	    $menu add command -label $TXT(chgnxtrs) \
		    -accelerator "<Ctrl-Shift-B3>" \
		    -command "destroy $mbt ; MapChangeRTNextRS"
	}
	$menu add command -label $TXT(contnend) \
		-command "destroy $mbt ; MapContRTEnd"	
    } elseif { $MapRTLast != 0 } {
	$menu add command -label $TXT(chglstrs) -accelerator "<Control-B3>" \
		-command "destroy $mbt ; MapChangeRTLastRS"
    }
    $menu add command -label $TXT(closemenu) -command "destroy $mbt"
    return
}

proc MapEditRT {} {
    # start editing on map RT currently in the RT edit window
    # this is assumed to be launched from the RT edit window
    global Map GMRTIndex RTDispl RTWPoints MapMakingRT MapRTLast MAPCOLOUR MESS

    if { $MapMakingRT } { bell ; return }
    if { [.gmRT.fr.fr3.fr31.frbx.bxn size] == 0 } {
	GMMessage $MESS(needs1wp)
	return
    }
    if { $GMRTIndex != -1 } {
	if { $RTDispl($GMRTIndex) } { UnMapRT $GMRTIndex }
	set wps $RTWPoints($GMRTIndex)
    } else {
	set wps [.gmRT.fr.fr3.fr31.frbx.box get 0 end]
    }
    if { [PutMapRTWPRS -1 $wps {} {mkRT mkRTedge} {}] == -1 } { return }
    set i -1
    foreach nwp $wps {
	set wpix [IndexNamed WP $nwp]
	$Map addtag inRT=:$i withtag forWP=$wpix
	incr i
    }
    set MapMakingRT 1 ; set MapRTLast $i
    GMRouteMapEdit
    set it [$Map find withtag WP=$nwp]
    set cs [$Map coords $it]
    MapStartRTEdit [expr [lindex $cs 0]+1] [expr [lindex $cs 1]+1] $it
    return
}

proc MapMakeRT {wpix x y} {
    # start making and mapping a RT for a mapped WP
    global Map MapMakingRT MapRTLast EdWindow WPName

    if { $MapMakingRT } { bell ; return }
    if { [winfo exists $EdWindow(RT)] } { Raise $EdWindow(RT) ; bell ; return }
    set MapMakingRT 1 ; set MapRTLast 0
    set n $WPName($wpix)
    set it [$Map find withtag WP=$n]
    $Map addtag inRT=:-1 withtag forWP=$wpix
    GMRoute -1 {create cancel} [FormData RT "WPoints Displ" [list [list $n] 1]]
    MapStartRTEdit $x $y $it
    return
}

proc MapStartRTEdit {x y wpit} {
    # prepare RT to be edited on map
    global Map MapRTCurrent MapRTLast MapRTNewWPs MapEditingRS MapEditedRS \
	    MAPCOLOUR 

    set MapEditingRS 0 ; set MapEditedRS -1
    set MapRTCurrent [list $x $y $wpit]
    set MapRTNewWPs ""
    GMRouteSelect end
    $Map create line $x $y $x $y -fill $MAPCOLOUR(mkRT) -arrow first \
	    -smooth 0 -width 2 -tags [list mkRT mkRTfrom mkRTfrline mkRTtrans]
    $Map create oval [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
	    -fill $MAPCOLOUR(mkRT) \
	    -tags [list mkRT mkRTfrom mkRTcursor mkRTtrans]
    $Map bind mkRTtrans <Button-3> { MapFinishRT %x %y }
    $Map bind mkRTtrans <Shift-2> { MapCancelRT ask close }
    $Map bind mkRTtrans <Shift-1> { MapDelFromRT sel }
    $Map bind mkRTtrans <Button-1> { MapAddToRT %x %y }
    $Map bind mkRTtrans <Control-1> { MapRTMenu -1 %x %y }
    $Map bind mkRTtrans <Control-3> { MapChangeRTLastRS }
    $Map bind mkRTtrans <Control-Shift-3> { MapChangeRTNextRS }
    return
}

proc MapFinishRTLastWP {} {
    global MapMakingRT TXT

    if { $MapMakingRT } {
	MapDestroyRT
	GMRouteMapEditEnd
    }
    return
}

proc MapFinishRT {x y} {
    global MapMakingRT TXT

    if { $MapMakingRT } {
	MapAddToRT $x $y
	MapFinishRTLastWP
    }
    return
}

proc MapAddToRT {x y} {
    global Map MapMakingRT MapRTCurrent MapRTLast MapRTNewWPs OVx OVy WPName \
	    CRHAIRx CRHAIRy MAPCOLOUR MapPFormat CREATIONDATE Datum \
	    MapEditingRS MapRTNext MapEditedRS MapWPMoving

    if { ! $MapMakingRT || $MapWPMoving != -1 } { return }
    set xx [expr $OVx+$x-$CRHAIRx] ; set yy [expr $OVy+$y-$CRHAIRx]
    set its [$Map find overlapping [expr $xx-3] [expr $yy-3] \
	                           [expr $xx+3] [expr $yy+3]]
    set ix -1
    foreach it $its {
	set ts [$Map gettags $it]
	if { [set i [lsearch -glob $ts {*forWP=*}]] != -1 } {
	    set t [lindex $ts $i]
	    regsub .*forWP= $t "" ix
	    set name $WPName($ix)
	    # cannot repeat last WP
	    if { "$name" == "[.gmRT.fr.fr3.fr31.frbx.box get end]" } {
		bell ; return
	    }
	    break
	}
    }
    if { $ix == -1 } {
	# create new WP at $xx,$yy
	set p [MapToPosn $xx $yy $MapPFormat]
	set name [NewName WP]
	if { $CREATIONDATE } {
	    set data [FormData WP "Name PFrmt Posn Datum Date" \
		       [list $name $MapPFormat $p $Datum [Now]]]
	} else {
	    set data [FormData WP "Name Commt PFrmt Posn Datum" \
		       [list $name [DateCommt [Now]] $MapPFormat $p $Datum]]
	}
	set ix [CreateItem WP $data]
	PutMap WP $ix
	lappend MapRTNewWPs $name
    }
    if { $MapEditingRS } {
	# start and end points of the new stage
	set fromit [$Map find withtag WP=$name]
	set toit [lindex $MapRTNext 2]
	# change previous stage to end at $xx,$yy
	set oldst stno=$MapEditedRS
	set cs [$Map coords $oldst]
	$Map coords $oldst [lreplace $cs 2 3 $xx $yy]
	$Map itemconfigure $oldst -fill $MAPCOLOUR(mkRT)
	$Map dtag $oldst to=$toit ; $Map addtag to=$fromit withtag $oldst
	set stno [lindex $MapEditedRS 0]
	# renumber RT items after this RS
	set nxt [expr $MapEditedRS+1]
	for { set n $MapRTLast } { $n > $nxt } { set n $i } {
	    set i [expr $n-1]
	    foreach it [$Map find withtag stno=$i] {
		$Map dtag $it stno=$i ; $Map addtag stno=$n withtag $it
	    }
	    foreach it [$Map find withtag inRT=:$i] {
		$Map dtag $it inRT=:$i ; $Map addtag inRT=:$n withtag $it
	    }
	}
	# old end point of stage
	foreach it [$Map find withtag inRT=:$MapEditedRS] {
	    $Map dtag $it inRT=:$MapEditedRS
	    $Map addtag inRT=:$nxt withtag $it
	}
	$Map addtag inRT=:$MapEditedRS withtag forWP=$ix
	# create a new stage from the new point to the old end point
	set cs [$Map coords $fromit]
	set xx [expr [lindex $cs 0]+1] ; set yy [expr [lindex $cs 1]+1]
	set is [$Map create line $xx $yy \
		[lindex $MapRTNext 0] [lindex $MapRTNext 1] \
		-fill $MAPCOLOUR(mapsel) -arrow last -smooth 0 \
		-width 2 -tags [list mkRT mkRTedge from=$fromit to=$toit \
		                     stno=$nxt line]]
	set MapEditedRS $nxt
	set sel $nxt
	set MapRTCurrent [list $xx $yy $fromit]
	$Map coords mkRTfrom $xx $yy $xx $yy
    } else {
	$Map addtag inRT=:$MapRTLast withtag forWP=$ix
	set toit [$Map find withtag WP=$name]
	set cs [$Map coords $toit]
	set xx [expr [lindex $cs 0]+1] ; set yy [expr [lindex $cs 1]+1]
	$Map coords mkRTfrom $xx $yy $xx $yy
	set oldit [lindex $MapRTCurrent 2]
	set is [$Map create line [lindex $MapRTCurrent 0] \
		[lindex $MapRTCurrent 1] $xx $yy \
		-fill $MAPCOLOUR(mkRT) -arrow last -smooth 0 \
		-width 2 -tags [list mkRT mkRTedge to=$toit from=$oldit \
		                     stno=$MapRTLast line]]
	set MapRTCurrent [list $xx $yy $toit]
	set sel end
    }
    GMRTChange insa $name
    GMRouteSelect $sel
    incr MapRTLast
    .gmRT.fr.fr3.frbt.del configure -state normal
    return
}

proc MapDelFromRT {which} {
    # delete WP from RT being built on map but fail if there is
    #  only one
    #  $which is either 0 (for 1st WP) or "sel" (for previous one)
    # GMRTChange will call MapDelRT1st or MapDelRTPrevious on success
    global MapMakingRT MapRTLast

    if { $MapMakingRT } {
	if { $MapRTLast == 0 } { bell ; return }
	GMRTChange del $which
    }
    return
}

proc MapDelRT1st {delwp} {
    # update map by deleting first WP on RT under construction on map
    global Map MapRTLast MapRTNewWPs MapEditedRS MapEditingRS

    if { $MapEditingRS } {
	if { $MapEditedRS == 0 } {
	    if { $MapRTLast == 1 } {
		MapContRTEnd
	    } else {
		MapChangeRTNextRS
	    }
	} else {
	    incr MapEditedRS -1
	}
    }
    # zero or one items will have this tag
    foreach it [$Map find withtag stno=0] {
	$Map delete $it
    }
    foreach it [$Map find withtag inRT=:-1] {
	$Map dtag $it inRT=:-1
    }
    if { [set i [lsearch -exact $MapRTNewWPs $delwp]] != -1 && \
	    [lsearch -exact [.gmRT.fr.fr3.fr31.frbx.box get 0 end] $delwp] == \
	    -1 } {
	set MapRTNewWPs [lreplace $MapRTNewWPs $i $i]
	Forget WP [IndexNamed WP $delwp]
    }
    incr MapRTLast -1
    # renumber items
    set i -1
    while { $i < $MapRTLast } {
	set nxt [expr $i+1]
	foreach it [$Map find withtag stno=$nxt] {
	    $Map dtag $it stno=$nxt ; $Map addtag stno=$i withtag $it
	}
	foreach it [$Map find withtag inRT=:$nxt] {
	    $Map dtag $it inRT=:$nxt ; $Map addtag inRT=:$i withtag $it
	}
	set i $nxt
    }
    return
}

proc MapDelRTPrevious {prevwp delwp} {
    # update map by deleting previous WP on RT under construction on map
    #  $delwp is name of deleted WP
    #  $prevwp is name of WP preceding $delwp
    global Map MapRTLast MapRTCurrent MapRTNewWPs MapEditingRS MapEditedRS \
	    MapRTNext MAPCOLOUR

    if { $MapEditingRS } {
	if { $MapEditedRS == 0 } {
	    MapDelRT1st $delwp
	    return
	}
	# zero or one items will have this tag
	foreach it [$Map find withtag stno=$MapEditedRS] {
	    $Map delete $it
	}
	incr MapEditedRS -1
	set sel [set stno $MapEditedRS]
    } else {
	set stno [expr $MapRTLast-1]
	set sel end
    }
    incr MapRTLast -1
    set cit [$Map find withtag WP=$prevwp]
    set cs [$Map coords $cit]
    set xx [expr [lindex $cs 0]+1] ; set yy [expr [lindex $cs 1]+1]
    $Map coords mkRTfrom $xx $yy $xx $yy
    set MapRTCurrent [list $xx $yy $cit]
    # zero or one items will have this tag
    foreach it [$Map find withtag stno=$stno] {
	$Map delete $it
    }
    foreach it [$Map find withtag inRT=:$stno] {
	$Map dtag $it inRT=:$stno
    }
    if { [set i [lsearch -exact $MapRTNewWPs $delwp]] != -1 && \
	    [lsearch -exact [.gmRT.fr.fr3.fr31.frbx.box get 0 end] $delwp] == \
	    -1 } {
	set MapRTNewWPs [lreplace $MapRTNewWPs $i $i]
	Forget WP [IndexNamed WP $delwp]
    }
    # renumber items
    set i $stno
    while { $i < $MapRTLast } {
	set nxt [expr $i+1]
	foreach it [$Map find withtag stno=$nxt] {
	    $Map dtag $it stno=$nxt ; $Map addtag stno=$i withtag $it
	}
	foreach it [$Map find withtag inRT=:$nxt] {
	    $Map dtag $it inRT=:$nxt ; $Map addtag inRT=:$i withtag $it
	}
	set i $nxt
    }
    if { $MapEditingRS } {
	GMRouteSelect $MapEditedRS
	# create RS
	set toit [lindex $MapRTNext 2]
	set is [$Map create line $xx $yy \
		[lindex $MapRTNext 0] [lindex $MapRTNext 1] \
		-fill $MAPCOLOUR(mapsel) -arrow last -smooth 0 \
		-width 2 -tags [list mkRT mkRTedge to=$toit \
		                  from=$cit stno=$MapEditedRS line]]
    } else {
	GMRouteSelect $MapRTLast
    }
    return
}

proc MapCancelRT {ask close} {
    # cancel construction of RT on map
    #  $ask is "ask" if cancellation must be confirmed when defining a new RT
    #  $close is "close" if RT window must be closed
    global MapMakingRT MapRTNewWPs MESS TXT GMRTIndex

    if { $MapMakingRT && \
	    ($GMRTIndex != -1 || "$ask" != "ask" || \
	     [GMConfirm [format $MESS(askforget) $TXT(nameRT)]]) } {
	MapDestroyRT
	foreach wp $MapRTNewWPs {
	    Forget WP [IndexNamed WP $wp]
	}
	if { "$close" == "close" } { GMButton RT cancel }
    }
    return
}

proc MapDestroyRT {} {
    # destroy RT being made on map
    global Map MapMakingRT MapRTLast

    set MapMakingRT 0
    $Map delete mkRT
    while { $MapRTLast >= 0 } {
	incr MapRTLast -1
	foreach it [$Map find withtag inRT=:$MapRTLast] {
	    $Map dtag $it inRT=:$MapRTLast
	}
    }
    return
}

proc MapChangeRTLastRS {} {
    # open previous RS for editing when creating RT on map
    global MapMakingRT MapEditingRS MapEditedRS Map MapRTLast MAPCOLOUR
    
    if { ! $MapMakingRT } { return }
    if { $MapEditingRS } {
	if { $MapEditedRS == 0 } { bell ; return }
	# restore stage being edited
	$Map itemconfigure stno=$MapEditedRS -fill $MAPCOLOUR(mkRT)
	# open stage before this one
	set n [expr $MapEditedRS-1]
    } else { set n [expr $MapRTLast-1] }
    if { "[set is [$Map find withtag stno=$n]]" == "" } { bell ; return }
    set ts [$Map gettags $is]
    set tx [lsearch -glob $ts to=*]
    set fx [lsearch -glob $ts from=*]
    if { $tx == -1 || $fx == -1 } { BUG "bad tags on stage" }
    regsub to= [lindex $ts $tx] "" toit
    regsub from= [lindex $ts $fx] "" fromit
    MapOpenStage -1 $n $is $fromit $toit
    return
}

proc MapChangeRTNextRS {} {
    # open next RS for editing when creating RT on map
    global MapMakingRT MapEditingRS MapEditedRS Map MapRTLast MAPCOLOUR
    
    if { ! $MapMakingRT || ! $MapEditingRS } { return }
    if { $MapEditedRS == $MapRTLast-1 } {
	MapContRTEnd
	return
    }
    # restore stage being edited
    $Map itemconfigure stno=$MapEditedRS -fill $MAPCOLOUR(mkRT)
    # open stage after this one
    set n [expr $MapEditedRS+1]
    if { "[set is [$Map find withtag stno=$n]]" == "" } { bell ; return }
    set ts [$Map gettags $is]
    set tx [lsearch -glob $ts to=*]
    set fx [lsearch -glob $ts from=*]
    if { $tx == -1 || $fx == -1 } { BUG "bad tags on stage" }
    regsub to= [lindex $ts $tx] "" toit
    regsub from= [lindex $ts $fx] "" fromit
    MapOpenStage -1 $n $is $fromit $toit
    return
}

proc MapContRTEnd {} {
    # finish editing RSs and continue at the end of RT being created on map
    global MapMakingRT MapEditingRS Map MapRTLast MapRTCurrent MapEditedRS \
	    MAPCOLOUR

    if { ! $MapMakingRT || ! $MapEditingRS } { return }
    $Map itemconfigure stno=$MapEditedRS -fill $MAPCOLOUR(mkRT)
    set n [expr $MapRTLast-1]
    if { "[set wpit [$Map find withtag sq2&&inRT=:$n]]" == "" } {
	BUG "no item for WP at end"
    }
    set cs [$Map coords $wpit]
    set x [expr [lindex $cs 0]+1] ; set y [expr [lindex $cs 1]+1]
    set MapRTCurrent [list $x $y $wpit]
    set MapEditingRS 0
    GMRouteSelect end
    $Map delete mkRTtrans
    $Map create line $x $y $x $y -fill $MAPCOLOUR(mkRT) -arrow first \
	    -smooth 0 -width 2 -tags [list mkRT mkRTfrom mkRTfrline mkRTtrans]
    $Map create oval [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
	    -fill $MAPCOLOUR(mkRT) \
	    -tags [list mkRT mkRTfrom mkRTcursor mkRTtrans]
    return
}

proc MapOpenStage {ix stno it fromit toit} {
    # open RT stage for editing on map
    #  $ix is RT index, -1 if RT is being built on map
    #  $stno is stage number (from 0)
    #  $it is map item of line representing the stage
    #  $fromit, $toit are the map items for the start and end WPs
    global MapMakingRT MapEditingRS Map MapRTCurrent MapRTNext MapEditedRS \
	    MAPCOLOUR

    if { $ix != -1 } {
	GMMessage "not yet" ; return
    }
    if { ! $MapMakingRT } { return }
    set MapEditedRS $stno
    GMRouteSelect $stno
    $Map itemconfigure $it -fill $MAPCOLOUR(mapsel)
    set cs [$Map coords $fromit]
    set xx [expr [lindex $cs 0]+1] ; set yy [expr [lindex $cs 1]+1]
    set MapRTCurrent [list $xx $yy $fromit]
    set cs [$Map coords $toit]
    set xx [expr [lindex $cs 0]+1] ; set yy [expr [lindex $cs 1]+1]
    set MapRTNext [list $xx $yy $toit]
    $Map create line $xx $yy $xx $yy -fill $MAPCOLOUR(mkRT) \
	    -arrow first -smooth 0 -width 2 \
	    -tags [list mkRT mkRTtoline mkRTtrans]
    set MapEditingRS 1
    return
}

proc MapWPsWithin {how d ix} {
    # map or clear all WPs with distance $d of WP with index $ix
    #  $how in {displ, clear}
    # when clearing the given WP will not be cleared
    global WPName WPPosn WPDatum WPDispl EdWindow GMWPIndex

    SetCursor . watch
    if { [winfo exists $EdWindow(WP)] } {
	set edix $GMWPIndex
    } else { set edix -1 }
    set displ [string compare $how clear]
    set p1 $WPPosn($ix) ; set d1 $WPDatum($ix)
    SetDatumData $d1
    foreach ix2 [array names WPName] {
	if { $ix2 != $ix && (($displ && ! $WPDispl($ix2)) || \
		             (! $displ && $WPDispl($ix2))) } {
	    set p2 $WPPosn($ix2) ; set d2 $WPDatum($ix2)
	    if  { "$d1" != "$d2" } {
		set p2 [ConvertDatum [lindex $p2 0] [lindex $p2 1] $d2 $d1 DDD]
	    }
	    if { $d >= [lindex [ComputeDistFD $p1 $p2] 0] } {
		MapOrClear WP $displ $ix2 $edix
	    }
	}
    }
    SetMapBounds
    ResetCursor .
    return
}

proc MapWPsInRect {how ix1 wp2} {
    # map or clear all WPs in the rectangle defined by the WPs with index $ix1
    #  and name $wp2
    #  $how in {displ, clear}
    # when clearing the given WP will not be cleared
    global WPName WPPosn WPDatum WPDispl EdWindow GMWPIndex

    SetCursor . watch
    if { [winfo exists $EdWindow(WP)] } {
	set edix $GMWPIndex
    } else { set edix -1 }
    set displ [string compare $how clear]
    set p1 $WPPosn($ix1) ; set d1 $WPDatum($ix1)
    SetDatumData $d1
    set ix2 [IndexNamed WP $wp2]
    set p2 $WPPosn($ix2) ; set d2 $WPDatum($ix2)
    if  { "$d1" != "$d2" } {
	set p2 [ConvertDatum [lindex $p2 0] [lindex $p2 1] $d2 $d1 DDD]
    }
    set la1 [lindex $p1 0] ; set lo1 [lindex $p1 1]
    set la2 [lindex $p2 0] ; set lo2 [lindex $p2 1]
    if { $la1 >= $la2 } {
	set lamx $la1 ; set lamn $la2
    } else { set lamx $la2 ; set lamn $la1 }
    if { $lo1 >= $lo2 } {
	set lomx $lo1 ; set lomn $lo2
    } else { set lomx $lo2 ; set lomn $lo1 }
    foreach ixn [array names WPName] {
	if { $ixn != $ix1 && (($displ && ! $WPDispl($ixn)) || \
		              (! $displ && $WPDispl($ixn))) } {
	    set pn $WPPosn($ixn) ; set dn $WPDatum($ixn)
	    if  { "$d1" != "$dn" } {
		set pn [ConvertDatum [lindex $pn 0] [lindex $pn 1] $dn $d1 DDD]
	    }
	    set lan [lindex $pn 0]
	    if { $lamx>=$lan && $lan>=$lamn } {
		set lon [lindex $pn 1]
		if { $lomx>=$lon && $lon>=$lomn } {
		    MapOrClear WP $displ $ixn $edix
		}
	    }
	}
    }
    SetMapBounds
    ResetCursor .
    return
}

proc MapRTsFor {ix how} {
    # map or clear all RTs that contain the WP with index $ix
    #  $how in {displ, clear}
    global WPRoute RTDispl EdWindow GMRTIndex GMRTDispl

    set displ [string compare $how clear]
    if { [winfo exists $EdWindow(RT)] } {
	set edix $GMRTIndex
    } else { set edix -1 }
    foreach rt $WPRoute($ix) {
	MapOrClear RT $displ [IndexNamed RT $rt] $edix
    }
    return
}

proc MapRTsForMappedWPs {how} {
    # map or clear all RTs for all mapped WPs
    #  $how in {displ, clear}
    global WPName WPDispl

    foreach ix [array names WPName] {
	if { $WPDispl($ix) } {
	    MapRTsFor $ix $how
	}
    }
    return
}

proc MapOrClear {wh displ ix edix} {
    # map or clear an item of type $wh in {WP, RT} with index $ix
    #  $displ is set if item is to be displayed
    #  $edix is the index of item being edited
    global GM${wh}Displ ${wh}Displ EdWindow

    if { $ix == $edix } {
	if { $displ } {
	    if { ! [set GM${wh}Displ] } {
		PutMap$wh $ix
		set GM${wh}Displ 1 ; set ${wh}Displ($ix) 1
		$EdWindow($wh).fr.displayed select
	    }
	} elseif { [set GM${wh}Displ] && [UnMap$wh $ix] } {
	    set GM${wh}Displ 0 ; set ${wh}Displ($ix) 0
	    $EdWindow($wh).fr.displayed deselect
	}
    } elseif { $displ } {
	PutMap$wh $ix
	set ${wh}Displ($ix) 1
    } elseif { [UnMap$wh $ix] } { set ${wh}Displ($ix) 0 }
    return
}

### background image

proc LoadMapBack {} {
    # load map background: either an image to be fixed, or information on
    #  an image and fixing information
    global Map File MESS

    if { "[$Map find all]" != "" && ! [GMConfirm $MESS(clrcurrmap)] } {
	return
    }
    set r [LoadMapFixedBk ""]
    switch -- [lindex $r 0] {
	0 {
	    LoadMapBackImage $File(MapBkInfo)
	}
	1 {
	    eval LoadMapBackGeoRef [lrange $r 1 end]
	}
  	2 {
#  	    # this is here only for supporting the old (<4.0) file format
#  	    eval LoadMapBackFixed [lrange $r 1 end]
  	}
    }
    return
}

proc BadImage {im filename} {
    # create image

    SetCursor . watch
    catch "image delete $im"
    set r [catch "image create photo $im -file $filename"]
    ResetCursor .
    return $r
}

proc MapCreateOriginImage {path} {
    # create map background image at origin
    # clear the map, disable scale and datum, and set image parameters
    global MpW Map MapImageFile MapImageHeight MapImageWidth MapImageItems \
	    MapImageGrid MAPW2 MAPH2 WConf

    DoClearMap
    $MpW.frm.frmap3.mn configure -state disabled
    $MpW.frm.frmap3.cv.val configure -text ?
    foreach b $WConf(mapdatum) { $b configure -state disabled }
    set MapImageFile(0,0) $path
    set MapImageHeight [image height MapImage]
    set MapImageWidth [image width MapImage]
    set MapImageItems [$Map create image 0 0 -image MapImage \
	    -anchor nw -tags [list map mapimage forIm=0,0]]
    SetMapBounds
    # scroll image to centre it
    ScrollMapTo [expr $MapImageWidth/2.0] [expr $MapImageHeight/2.0] \
	        $MAPW2 $MAPH2
    set MapImageGrid(dxmin) -1 ; set MapImageGrid(dymin) -1
    set MapImageGrid(dxn) 3 ; set MapImageGrid(dyn) 3
    return
}

proc LoadMapParams {datum pdata tdata pformt scale} {
    # load map parameters
    #  $pdata, $tdata describe projection and transformation and are pairs
    #   with name and list of pairs with parameter name and value
    # assume map is empty
    global MpW Map MPData MTData MapScale MapPFormat MapProjection \
	    MapProjTitle MapProjInitProc MapTransf \
	    MAPPROJDATA MAPPARTPDATA MAPPARTPROJ MAPPROJAUX

    ChangeMapDatum $datum
    set MapScale $scale
    catch "unset MPData" ; catch "unset MTData"
    MapProjectionIs [lindex $pdata 0]
    if { [catch "set mp $MAPPARTPROJ($MapProjection)"] } {
	foreach p [lindex $pdata 1] {
	    set MPData([lindex $p 0]) [lindex $p 1]
	}
    } else {
	foreach e $MAPPROJDATA($mp) v $MAPPARTPDATA($MapProjection) {
	    set MPData($e) $v
	}
    }
    set MPData(datum) $datum
    if { [lsearch -exact $MAPPROJAUX $MapProjection] != -1 } {
	Proj${MapProjection}ComputeAux MPData $datum
    }
    MapTransfIs [lindex $tdata 0]
    foreach p [lindex $tdata 1] {
	set MTData([lindex $p 0]) [lindex $p 1]
    }
    regsub {\.00 } [MapScaleToShow $scale] " " txt
    $MpW.frm.frmap3.cv.val configure -text $txt
    set MapPFormat $pformt
    return
}

proc LoadMapBackGeoRef {path datum pdata tdata scale ixps} {
    # load geo-referenced map background image
    #  $pdata, $tdata describe projection and transformation and are pairs
    #   with name and list of pairs with parameter name and value
    #  $ixps: list of image grid coordinates and path for subsidiary images
    global Map MapImageFile MapImageItems MapImageHeight MapImageWidth \
	    MapImageGrid MapEmpty MapPFormat MESS

    foreach ixp $ixps {
	set p [lindex $ixp 1]
	if { [BadImage MapImage[lindex $ixp 0] $p] } {
	    GMMessage "$MESS(badimage): $p"
	    return
	}
    }
    if { [BadImage MapImage $path] } {
	GMMessage "$MESS(badimage): $path"
	return
    }
    MapCreateOriginImage $path
    set dxmin 0 ; set dxmax 0 ; set dymin 0 ; set dymax 0
    foreach ixp $ixps {
	scan $ixp %d,%d%s dx dy p
	set MapImageFile($dx,$dy) $p
	set x [expr $MapImageWidth*$dx] ; set y [expr $MapImageHeight*$dy]
	set it [$Map create image $x $y \
		-image "MapImage$dx,$dy" -anchor nw \
		-tags [list map mapimage forIm=$dx,$dy]]
	$Map lower $it
	lappend MapImageItems $it
	if { $dx > $dxmax } { set dxmax $dx }
	if { $dy > $dymax } { set dymax $dy }
	if { $dx < $dxmin } { set dxmin $dx }
	if { $dy < $dymin } { set dymin $dy }
    }
    set MapImageGrid(dxmin) [expr $dxmin-1]
    set MapImageGrid(dymin) [expr $dymin-1]
    set MapImageGrid(dxn) [expr $dxmax+3-$dxmin]
    set MapImageGrid(dyn) [expr $dymax+3-$dymin]
    SetMapBounds
    LoadMapParams $datum $pdata $tdata $MapPFormat $scale
    set MapEmpty 0
    StatusMapBackMenu normal
    return
}

proc LoadMapBackImage {filename} {
    # load map background image to be geo-referenced from file under $filename
    global MpW Map MapLoading MapLdOldScale MapImageItems MapImageFile \
	    MapImageHeight MapImageWidth MapScInitVal EdWindow Number \
	    MAPKNOWNTRANSFS MESS TXT TYPES

    set ts "" ; set rs ""
    foreach t $MAPKNOWNTRANSFS {
	lappend ts $TXT(TRNSF$t) ; lappend rs $t
    }
    lappend ts $TXT(cancel) ; lappend rs 0
    switch [set how [GMSelect $MESS(georefhow) $ts $rs]] {
	0 {
	    return
	}
	AffineConf {
	    set n 2
	}
	Affine -
	NoRot {
	    set n 3
	}
	default {
	    GMMessage "Bug: missing case for transformation"
	    return
	}
    }
    if { $Number(WP) < $n } {
	GMMessage [format $MESS(cantfix) $n]
	return
    }
    if { [BadImage MapImage $filename] } {
	GMMessage $MESS(badimage)
	return
    }
    MapCreateOriginImage [file join [pwd] $filename]
    if { [scan [$MpW.frm.frmap3.cv.val cget -text] %d MapLdOldScale] != 1 } {
	set MapLdOldScale $MapScInitVal
    }
    foreach wh $TYPES {
	if { [winfo exists $EdWindow($wh)] } {
	    $EdWindow($wh).fr.displayed configure -state disabled
	}
    }
    set MapLoading ${how}=$n
    MapLoadBkDial $how $n
    return
}

proc MapLoadBkDial {how n} {
    # dialog used during map background loading
    #  $how in $MAPKNOWNTRANSFS
    #  $n is number of WPs used for geo-referencing
    global WPName MapLoadWPs MapLoadWPNs NAMEWIDTH TXT MESS COLOUR EPOSX EPOSY

    destroy .wmapload
    set w .wmapload
    toplevel $w
    wm protocol $w WM_DELETE_WINDOW { MapLoadBkCancel }
    wm title $w "GPS Manager: $TXT(mapload)"
    wm transient $w
    wm geometry $w +[expr $EPOSX+100]+$EPOSY

    frame $w.fr -borderwidth 5 -bg $COLOUR(messbg)
    label $w.fr.title -text $TXT(mapload) -relief sunken
    message $w.fr.text -aspect 800 -text [format $MESS(mapaskWPs) $n]
    listbox $w.fr.bx -height 3 -width $NAMEWIDTH -relief flat \
 	    -selectmode single -exportselection 1
    frame $w.fr.bns
    button $w.fr.bns.ok -text Ok -command MapLoadBkDialDone -state disabled
    button $w.fr.bns.cnc -text $TXT(cancel) -command MapLoadBkCancel
    pack $w.fr -side top
    pack $w.fr.bns.ok $w.fr.bns.cnc -side left
    pack $w.fr.title $w.fr.text $w.fr.bx $w.fr.bns -side top -pady 5
    update idletasks

    set no $n ; set MapLoadWPs ""
    while { $no > 0 } {
	if { "[set wps [ChooseItems WP]]" == "" } {
	    MapLoadBkCancel
	    return
	}
	foreach ix $wps {
	    set nn $WPName($ix) ; set d 0
	    foreach n [$w.fr.bx get 0 end] {
		if { "$n" == "$nn" } { set d 1 ; break }
	    }
	    if { $d } {
		GMMessage [format $MESS(duplicate) $nn]
	    } else {
		$w.fr.bx insert end $nn
		lappend MapLoadWPs $ix
		incr no -1
		if { $no == 0 } { break }
	    }
	}
    }
    $w.fr.text configure -text $MESS(mapadjust)
    switch $how {
	NoRot {
	    set MapLoadWPNs [$w.fr.bx get 0 end]
	    MapComputePositions
	}
	AffineConf {
	    set MapLoadWPNs [list [$w.fr.bx get 1 1] [$w.fr.bx get 0 0]]
	    set MapLoadWPs [list [lindex $MapLoadWPs 1] [lindex $MapLoadWPs 0]]
	}
	Affine {
	    set MapLoadWPNs [list [$w.fr.bx get 2 2] [$w.fr.bx get 1 1] \
		    [$w.fr.bx get 0 0]]
	    set MapLoadWPs [list [lindex $MapLoadWPs 2] \
		    [lindex $MapLoadWPs 1] [lindex $MapLoadWPs 0]]
	}
    }
    # control will be assumed by MapCursor, MarkMapPoint and MapLoadBkDialDone

    return
}

proc MapLoadRestore {} {
    # restore interface state after success or failure of map loading
    global MapLoading MapLoadPos EdWindow TYPES

    foreach wh $TYPES {
	if { [winfo exists $EdWindow($wh)] } {
	    $EdWindow($wh).fr.displayed configure -state normal
	}
    }
    set MapLoading 0
    destroy .wmapload
    catch "unset MapLoadPos"
    return
}

proc MapLoadBkDialDone {} {
    # successful end of map background loading dialog
    global Map MapLoading MapScale MapLoadWPs MapLoadPos MapEmpty EdWindow \
	    WPDispl GMWPIndex GMWPDispl GMWPData MESS MPData MTData

    catch "unset MTData"
    switch -glob $MapLoading {
	Affine=* {
	    if {! [MapInitAffineTransf] } {
		GMMessage $MESS(cantsolve)
		MapLoadBkCancel
		return
	    }
	}
	AffineConf=* {
	    if {! [MapInitAffineConfTransf] } {
		GMMessage $MESS(cantsolve)
		MapLoadBkCancel
		return
	    }
	}
	NoRot=* {
	    MapInitNoRotTransf $MapScale $MapLoadPos(xt0) $MapLoadPos(yt0) \
		    $MapLoadPos(origin,x) $MapLoadPos(origin,y)
	}
    }
    MapScaleChange $MapScale
    MapLoadRestore
    set MapEmpty 0
    $Map delete mapadjust
    StatusMapBackMenu normal
    set ned ""
    foreach wpix $MapLoadWPs {
	set WPDispl($wpix) 1
	if { [winfo exists $EdWindow(WP)] && $GMWPIndex == $wpix } {
	    set GMWPDispl 1
	    set GMWPData [lreplace $GMWPData end end 1]
	    $EdWindow(WP).fr.displayed select
	} else {
	    SetDisplShowWindow WP $wpix select
	}
    }
    return
}

proc MapLoadBkCancel {} {
    # cancel loading a map background image
    global MpW Map MapLoading MapLdOldScale MapImageItems

    eval $Map delete [$Map find all]
    set MapImageItems ""
    SetMapBounds
    if { $MapLoading != 0 } {
	MapLoadRestore
	# now $MapLoading is 0
	$MpW.frm.frmap3.mn configure -state normal
	MapScaleChange $MapLdOldScale
    }
    return
}

proc MapGeoRefPoints {n} {
    # compute planar Cartesian coordinates of $n WPs for geo-referencing
    #  and initialize projection procedure
    #  $MapLoadWPs is list of indices of relevant WPs
    # set MapLoadPos(latd), MapLoadPos(longd) to coords of 1st WP, relative
    #  to $Datum
    global Datum MapLoadWPs MapLoadPos WPPosn WPDatum MapProjInitProc \
	    MapProjPointProc MPData Datum

   for { set i 0 ; set ps "" } { $i < $n } { incr i } {
       set ix [lindex $MapLoadWPs $i]
       set p $WPPosn($ix)
       set latd [lindex $p 0] ; set longd [lindex $p 1]
       if { "[set datum $WPDatum($ix)]" != "$Datum" } {
	   set p [ConvertDatum $latd $longd $datum $Datum DDD]
	   set latd [lindex $p 0] ; set longd [lindex $p 1]
       }
       if { $i == 0 } {
	   set MapLoadPos(latd) $latd ; set MapLoadPos(longd) $longd
       }
       lappend ps [list $latd $longd $Datum]
   }
   catch "unset MPData"
   $MapProjInitProc MPData $Datum $ps
   set xys ""
   foreach p $ps {
       lappend xys [eval $MapProjPointProc MPData $p]
   }
   return $xys
}

proc MapComputePositions {} {
    # compute lines from 1st to 2nd and 1st to 3rd selected WPs
    #  when loading a map background image with no rotation
    # set MapLoadPos(xt0),MapLoadPos(yt0) to terrain coords of 1st WP
    global MapLoadPos MAPWIDTH MAPHEIGHT

    set tcs [MapGeoRefPoints 3]
    set p0 [lindex $tcs 0]
    set MapLoadPos(xt0) [set xt0 [lindex $p0 0]]
    set MapLoadPos(yt0) [set yt0 [lindex $p0 1]]
    set mx $MAPWIDTH
    if { $MAPHEIGHT > $MAPWIDTH } { set mx $MAPHEIGHT }
    incr mx 10000
    foreach a "1 2" {
	set p [lindex $tcs $a]
	set xta [lindex $p 0] ; set yta [lindex $p 1]
	set MapLoadPos(dmx,$a) [set dx [expr $xta-$xt0]]
	set MapLoadPos(dmy,$a) [set dy [expr $yt0-$yta]]
	if { abs($dx) >= abs($dy) } {
	    set MapLoadPos(dir,$a) x
	} else {
	    set MapLoadPos(dir,$a) y
	}
	set l [expr sqrt(1.0*$dx*$dx+1.0*$dy*$dy)]
        set x [expr 100+$mx/$l*$dx] ; set y [expr 100+$mx/$l*$dy]
	set MapLoadPos(pos,$a) [list 100 100 $x $y]
	set MapLoadPos(dx,$a) [expr $x-100]
	set MapLoadPos(dy,$a) [expr $y-100]
    }
    return
}

proc ClearMapBack {} {
    # clear map background images
    global MpW Map MapImageItems MapImageFile MESS

    if { [GMConfirm $MESS(okclrbkmap)] } {
	$Map delete mapimage
	set MapImageItems "" ; catch "unset MapImageFile"
	$MpW.frm.frmap3.mn configure -state normal
	StatusMapBackMenu disabled
	return 1
    }
    return 0
}

proc OverBackImage {its} {
    # check if list of map items $its contains only a background image item
    global MapImageItems

    if { [llength $its] > 1 } { return 0 }
    foreach it $MapImageItems {
	if { $it == $its } { return 1 }
    }
    return 0
}

proc SaveMapBack {args} {
    # save map background image information
    #  $args is either "" or file
    global Map MapImageFile MapScale MapProjection MPData MapTransf MTData \
	    MAPPARTPROJ MAPPROJDATA MAPTRANSFDATA

    if { "[$Map find withtag mapimage]" == "" } { return }
    set pd $MapProjection
    if { [catch "set MAPPARTPROJ($MapProjection)"] } {
	foreach e $MAPPROJDATA($MapProjection) {
	    lappend pd "$e=$MPData($e)"
	}
    }
    set pt $MapTransf
    foreach e $MAPTRANSFDATA($MapTransf) {
	lappend pt "$e=$MTData($e)"
    }
    set l ""
    foreach ixs [array names MapImageFile] {
	if { "$ixs" != "0,0" } {
	    set l [linsert $l 0 [list $ixs $MapImageFile($ixs)]]
	}
    }
    SaveFileTo $args mapback MapBkInfo $MapImageFile(0,0) $pd $pt $MapScale $l
    return
}

proc SaveMapParams {args} {
    # save map projection, transformation, position format of coordinates
    #  and scale when there is no background image
    #  $args is either "" or file
    global Map MapScale MapProjection MPData MapTransf MTData MapPFormat \
	    MAPPARTPROJ MAPPROJDATA MAPTRANSFDATA

    if { "[$Map find withtag mapimage]" != "" } { return }
    set pd $MapProjection
    if { [catch "set MAPPARTPROJ($MapProjection)"] } {
	foreach e $MAPPROJDATA($MapProjection) {
	    lappend pd "$e=$MPData($e)"
	}
    }
    set pt $MapTransf
    foreach e $MAPTRANSFDATA($MapTransf) {
	lappend pt "$e=$MTData($e)"
    }
    SaveFileTo $args mapinfo MapInfo $pd $pt $MapPFormat $MapScale
    return
}

proc ChangeMapBack {} {
    # dialog used to change map background images
    global MapImageGrid MapImageFile TXT EPOSX EPOSY COLOUR MAPCOLOUR

    # name .wchgmapbak used explicitly below
    set w .wchgmapbak
    if { [winfo exists $w] } { Raise $w ; return }

    toplevel $w
    wm protocol $w WM_DELETE_WINDOW "destroy $w"
    wm title $w "GPS Manager: $TXT(mpbkchg)"
    wm transient $w
    wm geometry $w +[expr $EPOSX+100]+$EPOSY

    frame $w.fr -borderwidth 5 -bg $COLOUR(messbg)
    label $w.fr.title -text $TXT(mpbkchg) -relief sunken
    set rw 43 ; set rh 21
    set wd [expr 3*$rw] ; set hg [expr 3*$rh]
    canvas $w.fr.grid -width $wd -height $hg -relief sunken \
	    -xscrollincrement $rw -yscrollincrement $rh
    set cv $w.fr.grid
    # make central 3x3 grid: canvas 0,0 is upper left corner of -1,-1 slot
    for { set dx -1 } { $dx < 2 } { incr dx } {
	MapColumnBackGrid $cv $dx -1 3 $rw $rh
    }
    # extend grid if needs be
    foreach d "x y" h "Column Row" \
	    omin "-1 $MapImageGrid(dxmin)" on "3 $MapImageGrid(dxn)" {
	if { [set d0 $MapImageGrid(d${d}min)] < -1 } {
	    for { set dd $d0 } { $dd < -1 } { incr dd } {
		Map${h}BackGrid $cv $dd $omin $on $rw $rh
		set bb [$cv bbox all]
		set x0 [lindex $bb 0] ; set y0 [lindex $bb 1]
		set x1 [lindex $bb 2] ; set y1 [lindex $bb 3]
		$cv configure -width [expr $x1-$x0] -height [expr $y1-$y0]
		$cv ${d}view scroll -1 units
	    }
	}
	if { [set df [expr $d0+$MapImageGrid(d${d}n)]] > 1 } {
	    for { set dd 2 } { $dd < $df } { incr dd } {
		Map${h}BackGrid $cv $dd $omin $on $rw $rh
		set bb [$cv bbox all]
		set x0 [lindex $bb 0] ; set y0 [lindex $bb 1]
		set x1 [lindex $bb 2] ; set y1 [lindex $bb 3]
		$cv configure -width [expr $x1-$x0] -height [expr $y1-$y0]
	    }
	}
    }

    foreach ixs [array names MapImageFile] {
	$cv itemconfigure forIm=$ixs -fill $MAPCOLOUR(fullgrid)
    }
    $cv itemconfigure forIm=0,0 -width 4 -outline $MAPCOLOUR(mapsel)
    set it [$cv create text [expr 1.5*$rw] [expr 1.5*$rh] -anchor center \
	     -text + -justify center]
    $cv bind $it <Enter> "MapBackGridEnter 0 0"
    $cv bind $it <Leave> "MapBackGridLeave 0 0"
    $cv bind $it <Button-1> "MapBackGridSelect 0 0"

    frame $w.fr.cs
    label $w.fr.cs.tit -text $TXT(mpbkgrcs):
    label $w.fr.cs.cs -text 0,0

    frame $w.fr.pt
    label $w.fr.pt.tit -text $TXT(file):
    label $w.fr.pt.pt -text $MapImageFile(0,0) -width 50

    frame $w.fr.bns
    button $w.fr.bns.ld -text $TXT(load) \
	    -command "MapBackGridLoad $rw $rh ; \
	              $w.fr.bns.ld configure -state normal"
    button $w.fr.bns.clr -text $TXT(clear) -state disabled \
	    -command "MapBackGridClear ; $w.fr.bns.clr configure -state normal"
    button $w.fr.bns.clrall -text $TXT(clearall) \
	    -command {
	      if { [ClearMapBack] } {
		  destroy .wchgmapbak
	      } else {
		  .wchgmapbak.fr.bns.clrall configure -state normal
	      }
	    }
    button $w.fr.bns.ok -text Ok -command "destroy $w"

    pack $w.fr -side top
    pack $w.fr.cs.tit $w.fr.cs.cs -side left
    pack $w.fr.pt.tit $w.fr.pt.pt -side left
    pack $w.fr.bns.ld $w.fr.bns.clr $w.fr.bns.clrall $w.fr.bns.ok -side left
    pack $w.fr.title $w.fr.grid $w.fr.cs $w.fr.pt $w.fr.bns -side top -pady 5
    update idletasks

    return
}

proc MapBackGridEnter {dx dy} {
    # cursor on image grid slot
    global MAPCOLOUR

    set cv .wchgmapbak.fr.grid
    $cv itemconfigure forIm=$dx,$dy -fill $MAPCOLOUR(mapsel)
    return
}

proc MapBackGridLeave {dx dy} {
    # cursor out of image grid slot
    global MAPCOLOUR MapImageFile

    set cv .wchgmapbak.fr.grid
    if { [catch "set MapImageFile($dx,$dy)"] } {
	set c emptygrid
    } else { set c fullgrid }
    $cv itemconfigure forIm=$dx,$dy -fill $MAPCOLOUR($c)
    return
}

proc MapBackGridSelect {dx dy} {
    # click on an image grid slot
    global MAPCOLOUR MapImageFile

    set fr .wchgmapbak.fr ; set cv $fr.grid
    set last [$fr.cs.cs cget -text]
    if { [catch "set p $MapImageFile($dx,$dy)"] } {
	set p ""
	$fr.bns.clr configure -state disabled
    } else {
	if { "$dx,$dy" != "0,0" } {
	    $fr.bns.clr configure -state normal
	}
    }
    $cv itemconfigure forIm=$last -width 2 -outline black
    $cv itemconfigure forIm=$dx,$dy -width 4 -outline $MAPCOLOUR(mapsel)
    .wchgmapbak.fr.cs.cs configure -text $dx,$dy
    .wchgmapbak.fr.pt.pt configure -text $p
    return
}

proc MapBackGridLoad {rw rh} {
    # (re-)load one image for map background
    #  $rw: width of grid rectangle
    #  $rh: height of grid rectangle
    global Map MapImageFile MapImageWidth MapImageHeight MapImageItems \
	    MapImageGrid File MESS TXT MAPCOLOUR

    set fr .wchgmapbak.fr
    scan [set cs [$fr.cs.cs cget -text]] %d,%d dx dy
    if { "[set f [GMOpenFile $TXT(loadfrm) Image r]]" != ".." } {
	set filename $File(Image)
	if { [BadImage MapImage$cs $filename] } {
	    GMMessage $MESS(badimage)
	    return
	}
	set MapImageFile($cs) [file join [pwd] $filename]
	$fr.pt.pt configure -text $MapImageFile($cs)
	set cv $fr.grid
	$cv itemconfigure forIm=$cs -fill $MAPCOLOUR(fullgrid)
	$Map delete forIm=$cs
	set x [expr $MapImageWidth*$dx] ; set y [expr $MapImageHeight*$dy]
	set it [$Map create image $x $y \
		-image "MapImage$cs" -anchor nw \
		-tags [list map mapimage forIm=$cs]]
	$Map lower $it
	lappend MapImageItems $it
	SetMapBounds
	MapWideBackGrid $cv x $dx Column \
		$MapImageGrid(dymin) $MapImageGrid(dyn) $rw $rh
	MapWideBackGrid $cv y $dy Row \
		$MapImageGrid(dxmin) $MapImageGrid(dxn) $rw $rh
	$fr.bns.clr configure -state normal
    }
    return
}

proc MapBackGridClear {} {
    # clear one image from map background
    global Map MapImageFile MapImageItems MapImageGrid MAPCOLOUR MESS

    set fr .wchgmapbak.fr
    scan [set cs [$fr.cs.cs cget -text]] %d,%d dx dy
    if { [GMConfirm "$MESS(okclrbkim) $cs"] } {
	set it [$Map find withtag forIm=$cs]
	$Map delete forIm=$cs
	SetMapBounds
	$fr.bns.clr configure -state disabled
	catch "image delete MapImage$cs ; unset MapImageFile($cs)"
	if { [set ix [lsearch -exact $MapImageItems $it]] >= 0 } {
	    set MapImageItems [lreplace $MapImageItems $ix $ix]
	}
	set cv $fr.grid
	$cv itemconfigure forIm=$cs -fill $MAPCOLOUR(emptygrid)
	if { ([MapShrinkBackGrid $cv x $dx %d,*] | \
		[MapShrinkBackGrid $cv y $dy *,%d]) && \
		"[$cv find withtag forIm=$dx,$dy]" == "" } {
	    $cv itemconfigure forIm=0,0 -outline $MAPCOLOUR(mapsel)
	    $fr.cs.cs configure -text 0,0
	    $fr.pt.pt configure -text $MapImageFile(0,0)
	} else {
	    $fr.pt.pt configure -text ""
	}
    }
    return
}

proc MapColumnBackGrid {gr dx dymin dyn rw rh} {
    # make column of grid in dialog used to change map
    #  background images
    #  $gr: canvas with grid
    #  $dx: grid coordinate
    #  $dymin: min grid y-coordinate
    #  $dyn: number of slots along y-coordinate
    #  $rw, $rh: rectangle dimensions
    global MapImageGrid MAPCOLOUR

    set m [expr $dymin+$dyn]
    for { set dy $dymin } { $dy < $m } { incr dy } {
	set it [$gr create rectangle [expr ($dx+1)*$rw+2] \
		[expr ($dy+1)*$rh+2] [expr ($dx+2)*$rw] \
		[expr ($dy+2)*$rh] -width 2 -fill $MAPCOLOUR(emptygrid) \
		-tags [list grid forIm=$dx,$dy]]
	$gr bind $it <Enter> "MapBackGridEnter $dx $dy"
	$gr bind $it <Leave> "MapBackGridLeave $dx $dy"
	$gr bind $it <Button-1> "MapBackGridSelect $dx $dy"
    }
    return
}

proc MapRowBackGrid {gr dy dxmin dxn rw rh} {
    # make row of grid in dialog used to change map
    #  background images
    #  $gr: canvas with grid
    #  $dy: grid coordinate
    #  $dxmin: min grid x-coordinate
    #  $dxn: number of slots along x-coordinate
    #  $rw, $rh: rectangle dimensions
    global MapImageGrid MAPCOLOUR

    set m [expr $dxmin+$dxn]
    for { set dx $dxmin } { $dx < $m } { incr dx } {
	set it [$gr create rectangle [expr ($dx+1)*$rw+2] \
		[expr ($dy+1)*$rh+2] [expr ($dx+2)*$rw] \
		[expr ($dy+2)*$rh] -width 2 -fill $MAPCOLOUR(emptygrid) \
		-tags [list grid forIm=$dx,$dy]]
	$gr bind $it <Enter> "MapBackGridEnter $dx $dy"
	$gr bind $it <Leave> "MapBackGridLeave $dx $dy"
	$gr bind $it <Button-1> "MapBackGridSelect $dx $dy"
    }
    return
}

proc MapWideBackGrid {gr dir c how omin on rw rh} {
    # add external row/column of grid in dialog used to change map
    #  background images if the external row/column becomes non-empty
    #  $gr: canvas with grid
    #  $dir in {x, y}
    #  $c: grid coordinate along $dir
    #  $how in {Row, Column} according to $dir
    #  $omin: min grid coordinate along other direction
    #  $on: number of slots along other direction
    #  $rw, $rh: rectangle dimensions
    global MapImageGrid

    if { $c != 0 } {
	set chg 0 ; set dd d$dir
	if { $c == [set m $MapImageGrid(${dd}min)] } {
	    set chg 1 ; set scr -1
	    incr MapImageGrid(${dd}min) -1 ; incr MapImageGrid(${dd}n)
	    Map${how}BackGrid $gr $MapImageGrid(${dd}min) $omin $on $rw $rh
	} elseif { $c == [expr $MapImageGrid(${dd}n)+$m-1] } {
	    set chg 1 ; set scr 0
	    incr MapImageGrid(${dd}n)
	    Map${how}BackGrid $gr [expr $c+1] $omin $on $rw $rh
	}
	if { $chg } {
	    set bb [$gr bbox all]
	    set x0 [lindex $bb 0] ; set y0 [lindex $bb 1]
	    set x1 [lindex $bb 2] ; set y1 [lindex $bb 3]
	    $gr configure -width [expr $x1-$x0] -height [expr $y1-$y0]
	    $gr ${dir}view scroll $scr units
	}
    }
    return
}

proc MapShrinkBackGrid {gr dir c fmt} {
    # delete external row/column of grid in dialog used to change map
    #  background images if its neighbour becomes empty (external rows
    #  and columns are always empty; minimum size is 3x3, as slot with
    #  origin is never emptied)
    # return 1 if there was shrinking
    #  $gr: canvas with grid
    #  $dir in {x, y}
    #  $c: grid coordinate along $dir
    #  $fmt in {"%d,*", "*,%d"}
    global MapImageGrid MapImageFile

    set chg 0
    if { $c != 0 } {
	set dd d$dir ; set patt [format $fmt $c]
	if { $c == [set c1 [expr $MapImageGrid(${dd}min)+1]] && \
		[NoBackImageAt $patt] } {
	    set chg 1 ; set scr 1 ; incr MapImageGrid(${dd}min)
	} elseif { $c == [expr $MapImageGrid(${dd}n)+$c1-3] && \
		[NoBackImageAt $patt] } {
	    set chg 1 ; set scr 0
	}
	if { $chg } {
	    incr MapImageGrid(${dd}n) -1
            set dc [expr 1-$scr-$scr]
            set cd [expr $c+$dc] ; set patt [format $fmt $cd]
	    foreach it [$gr find withtag grid] {
		if { [lsearch -glob [$gr gettags $it] forIm=$patt] != -1 } {
		    $gr delete $it
		}
	    }
	    set bb [$gr bbox all]
	    set x0 [lindex $bb 0] ; set y0 [lindex $bb 1]
	    set x1 [lindex $bb 2] ; set y1 [lindex $bb 3]
	    $gr configure -width [expr $x1-$x0] -height [expr $y1-$y0]
	    $gr ${dir}view scroll $scr units
	    if { abs($c) != 1 } {
		MapShrinkBackGrid $gr $dir [expr $c-$dc] $fmt
	    }
	}
    }
    return $chg
}

proc NoBackImageAt {patt} {
    # check whether there is a loaded image with coordinates of given pattern
    global MapImageFile

    if { [lsearch -glob [array names MapImageFile] $patt] == -1 } {
	return 1
    }
    return 0
}

proc StatusMapBackMenu {st} {
    # change status of Save/Change/Clear options in Backrgnd menu
    global WConf

    set m $WConf(mapstateback)
    for { set i 1 } { $i < 4 } { incr i } {
	$m entryconfigure $i -state $st
    }
    return
}

## BSB contribution

proc LoadIndexedMap {path} {
    # this loads a fixed or geo-referenced image as background for the map

    set r [LoadMapFixedBk $path]
    switch -- [lindex $r 0] {
	0 {
	    # no geo-referencing during auto-load
	}
	1 {
	    eval LoadMapBackGeoRef [lrange $r 1 end]
	}
#  	2 {
#  	    # this is here only for supporting the old (<4.0) file format
#  	    eval LoadMapBackFixed [lrange $r 1 end]
#  	}
    }
    return
}


#### locate or clear items on map

proc Locate {wh ix it} {
    # scroll map to get displayed item on centre
    #  $wh in $TYPES
    #  $it is map item for main element of (data-base) item
    global Map OVx OVy MAPW2 MAPH2

    if { "[set cs [$Map coords $it]]" != "" } {
	ScrollMapTo [lindex $cs 0] [lindex $cs 1] \
		[expr $OVx+$MAPW2] [expr $OVy+$MAPH2]
    }
    return
}

proc FillMappedMenus {menu comm} {
    # fill menus under $menu with items currently displayed on map
    #  $comm is command to invoke with the following arguments:
    #     type (in $TYPES), item index and map item
    global Map TXT MAXMENUITEMS RTIdNumber RTWPoints TRName TYPES

    foreach wh $TYPES {
	if { [winfo exists $menu.w$wh] } {
	    destroy $menu.w$wh
	}
	menu $menu.w$wh -tearoff 0
	set ns$wh ""
    }
    set rts ""
    foreach it [$Map find withtag WP] {
	set ts [$Map gettags $it]
	if { [set k [lsearch -glob $ts WP=*]] != -1 } {
	    regsub WP= [lindex $ts $k] "" n
	    lappend nsWP [list $n $it]
	}
	if { [set k [lsearch -glob $ts {inRT=[0-9]*}]] != -1 } {
	    regsub inRT= [lindex $ts $k] "" ix
	    if { [lsearch -exact $rts $ix] == -1 } { lappend rts $ix }
	}
    }
    foreach ix $rts {
	set fwpn [lindex $RTWPoints($ix) 0]
	if { "[set it [$Map find withtag WP=$fwpn]]" != "" } {
	    lappend nsRT [list $RTIdNumber($ix) $it]
	}
    }
    foreach it [$Map find withtag TRfirst] {
	set ts [$Map gettags $it]
	if { [set k [lsearch -glob $ts TR=*]] != -1 } {
	    regsub TR= [lindex $ts $k] "" ix
	    if { $ix != -1 } {
		lappend nsTR [list $TRName($ix) $it]
	    }
	}
    }
    set mentry 0
    foreach wh $TYPES {
	if { "$wh" != "GR" } {
	    if { "[set ns$wh]" == "" } {
		set st disabled
	    } else {
		set st normal
		set ns [lsort -dictionary -index 0 [set ns$wh]]
		set mw $menu.w$wh
		set n 0 ; set m 0
		foreach p $ns {
		    if { $n > $MAXMENUITEMS } {
			$mw add cascade -label "$TXT(more) ..." -menu $mw.m$m
			set mw $mw.m$m ; menu $mw -tearoff 0
			set n 0 ; incr m
		    }
		    set name [lindex $p 0]
		    $mw add command -label $name \
			    -command "$comm $wh [IndexNamed $wh $name] \
			                    [lindex $p 1]"
		    incr n
		}
	    }
	    $menu entryconfigure $mentry -state $st
	    incr mentry
	}
    }
    return
}

### menus for displaying items not already mapped

proc FillDispMenus {menu} {
    # fill menus under $menu with items currently not displayed on map
    #  except in case of GRs
    global Map TXT MAXMENUITEMS TYPES Storage

    set mentry 0
    foreach wh $TYPES {
	set mw $menu.w$wh
	if { [winfo exists $mw] } { destroy $mw }
	set ids [lindex $Storage($wh) 0]
	global $ids

	menu $mw -tearoff 0
	set n 0 ; set m 0
	set ns ""
	foreach ix [array names $ids] {
	    if { "[$Map find withtag for$wh=$ix]" == "" } {
		lappend ns [list [set [set ids]($ix)] $ix]
	    }
	}
	if { "$ns" != "" } {
	    set st normal
	    foreach p [lsort -dictionary -index 0 $ns] {
		if { $n > $MAXMENUITEMS } {
		    $mw add cascade -label "$TXT(more) ..." -menu $mw.m$m
		    set mw $mw.m$m ; menu $mw -tearoff 0
		    set n 0 ; incr m
		}
		$mw add command -label [lindex $p 0] \
			-command "PutMap $wh [lindex $p 1]"
		incr n
	    }
	} else {
	    set st disabled
	}
	$menu entryconfigure $mentry -state $st
	incr mentry
    }
    return
}
