gpsman 6.4.4.2-2 / usr / lib / gpsman / map.tcl

#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de
#
#    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 3 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:  6 October 2013
#
# Includes contributions by
#  - Brian Baulch (baulchb _AT_ onthenet.com.au) marked "BSB contribution"
#  - Stefan Heinen (stefan.heinen _AT_ djh-freeweb.de) marked "SH contribution"
#  - David Gardner (djgardner _AT_ users.sourceforge.net) marked "DJG contribution"
#  - Rudolf Martin (rudolf.martin _AT_ gmx.de) marked "RM 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
#    lines of RSs (RT stages):
#               RT forRT=$ix from=$itWP to=$itWP stno=$number (>=0) line
#    labels of RSs: RT forRT=$ix lab txt
#    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
#    first point in LNs: LN forLN=$ix LNfirst LN=$ix sq2
#    lines in LNs: LN forLN=$ix line
#    lines for measuring distance: measure mseg=$number (>0)
#    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 in grid: mapimage forIm=$dx,$dy
#    background images not in grid: mapimage forIm=$number
#    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
#    when simplifying/converting TR to RT/TR, with $w a window path,
#     $n a natural number:
#      - lines in converted RT/TR: exp=$w expconv=$w line
#      - turnpoints in converted RT/TR: exp=$w expconv=$w sq2 lab=$n.$n
#      - TR elements: exp=$w expTR=$w (in addition to normal tags)
##

### map bindings
#
# - by event
#
# <Key-Up>	& scroll up (move map down) slowly
# <Shift-Up>	& scroll NE (move map SW) slowly
# <Key-Down>	& scroll down (move map up) slowly
# <Shift-Down>	& scroll SW (move map NE) slowly
# <Key-Left>	& scroll left (move map right) slowly
# <Shift-Right>	& scroll SE (move map NW) slowly
# <Shift-Left>	& scroll NW (move map SE) slowly
# <Key-Right>	& scroll right (move map left) slowly
# <Key-Delete>	& scroll up (move map down) fast
# <Key-space>	& scroll down (move map up) fast
# <Return>	& create waypoint
#
# <Control-Motion> & panning slowly			% <---- SH
#
# <Button-1>	& create waypoint, or
#  		& add waypoint to route being edited on map (if any)
# <Double-1>	& open item (if over item)
# <Control-1>	& open waypoint menu (if over waypoint); otherwise
#  		& Unix: open route menu if editing it on the map
#  		& non-Unix: finish edition of route on map
# <Shift-1>	& delete waypoint from route being edited on map (if any)
#
# <B2-Motion>	& panning fast
# <Shift-2>	& cancel edition of route on map
#
# <Button-3>	& stop motion of waypoint (if one moving)
#  		& Unix: finish edition of route on map
#  		& non-Unix: open waypoint menu (if over waypoint); otherwise
#  		& non-Unix: open route menu if editing it on the map
# <Control-3>	& edit previous stage of route being edited on map (if any)
# <Shift-3>	& mark position to measure distance and compute azimuth
#                    (not when loading image or editing a route on map)
# <Control-Shift-3>
#  		& edit next stage of route being edited on map (if any)
#
# <Button-4>	& scroll up (move map down)
# <Shift-4>	& scroll up (move map down) fast
# <Control-4>	& scroll left (move map right) fast
# <Alt-4>		& scroll left (move map right)
# <Button-5>	& scroll down (move map up)
# <Shift-5>	& scroll down (move map up) fast
# <Control-5>	& scroll right (move map left) fast
# <Alt-5>		& scroll right (move map left)
#
# - by action
#
# scroll up (move map down) slowly	& <Key-Up>
# scroll up (move map down)		& <Button-4>
# scroll up (move map down) fast		& <Key-Delete>, <Shift-4>
#
# scroll down (move map up) slowly	& <Key-Down>
# scroll down (move map up)		& <Button-5>
# scroll down (move map up) fast		& <Key-space>, <Shift-5>
#
# scroll left (move map right) slowly	& <Key-Left>
# scroll left (move map right)		& <Alt-4>
# scroll left (move map right) fast	& <Control-4>
#
# scroll right (move map left) slowly	& <Key-Right>
# scroll right (move map left)		& <Alt-5>
# scroll right (move map left) fast	& <Control-5>
#
# scroll NE (move map SW) slowly		& <Shift-Up>
# scroll SE (move map NW) slowly		& <Shift-Right>
# scroll SW (move map NE) slowly		& <Shift-Down>
# scroll NW (move map SE) slowly		& <Shift-Left>
#
# panning slowly		& <Control-Motion>
# panning fast		& <B2-Motion>
#
# create waypoint 	& <Button-1>, <Return>
#
# stop motion of waypoint (if one moving)		& <Button-3>
#
# open item (if over item)	& <Double-1>
#
# measure distance/azimuth & <Shift-3>
#
# open waypoint menu (if over waypoint)	& Unix: <Control-1>
#  					& non-Unix: <Button-3>
#
# add waypoint to route being edited on map (if any)	& <Button-1>
# delete waypoint from route being edited on map (if any)	& <Shift-1>
# edit previous stage of route being edited on map (if any)
# 						& <Control-3>
# edit next stage of route being edited on map (if any)
#  						& <Control-Shift-3>
# open route menu if editing it on the map	& Unix: <Control-1>
#  						& non-Unix: <Button-3>
#
# finish edition of route on map			& Unix: <Button-3>
#  						& non-Unix: <Control-1>
# cancel edition of route on map	& <Shift-2>
#
###
#  general bindings are set in proc SetMapBindings
#  other bindings are set in procs:
#      MapCreateWP, PutMapRTWPRS, PutMapTREls
#  changes in scrolling/panning bindings should be reflected in
#      proc MapBackNGPlaceWP 

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 UNIX LNSREACT

    $Map configure -cursor crosshair

    if { $UNIX } {
	bind $Map <Enter> "focus $Map ; MapCursor"
	bind $Map <Leave> { focus . ; UnMapCursor }
    } else {
	# SH contribution: focus when creating but no focus changes when
	#  entering/leaving
	focus $Map
	bind $Map <Enter> MapCursor
	bind $Map <Leave> { UnMapCursor }
    }

    #  changes in scrolling/panning bindings should be reflected in
    #      proc MapBackNGPlaceWP 
    # 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-Left> { 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 }
    # panning
    # SH contribution: marking during motion and panning with
    #  Control-Motion at a lower speed
    bind $Map <Motion> {$Map scan mark %x %y; MapCursorMotion %x %y}
    bind $Map <Control-Motion> "$Map scan dragto %x %y 1; \
	    SetVisibleOrigin x ; SetVisibleOrigin y ; MapCursorUpdate"

    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 }
    }
    if { $LNSREACT } {
	$Map bind LN <Enter> { HighLight }
	$Map bind LN <Leave> { LowLight }
    }
    after 5000 "$Map delete dummy"
    bind $Map <Button-1> { SafeSingleClick 1 MarkMapPoint %x %y }
    bind $Map <Double-1> { SafeCompoundClick 1 Ignore ; break }
    # bindings of mkRTtrans tag that did not work under some window managers
    #  are now set in this way
    foreach e "Control-1 Shift-1 Shift-2 Button-3 Control-3 Control-Shift-3" {
        bind $Map <$e> "MapBinding $e %x %y ; break"
    }
    bind $Map <Shift-3> { MapMeasure %x %y }
    # BSB contribution
    bind $Map <Return> { MarkMapPoint %x %y }
    return
}

proc MapBinding {event x y} {
    # answer to a map event
    global UNIX MapMakingRT

    switch $event {
	Control-1 {
	    if { $MapMakingRT } {
		# SH contribution: roles of B-3 and Control-1 in non-Unix
		if { $UNIX} {
		    MapRTMenu -1 $x $y
		} else { MapFinishRT $x $y }
	    }
	}
	Shift-1 {
	    if { $MapMakingRT } { MapDelFromRT sel }
	}
	Button-3 {
	    if { $MapMakingRT } {
		# SH contribution: roles of B-3 and Control-1 in non-Unix
		if { $UNIX} {
		    MapFinishRT $x $y
		} else { MapRTMenu -1 $x $y }
	    } else {
		StopMapWPMoving
	    }
	}
	Control-3 {
	    if { $MapMakingRT} { MapChangeRTLastRS }
	}
	Control-Shift-3 {
	    if { $MapMakingRT} { MapChangeRTNextRS }
	}
	Shift-2 {
	    if { $MapMakingRT} { MapCancelRT ask close }
	}
    }
    return
}

### cursor: marking, moving

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

    set xx [expr $OVx+$x-$CRHAIRx] ; set yy [expr $OVy+$y-$CRHAIRy]
    switch -glob $MapLoading {
	0 {
	    if { ! $MapEmpty } {
		if { $MapWPMoving != -1 } {
		    eval MapMoveWP [MapToPosn $xx $yy]
		    return
		} elseif { $MapMakingRT } {
		    # this was a binding of mkRTtrans tag that
		    #  did not work under some window managers
		    MapAddToRT $x $y
		    return
		} else {
		    # create new WP
		    if { [winfo exists $EdWindow(WP)] } {
			Raise $EdWindow(WP) ; bell ; return
		    }
		    foreach "latd longd" [MapToPosn $xx $yy] { break }
		    foreach "p pfmt datum" \
			[FormatPosition $latd $longd $Datum \
			     $MapPFormat $MapPFDatum DDD] { break }
		    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 {
	    # display first waypoint
	    set MapLoadPos(origin,x) $xx ; set MapLoadPos(origin,y) $yy
	    MapCreateWP $xx $yy [lindex $MapLoadWPs 0] [lindex $MapLoadWPNs 0]
	    # change tags of line segments
	    foreach a "1 2" {
		set it [$Map find withtag mapfixline=$a]
		$Map dtag $it mapfix ; $Map addtag mapadjust withtag $it
	    }
	    set dmx $MapLoadPos(dmx,1) ; set dmy $MapLoadPos(dmy,1)
	    if { [set dir $MapLoadPos(dir)] == "x" } {
		# compute coefficients of line (y=a x+b)
		set MapLoadPos(a) [expr -1.0*$dmy/$dmx]
		set MapLoadPos(b) [expr $yy-$MapLoadPos(a)*$xx]
	    } else {
		# compute coefficients of line (x=a y+b)
		set MapLoadPos(a) [expr -1.0*$dmx/$dmy]
		set MapLoadPos(b) [expr $xx-$MapLoadPos(a)*$yy]
	    }
	    set MapLoadPos(bound) $MapLoadPos(origin,$dir)
	    set c dm$dir
	    # Does 2nd point lie to the right (East), or above (North) the 1st
	    #  in the terrain?
	    set MapLoadPos(rtab) [expr $MapLoadPos($c,1) > 0]
	    set MapLoading NoRot=end ; set MapScale 1e6
	    MapCursor
	}
	NoRot=end {
	    if { $MapLoadPos(scale) > 1e5 } {
		bell
	    } else {
		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)
		.wmapload.fr.bns.ok configure -state normal
	    }
	}
	Affine*=[1-3] -  LeastSquares=* {
	    # type of transformation and number of points to be placed
	    regexp (.*)=(.*) $MapLoading z how n
	    incr n -1
	    set MapLoadPos($n,x) $xx ; set MapLoadPos($n,y) $yy
	    if { [set ix [lindex $MapLoadWPs $n]] == -1 && \
		   [set ix [DefineCtrlPoint .wmapload $n \
				.wmapload.fr.frbx.bx 0]] == -1 } {
		MapLoadBkCancel
		return
	    }
	    MapCreateWP $xx $yy [lindex $MapLoadWPs $n] \
		    [lindex $MapLoadWPNs $n]
	    set MapLoading ${how}=$n
	    $Map delete mapfixname
	    MapCursor
	    if { $n == 0 } {
		.wmapload.fr.bns.ok configure -state normal
	    }
	    # continuation to either MapLoadBkDialDone or MapLoadBkCancel
	}
    }
    return
}

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

    switch -glob $MapLoading {
	Affine*=[1-3] -  LeastSquares=* {
	    $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 $DEFTRTWIDTH \
			    -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 $DEFTRTWIDTH \
			-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 \
	    UNIX RealTimeLogAnim

    switch -glob $MapLoading {
	Affine*=* -  NoRot=* -  LeastSquares=* {
	    $Map delete mapfix
	    # SH contribution: do not raise .wmapload under non-Unix
	    if { $UNIX && [winfo exists .wmapload] } { Raise .wmapload }
	}
	0 {
	    if { ! $MapEmpty } {
		catch { unset CursorPos }
		set XCoord "" ; set YCoord ""
		if { $MapMakingRT } {
		    $Map delete mkRTtrans
		    # SH contribution: do not raise .gmRT under non-Unix
		    if { $UNIX && [winfo exists .gmRT] } { Raise .gmRT }
		} elseif { $UNIX && $RealTimeLogAnim && \
			[winfo exists .simdrive] } {
		    # raise driving simulator window
		    Raise .simdrive
		}
	    }
	}
    }
    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 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] -  LeastSquares=* {
	    # 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 {
	    # move names and positions of 2nd and 3rd WPs
	    # move 2nd on its line; then place 3rd according to scale
	    set bound $MapLoadPos(bound) ; set rtab $MapLoadPos(rtab)
	    if { $MapLoadPos(dir) == "x" } {
		# $rtab!=0 means that segment is to the right of 1st point
		#  assuming vector (0,1) in terrain coordinates to point North
		if { $rtab } {
		    if { $xx < $bound } { set xx $bound }
		} elseif { $xx > $bound } {
		    set xx $bound
		}
		set yy [expr $MapLoadPos(a)*$xx+$MapLoadPos(b)]
	    } else {
		# $rtab!=0 means that segment is above the 1st point
		#  assuming vector (0,1) in terrain coordinates to point North
		# y-coordinates in the canvas grow South!
		if { $rtab } {
		    if { $yy > $bound } { set yy $bound }
		} elseif { $yy < $bound } {
		    set yy $bound
		}
		set xx [expr $MapLoadPos(a)*$yy+$MapLoadPos(b)]
	    }
	    # move 2nd point
	    $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)
	    set dx0 [expr $xx-$MapLoadPos(origin,x)]
	    set dy0 [expr $yy-$MapLoadPos(origin,y)]
	    if { [set d0 [expr sqrt($dx0*$dx0+$dy0*$dy0)]] < 1e-15 } {
		set sc 1e6
	    } else {
		set sc [expr 1.0*$MapLoadPos(dist)/$d0]
	    }
	    # compute coords of 3rd point and move it
	    set x3 [expr $MapLoadPos(origin,x)+1.0*$MapLoadPos(dmx,2)/$sc]
	    set y3 [expr $MapLoadPos(origin,y)-1.0*$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
}

### measuring

proc MapMeasure {x y} {
    # measuring a distance along a line on the map
    # this proc is used both for starting the operation and for adding each
    #  new point
    #  $x,$y are the map coordinates of point
    global MapEmpty MapLoading MapMakingRT MapMeasure FixedFont \
	    OVx OVy CRHAIRx CRHAIRy DPOSX DPOSY TXT COLOUR Map

    if { $MapEmpty || $MapMakingRT || $MapLoading != 0 } { return }
    set xx [expr $OVx+$x-$CRHAIRx] ; set yy [expr $OVy+$y-$CRHAIRy]
    set pn [MapToPosn $xx $yy]
    if { $MapMeasure == "" } {
	# list with total distance, number of segments, followed by
	#  positions and coordinates for each point
	set MapMeasure [list 0 0 $pn $xx $yy]
	return
    }

    # used elsewhere
    set w .mapmeasure

    if { ! [winfo exists $w] } {
	GMToplevel $w distazim +[expr $DPOSX+100]+[expr $DPOSY+100] {} \
	    {WM_DELETE_WINDOW MapMeasureEnd} {}
  
	frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg)
	label $w.fr.fromto -text $TXT(distazim)
	frame $w.fr.fr1 -relief flat -borderwidth 0
	label $w.fr.fr1.dist -width 15 -font $FixedFont -anchor w
	label $w.fr.fr1.bear -width 15 -font $FixedFont -anchor w
	frame $w.fr.frsel -relief flat -borderwidth 0
	button $w.fr.frsel.loop -text $TXT(loop) -command MapMeasureLoop
	button $w.fr.frsel.back -text $TXT(undo) -command MapMeasureUndo
	button $w.fr.frsel.cr -text $TXT(crtLN) -command MapMeasureCreateLN
	button $w.fr.frsel.cnc -text $TXT(cancel) -command MapMeasureEnd

	pack $w.fr -side top
	pack $w.fr.fr1.dist $w.fr.fr1.bear -side left -padx 5
	pack $w.fr.frsel.loop $w.fr.frsel.back $w.fr.frsel.cr \
	    $w.fr.frsel.cnc -side left -padx 5
	pack $w.fr.fromto $w.fr.fr1 $w.fr.frsel -side top -pady 5
    }
    MapMeasureAdd $pn $xx $yy
    return
}

proc MapMeasureAdd {posn xx yy} {
    # add new point to measure line updating the map and the dialog window
    #  unless distance to last point is less than 1 metre
    global MapMeasure Map Datum DSCALE DTUNIT TXT

    set pp [lindex $MapMeasure end-2]
    set xxp [lindex $MapMeasure end-1]
    set yyp [lindex $MapMeasure end]
    foreach "dist nsegs p1" $MapMeasure { break }
    if { [set dist [expr $dist+[ComputeDist $pp $posn $Datum]]] < 1e-3 } {
	bell ; return
    }
    lappend MapMeasure $posn $xx $yy
    set MapMeasure [lreplace $MapMeasure 0 1 $dist [incr nsegs]]
    set dist [format "%8.3f" [expr $dist*$DSCALE]]
    set bear [format "%5d" [ComputeBear $p1 $posn $Datum]]
    $Map create line $xxp $yyp $xx $yy -width 4 -arrow last -fill green \
	    -tags [list measure mseg=$nsegs]
    set w .mapmeasure
    $w.fr.fr1.dist configure -text "$dist $DTUNIT"
    $w.fr.fr1.bear configure -text "$bear $TXT(degrees)"
    return
}

proc MapMeasureCreateLN {} {
    # create LN from measurement line
    # there must be at least two points
    global MapMeasure EdWindow Datum MapPFormat MapPFDatum

    if { [llength $MapMeasure] < 8 } { bell ; return }
    if { [winfo exists $EdWindow(LN)] } {
	bell ; Raise $EdWindow(LN)
	return
    }
    set lps ""
    foreach "p xx yy" [lrange $MapMeasure 2 end] {
	foreach "latd longd" $p { break }
	set p [lindex \
		[FormatPosition $latd $longd $Datum $MapPFormat $MapPFDatum] 0]
	lappend lps [FormData LP posn [list $p]]
    }
    GMLine -1 {create revert cancel} [FormData LN "Datum PFrmt LPoints" \
					  [list $MapPFDatum $MapPFormat $lps]]
    return
}

proc MapMeasureLoop {} {
    # add segment from current to first point
    # there must be at least two points
    global MapMeasure

    if { [llength $MapMeasure] < 8 } { bell ; return }
    eval MapMeasureAdd [lrange $MapMeasure 2 4]
    return
} 

proc MapMeasureUndo {} {
    # delete last segment of measurement line or finish if there is
    #  only one
    global Map MapMeasure Datum DSCALE DTUNIT TXT

    foreach "dist nsegs p1" $MapMeasure { break }
    if { $nsegs < 2 } {
	MapMeasureEnd
	return
    }
    $Map delete mseg=$nsegs
    set lp [lindex $MapMeasure end-2]
    set MapMeasure [lrange $MapMeasure 0 end-3]
    set pp [lindex $MapMeasure end-2]
    set dist [expr $dist-[ComputeDist $pp $lp $Datum]]
    set MapMeasure [lreplace $MapMeasure 0 1 $dist [incr nsegs -1]]
    set dist [format "%8.3f" [expr $dist*$DSCALE]]
    set bear [format "%5d" [ComputeBear $p1 $pp $Datum]]
    set w .mapmeasure
    $w.fr.fr1.dist configure -text "$dist $DTUNIT"
    $w.fr.fr1.bear configure -text "$bear $TXT(degrees)"
    return
}

proc MapMeasureEnd {} {
    # finish measuring distances
    global Map MapMeasure

    set MapMeasure ""
    $Map delete measure
    destroy .mapmeasure
    return
}

### scrolling and resizing

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 MapResize {} {
    global Map MAPW2 MAPH2 MapWidth MapHeight
    global OVx OVy

    set cx [expr $MAPW2+$OVx] ; set cy [expr $MAPH2+$OVy]
    set MapWidth [winfo width $Map] ; set MapHeight [winfo height $Map]
    set MAPW2 [expr $MapWidth/2] ; set MAPH2 [expr $MapHeight/2]
    SetMapBounds
    ScrollMapTo $cx $cy [expr $MAPW2+$OVx] [expr $MAPH2+$OVy]
    return
}

### highlighting items

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 RTColour TRColour LNColour

    set ts [$Map itemcget [$Map find withtag current] -tags]
    if { [set i [lsearch -glob $ts {forRT=*}]] != -1 } {
	set t [lindex $ts $i]
	regsub forRT= $t "" ix
	if { $ix != -1 } {
	    set c $RTColour($ix)
	} else { set c $MAPCOLOUR(RT) }
	$Map itemconfigure $t -fill $c
	$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]
	regsub forTR= $t "" ix
	if { $ix != -1 } {
	    set c $TRColour($ix)
	} else { set c $MAPCOLOUR(TR) }
	$Map itemconfigure $t -fill $c
	$Map itemconfigure inTR=$ix -fill $MAPCOLOUR(TP)
	return
    }
    if { [set i [lsearch -glob $ts {forLN=*}]] != -1 } {
	set t [lindex $ts $i]
	regsub forLN= $t "" ix
	if { $ix != -1 } {
	    set c $LNColour($ix)
	} else { set c $MAPCOLOUR(LN) }
	$Map itemconfigure $t -fill $c
    }
    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 PrevCentre

    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
	set PrevCentre [list [lindex [$Map xview] 0] [lindex [$Map yview] 0]]
    } else {
	set st disabled
	set MapEmpty 1 ; set MapTransfTitle ""
	MapMeasureEnd
	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
    }
    ChangeOnState mapstate $st
    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.fr3.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.fr3.cv.val configure -text $txt
    update idletasks
    return
}

proc FixMapScale {proj} {
    # compute map scale after a foreign geo-referencing file was used
    #  by evaluating the distance between the inverse projections of
    #  the map center and a point to its right at $MAPSCLENGTH pixels
    # assume that the MPData array has the map projection parameters and
    #  that the map transformation has been set up
    # cannot call proc MapToPosn because proc MapProjectionIs has not
    #  been called yet
    global MapTransf MapScale MAPSCLENGTH MAPW2 MAPH2 MPData MAPPARTPROJ

    foreach n "1 2" xm "$MAPW2 [expr $MAPW2+$MAPSCLENGTH]" {
        set pt [MapInvert${MapTransf}Transf $xm $MAPH2]
	if { ! [catch {set mp $MAPPARTPROJ($proj)}] } {
	    set proj $mp
	}
	set p$n [eval Proj${proj}Invert MPData $pt]
    }
    set MapScale \
	[expr 1000.0*[ComputeDist $p1 $p2 $MPData(datum)]/$MAPSCLENGTH]
    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||lab}] {
	set cs ""
	foreach c [$Map coords $item] {
	    lappend cs [expr $r*$c]
	}
	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 \
	    MapProjection MapTransf MAPW2 MAPH2 WConf MPData MTData Datum \
	    RealTimeLogOn RealTimeLogAnim ASKPROJPARAMS

    if { $MapEmpty && ! $MapLoading } {
	set MapEmpty 0
	catch { unset MPData } ; catch { unset MTData }
	foreach b $WConf(mapdatum) { $b configure -state disabled }
	# do not ask for parameters confirmation if getting real-time log and
	#  animating it
	set oask $ASKPROJPARAMS
	if { $RealTimeLogOn && $RealTimeLogAnim } {
	    set ASKPROJPARAMS 0
	}
	set pt [$MapProjInitProc $MapProjection MPData $Datum \
		[list [list $latd $longd $datum]]]
	set ASKPROJPARAMS $oask
	# 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} {
    # compute latitude and longitude in projection datum from map coordinates
    global MapProjInvertProc MapTransf

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

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

    set pt [MapInvert${MapTransf}Transf $xm $ym]
    foreach "latd longd" [eval $MapProjInvertProc MPData $pt] { break }
    set p [lindex \
	       [FormatPosition $latd $longd $Datum $MapPFormat $MapPFDatum] 0]
    switch $POSTYPE($MapPFormat) {
	latlong -  nzgrid -  mh {
	    set MapZone ""
	    foreach "XCoord YCoord" [lrange $p 2 end] { break }
	}
	utm {
	    set XCoord [expr round([lindex $p 4])]
	    set YCoord [expr round([lindex $p 5])]
	    set MapZone "[lindex $p 2][lindex $p 3]"
	}
	grid {
	    foreach "MapZone XCoord YCoord" [lrange $p 2 end] { break }
	}
    }
    return
}

### displaying items

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

    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 $MapFont \
		    -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 $MapFont \
		    -justify center \
		    -tags [list WP WPn forWP=$wpix lab=$name txt]]
	}
    }
    if { [string first s $o] == 0 } {
	set syim [lindex [SymbolImageName $WPSymbol($wpix)] 0]
	lappend its [$Map create image $x $y -anchor center \
		-image $syim -tags [list WP WPsy syforWP=$wpix lab=$name]]
    }
    # SH contribution: use B-3 in non-Unix systems instead of Control-1
    if { $UNIX } {
	set event "<Control-1>"
	set com "SafeCompoundClick 1 MapWPMenu $wpix"
    } else {
	set event "<Button-3>"
	set com "MapWPMenu $wpix"
    }
    foreach m $its {
	$Map bind $m <Double-1> "SafeCompoundClick 1 OpenItem WP $wpix"
	$Map bind $m $event $com
    }
    return $it
}

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

    if { $MapEmpty && [set mbak $WPMBack($ix)] != "" } { LoadMapBack $mbak }
    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, or
    #  the operation was aborted, otherwise 1
    global RTWPoints RTStages RTMBack MapEmpty

    if { $MapEmpty && [set mbak $RTMBack($ix)] != "" } { LoadMapBack $mbak }
    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,
    #  or if operation was aborted, and 1 otherwise
    # slow operation dialog only used if $xi!=-1, "mkRT" not in $rttags and
    #  there are more than 100 WPs
    global WPDispl EdWindow GMEd Map MAPCOLOUR MESS TXT DataIndex MapFont \
	    RTWidth RTColour DEFTRTWIDTH

    if { $ix != -1 && [lindex $wps 100] != "" && \
	    [lsearch -exact $rttags mkRT] == -1 } {
	set slow 1
	set sid [SlowOpWindow $TXT(displ)]
    } else {
	set slow 0
	SetCursor . watch
    }
    set its ""
    foreach wp $wps {
	if { $slow && [SlowOpAborted] } {
	    UnMapRT $ix
	    SlowOpFinish $sid ""
	    return -1
	}
	set wpix [IndexNamed WP $wp]
	if { [set it [$Map find withtag WP=$wp]] == "" } {
	    if { $wpix == -1 } {
		set m "$MESS(cantmapRTunkn) $wp"
	    } elseif { [winfo exists $EdWindow(WP)] && \
		    $GMEd(WP,Index) == $wpix } {
		set m "$MESS(cantmapRTed): $wp"
	    } else { set m "" }
	    if { $m != "" } {
		if { $slow } {
		    SlowOpFinish $sid $m
		} else {
		    GMMessage $m
		    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
	}
    }
    if { $ix != -1 } {
	set wdth $RTWidth($ix) ; set colour $RTColour($ix)
    } else {
	set wdth $DEFTRTWIDTH ; set colour $MAPCOLOUR(RT)
    }
    if { [lindex $rttags 0] == "mkRT" } { set colour $MAPCOLOUR(mkRT) }
    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 { $slow && [SlowOpAborted] } {
	    UnMapRT $ix
	    SlowOpFinish $sid ""
	    return -1
	}
	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 $wdth -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 txt]
		lappend zs [$Map create text $xl $yl \
		    -text $sl -fill $colour -font $MapFont \
		    -justify center -tags $ts]
	    }
	    if { $ix != -1 } {
		foreach l $zs {
		    $Map bind $l <Double-1> \
			    "SafeCompoundClick 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
	}
    }
    if { $slow } {
	SlowOpFinish $sid ""
    } else { ResetCursor . }
    return 1
}

proc PutMapTREls {ix tps segsts datum tags} {
    # map TR elements
    #  $ix is index of TR or -1; used for tagging
    #  $tps is list of TR points with given $datum
    #  $segsts is list of indices (!=0) of TR points starting segments
    #  $tags is tags to add to all created canvas items (may be void)
    # slow operation dialog only used if there are more then 100 TPs
    # return -1 if operation was aborted, 1 otherwise
    global MAPCOLOUR Map TRName TRWidth TRColour DEFTTRWIDTH TRNUMBERINTVL \
	MapFont TXT TRINFO

    if { [lindex $tps 101] != "" } {
	set slow 1
	set sid [SlowOpWindow $TXT(displ)]
    } else {
	set slow 0
	SetCursor . watch
    }
    set res 1
    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) ; set wdth $TRWidth($ix)
	set colour $TRColour($ix)
    } else {
	set name "(???)" ; set wdth $DEFTTRWIDTH
	set colour $MAPCOLOUR(TR)
    }
    foreach tp $tps {
	if { $slow && [SlowOpAborted] } {
	    set res -1 ; break
	}
	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 $colour \
		  -outline $colour \
		  -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> "SafeCompoundClick 1 OpenItem TR $ix"
	lappend its $it
	if { $TRNUMBERINTVL && $i%$TRNUMBERINTVL == 0 } {
	    set t [$Map create text $x [expr $y-8] -text $i \
		    -fill $colour -font $MapFont -justify center \
		    -tags [linsert $tags1 0 lab=$ix-$i txt]]
	    $Map bind $t <Double-1> "SafeCompoundClick 1 OpenItem TR $ix"
	}
	switch $TRINFO {
	    number {
		set bbi [list ={$name}:$i]
	    }
	    date {
		set bbi [list ={$name}:[lindex $tp 4]]
	    }
	}
	BalloonBindings "$Map lab=$ix-$i" $bbi
	incr i
    }
    if { $res == 1 && [set rts [lreplace $its 0 0]] != "" } {
	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]
	set tpn 1 ; set nsst [lindex $segsts 0]
	foreach it $rts {
	    if { $slow && [SlowOpAborted] } {
		set res -1 ; break
	    }
	    set cs [$Map coords $it]
	    set x [expr [lindex $cs 0]+1] ; set y [expr [lindex $cs 1]+1]
	    if { $nsst == $tpn } {
		set segsts [lreplace $segsts 0 0]
		set nsst [lindex $segsts 0]
	    } else {
		set l [$Map create line $x0 $y0 $x $y -smooth 0 \
			-fill $colour -width $wdth -tags $tags2]
		$Map bind $l <Double-1> "SafeCompoundClick 1 OpenItem TR $ix"
		$Map lower $l $it0
	    }
	    set x0 $x ; set y0 $y
	    incr tpn
	}
    }
    if { $slow } {
	if { $res == -1 } { $Map delete forTR=$ix }
	SlowOpFinish $sid ""
    } else { ResetCursor . }
    return $res
}

proc PutMapTR {ix} {
    # map TR with given index
    # return -1 if operation was aborted, 1 otherwise
    global TRTPoints TRSegStarts TRDatum TRMBack MapEmpty

    if { $MapEmpty && [set mbak $TRMBack($ix)] != "" } { LoadMapBack $mbak }
    return [PutMapTREls $ix $TRTPoints($ix) $TRSegStarts($ix) $TRDatum($ix) ""]
}

proc PutMapLNEls {ix lps segsts datum tags} {
    # map LN elements
    #  $ix is index of LN or -1; used for tagging
    #  $lps is list of LN points with given $datum
    #  $segsts is list of indices (!=0) of LN points starting segments
    #  $tags is tags to add to all created canvas items (may be void)
    # slow operation dialog only used if there are more then 100 LPs
    # return -1 if operation was aborted, 1 otherwise
    global MAPCOLOUR Map LNWidth LNColour DEFTLNWIDTH Datum TXT LNSREACT

    if { [lindex $lps 101] != "" } {
	set slow 1
	set sid [SlowOpWindow $TXT(displ)]
    } else {
	set slow 0
	SetCursor . watch
    }
    set res 1
    if { $ix == -1 } {
	set colour $MAPCOLOUR(LN) ; set width $DEFTLNWIDTH
    } else {
	set colour $LNColour($ix) ; set width $LNWidth($ix)
    }
    set tgs [linsert $tags 0 LN forLN=$ix LNfirst LN=$ix sq2]
    set lp [lindex $lps 0]
    foreach "latd longd" [lindex $lp 0] { break }
    foreach "x0 y0" [MapFromPosn $latd $longd $datum] {}
    set its [$Map create rectangle [expr $x0-1] [expr $y0-1] \
	          [expr $x0+1] [expr $y0+1] -fill $colour \
		  -outline $colour -tags $tgs]
    set tgs [linsert $tags 0 LN forLN=$ix line]
    set lpn 1 ; set nsst [lindex $segsts 0]
    foreach lp [lreplace $lps 0 0] {
	if { $slow && [SlowOpAborted] } {
	    $Map delete forLN=$ix
	    set res -1
	    break
	}
	foreach "latd longd" [lindex $lp 0] { break }
	foreach "x y" [MapFromPosn $latd $longd $datum] {}
	if { $nsst == $lpn } {
	    set segsts [lreplace $segsts 0 0]
	    set nsst [lindex $segsts 0]
	} else {
	    $Map create line $x0 $y0 $x $y -smooth 0 -fill $colour \
		    -width $width -tags $tgs
	}
	set x0 $x ; set y0 $y
	incr lpn
    }
    if { $res != -1 && $LNSREACT } {
	$Map bind forLN=$ix <Double-1> "SafeCompoundClick 1 OpenItem LN $ix"
    }
    if { $slow } {
	SlowOpFinish $sid ""
    } else { ResetCursor . }
    return $res
}

proc PutMapLN {ix} {
    # map LN with given index
    # return -1 if operation was aborted, 1 otherwise
    global LNLPoints LNSegStarts LNDatum LNMBack MapEmpty

    if { $MapEmpty && [set mbak $LNMBack($ix)] != "" } { LoadMapBack $mbak }
    return [PutMapLNEls $ix $LNLPoints($ix) $LNSegStarts($ix) $LNDatum($ix) ""]
}

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

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

proc PutMapGR {ix} {
    # map GR with given index
    # use slow operation window explicitly only for WPs if there are more
    #  than 100
    # return -1 if an element cannot be unmapped/mapped, otherwise 1
    global GRConts TXT

    set res 1
    foreach p $GRConts($ix) {
	foreach "wh es" $p {}
	if { $wh == "LAP" } { continue }
	if { $wh == "WP" && [lindex $es 100] != "" } {
	    set slow 1
	    set sid [SlowOpWindow $TXT(displ)]
	} else { set slow 0 }
 	foreach e $es {
	    if { $slow && [SlowOpAborted] } {
		SlowOpFinish $sid ""
		return -1
	    } elseif { [set ex [IndexNamed $wh $e]] == -1 || \
			   [PutMapGREl $wh $ex] == -1 } {
		set res -1
	    }
 	}
	if { $slow } { SlowOpFinish $sid "" }
    }
    return $res
}

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 DEFTTRWIDTH

    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 $DEFTTRWIDTH -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
	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 UnMapLN {ix} {
    # delete LN with index $ix from map
    global Map

    $Map delete forLN=$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" } {
	    if { $wh == "LAP" } { continue }
	    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
}

### moving a WP

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 {latd longd} {
    # place WP at a new position for $Datum
    global EdWindow GMEd MapWPMoving MapPFormat WPPosn WPPFrmt WPName WPDatum \
	    Datum MapPFDatum

    set ix $MapWPMoving
    StopMapWPMoving
    if { [winfo exists $EdWindow(WP)] && $GMEd(WP,Index) == $ix } {
	bell ; Raise $EdWindow(WP)
	return
    }
    set name $WPName($ix)
    foreach "posn frmt datum" \
	[FormatPosition $latd $longd $Datum $MapPFormat $MapPFDatum DDD] {
	    break
    }
    set WPPosn($ix) $posn ; set WPPFrmt($ix) $frmt
    set WPDatum($ix) $datum
    MoveOnMap WP $ix $name 0 $name
    ChangeWPInRTWindows $name $name 1
    UpdateItemWindows WP $ix
    return
}

proc StopMapWPMoving {} {
    global MapWPMoving

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

### updating item coordinates

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
}

### updating WP symbol

proc ChangeMapWPSymbol {ix symbol} {
    # change symbol of mapped WP if there is one
    global Map

    if { [set it [$Map find withtag syforWP=$ix]] != -1 } {
	foreach "x y" [$Map coords $it] { break }
	set ts [$Map gettags $it]
	$Map delete $it
	set syim [lindex [SymbolImageName $symbol] 0]
	$Map create image $x $y -anchor center -image $syim -tags $ts
    }
    return
}

### saving and clearing mao

proc SaveMap {fmt} {
    # save map in graphics file format
    #  $fmt is either PS, or in $ImgOutFormats (if the Img library is loaded)
    global Map OVx OVy MapWidth MapHeight

    SaveCanvas $Map [list $OVx $OVy \
	    [expr $OVx+$MapWidth] [expr $OVy+$MapHeight]] $fmt file
    return
}

proc PrintMap {} {
    # print map to postscript printer
    global Map OVx OVy MapWidth MapHeight

    SaveCanvas $Map [list $OVx $OVy \
	    [expr $OVx+$MapWidth] [expr $OVy+$MapHeight]] PS printer
    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 GMEd 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 GMEd($wh,Displ) 0
	    set GMEd($wh,Data) [lreplace [set GMEd($wh,Data)] end end 0]
	    $EdWindow($wh).fr.frdw.displayed deselect
	}
	global ${wh}Displ
	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.fr3.mn configure -state normal
    foreach b $WConf(mapdatum) { $b configure -state normal }
    MapScaleChange $MapScInitVal
    set MapScale [MapScaleFromDist $MapScInitVal]
    ChangeOnState mapstateback disabled
    return
}

### menu for item on map

proc MapCreateMenu {wh title} {
    # create menu on map for item of type $wh with a dummy entry
    #  labelled $TXT($title)
    # return path of menu
    # SH contribution: no need for menubutton as in previous versions
    global Map TXT

    set mb $Map.m$wh
    destroy $mb
    menu $mb -tearoff 0
    $mb add command -label $TXT($title) -state disabled
    $mb add separator
    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, or
    #  for creating a new WP at given distance and bearing
    global Map TXT WPName LsW MAXMENUITEMS MapBounds DSCALE EdWindow \
	    GMEd UNIX

    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]
    # SH contribution: no need for menubutton as in previous versions
    set menu [MapCreateMenu WP withWP]

    if { [winfo exists $EdWindow(WP)] && $GMEd(WP,Index) == $ix } {
	set st disabled
    } else { set st normal }
    $menu add command -label $TXT(move) -state $st \
	    -command "StartMapWPMoving $ix"
    if { [winfo exists $EdWindow(RT)] } {
	set st disabled
    } else { set st normal }
    $menu add command -label $TXT(startRT) -state $st \
	    -command "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 "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 "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 "MapRTsFor $ix $f"
	$mn.rts add command -label $TXT(formappedWPs) \
		-command "MapRTsForMappedWPs $f"
    }
    $menu add command -label $TXT(newWPatdb) -command "CreateWPAtDistBear $ix"
    # SH contribution: no need for "close menu" entry in non-Unix systems
    if { $UNIX } {
	$menu add command -label $TXT(closemenu) -command "destroy $menu"
    }
    eval $menu post [winfo pointerxy .] 
    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 \
	    UNIX

    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
	}
    }
    # SH contribution: no need for menubutton as in previous versions
    set menu [MapCreateMenu RT route]

    if { $MapEditingRS } {
	$menu add command -label $TXT(stop) -command MapFinishRTLastWP
    } else {
	$menu add cascade -label $TXT(stop) -menu $menu.mnf
	menu $menu.mnf -tearoff 0
	# SH contribution: exchange roles of B-3 and Control-1 in
	#  non-Unix systems
	if { $UNIX } {
	    $menu.mnf add command -label $TXT(here) -accelerator "<Button-3>" \
		    -command "MapFinishRT $x $y"
	} else {
	    $menu.mnf add command -label $TXT(here) -accelerator "<Ctrl-B1>" \
		-command "MapFinishRT $x $y"
	}
	$menu.mnf add command -label $TXT(atprevwp) -command MapFinishRTLastWP
    }
    $menu add command -label $TXT(cancel) -accelerator "<Shift-B2>" \
	    -command "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 "MapDelFromRT sel"
	if { $MapEditingRS && $MapEditedRS == 0 } {
	    set st disabled
	} else { set st normal }
	$menu.mnd add command -label $TXT(firstwp) -state $st \
		-command "MapDelFromRT 0"
    }
    if { $MapEditingRS } {
	if { $MapEditedRS != 0 } {
	    $menu add command -label $TXT(chglstrs) \
		    -accelerator "<Control-B3>" -command MapChangeRTLastRS
	}
	if { $MapEditedRS != $MapRTLast-1 } {
	    $menu add command -label $TXT(chgnxtrs) \
		    -accelerator "<Ctrl-Shift-B3>" -command MapChangeRTNextRS
	}
	$menu add command -label $TXT(contnend) -command MapContRTEnd
    } elseif { $MapRTLast != 0 } {
	$menu add command -label $TXT(chglstrs) -accelerator "<Control-B3>" \
		-command MapChangeRTLastRS
    }
    # SH contribution: no need for "close menu" entry in non-Unix systems
    if { $UNIX } {
	$menu add command -label $TXT(closemenu) -command "destroy $menu"
    }
    eval $menu post [winfo pointerxy .] 
    return
}

### editing a RT

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 GMEd RTDispl RTWPoints MapMakingRT MapRTLast MAPCOLOUR MESS

    if { $MapMakingRT } { bell ; return }
    if { [.gmRT.fr.fr3.fr31.frbx.bxn size] == 0 } {
	GMMessage $MESS(needs1wp)
	return
    }
    if { [set rtix $GMEd(RT,Index)] != -1 } {
	if { $RTDispl($rtix) } { UnMapRT $rtix }
	set wps $RTWPoints($rtix)
    } 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 $rtix [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 -1 $x $y $it
    return
}

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

    set MapEditingRS 0 ; set MapEditedRS -1
    set MapRTCurrent [list $x $y $wpit]
    set MapRTNewWPs ""
    GMRouteSelect end
    foreach it [$Map find withtag mkRT] {
	foreach t [$Map gettags $it] {
	    if { [regexp {^mkRT} $t] } { $Map dtag $it $t }
	}
    }
    $Map create line $x $y $x $y -fill $MAPCOLOUR(mkRT) -arrow first \
	    -smooth 0 -width $DEFTRTWIDTH \
	    -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]
    # all bindings of mkRTtrans tag are now set on the canvas
    return
}

proc MapFinishRTLastWP {} {
    # stop editing RT in the map
    global MapMakingRT TXT UNIX

    if { $MapMakingRT } {
	MapDestroyRT
	GMRouteMapEditEnd
    }
    if { ! $UNIX } {
	# SH contribution
	focus .gmRT
    }
    return
}

proc MapFinishRT {x y} {
    global MapMakingRT TXT UNIX

    if { $MapMakingRT } {
	MapAddToRT $x $y
	MapFinishRTLastWP
    }
    if { ! $UNIX } {
	# SH contribution
	focus .gmRT
    }
    return
}

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

    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
	foreach "latd longd" [MapToPosn $xx $yy] { break }
	foreach "p pfmt datum" \
	 [FormatPosition $latd $longd $Datum $MapPFormat $MapPFDatum DDD] {
		break
	}
	set name [NewName WP]
	if { $CREATIONDATE } {
	    set data [FormData WP "Name PFrmt Posn Datum Date" \
		       [list $name $pfmt $p $datum [Now]]]
	} else {
	    set data [FormData WP "Name Commt PFrmt Posn Datum" \
		       [list $name [DateCommt [Now]] $pfmt $p $datum]]
	}
	set ix [CreateItem WP $data]
	PutMap WP $ix
	lappend MapRTNewWPs $name
    }
    set maprttag (mkRTedge||forRT=$GMEd(RT,Index))
    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 oldit [$Map find withtag $oldst&&$maprttag]
	set cs [$Map coords $oldit]
	$Map coords $oldit [lreplace $cs 2 3 $xx $yy]
	$Map itemconfigure $oldit -fill $MAPCOLOUR(mkRT)
	$Map dtag $oldit to=$toit ; $Map addtag to=$fromit withtag $oldit
	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)&&$maprttag] {
		$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 $DEFTRTWIDTH -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 $DEFTRTWIDTH -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 GMEd

    if { $MapEditingRS } {
	if { $MapEditedRS == 0 } {
	    if { $MapRTLast == 1 } {
		MapContRTEnd
	    } else {
		MapChangeRTNextRS
	    }
	} else {
	    incr MapEditedRS -1
	}
    }
    set maprttag (mkRTedge||forRT=$GMEd(RT,index))
    # zero or one items will have this tag
    foreach it [$Map find withtag (stno=0)&&$maprttag] {
	$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)&&$maprttag] {
	    $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 GMEd MAPCOLOUR DEFTRTWIDTH

    set maprttag (mkRTedge||forRT=$GMEd(RT,index))
    if { $MapEditingRS } {
	if { $MapEditedRS == 0 } {
	    MapDelRT1st $delwp
	    return
	}
	# zero or one items will have this tag
	foreach it [$Map find withtag (stno=$MapEditedRS)&&$maprttag] {
	    $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)&&$maprttag] {
	$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)&&$maprttag] {
	    $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 $DEFTRTWIDTH -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 GMEd

    if { $MapMakingRT && \
	    ( $GMEd(RT,Index) != -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 but display the original RT if it
    #  was already there
    global Map MapMakingRT MapRTLast GMEd RTDispl

    set MapMakingRT 0
    $Map delete mkRT
     while { $MapRTLast >= 0 } {
	incr MapRTLast -1
	foreach it [$Map find withtag inRT=:$MapRTLast] {
	    $Map dtag $it inRT=:$MapRTLast
	}
    }
    if { [set ix $GMEd(RT,Index)] != -1 && $RTDispl($ix) } { PutMapRT $ix }
    return
}

proc MapChangeRTLastRS {} {
    # open previous RS for editing when creating RT on map
    global MapMakingRT MapEditingRS MapEditedRS Map MapRTLast GMEd \
	MAPCOLOUR

    if { ! $MapMakingRT } { return }
    set maprttag (mkRTedge||forRT=$GMEd(RT,index))
    if { $MapEditingRS } {
	if { $MapEditedRS == 0 } { bell ; return }
	# restore stage being edited
	$Map itemconfigure (stno=$MapEditedRS)&&$maprttag -fill $MAPCOLOUR(mkRT)
	# open stage before this one
	set n [expr $MapEditedRS-1]
    } else { set n [expr $MapRTLast-1] }
    # RM contribution: must have the "mkRT" tag otherwise finds stages of
    #  all routes on map
    # changed by MF: may have "forRT=$ix" instead
    if { [set is [$Map find withtag (stno=$n)&&$maprttag]] == {} } {
	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 GMEd \
	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]
    # RM contribution: must have the "mkRT" tag otherwise finds stages of
    #  all routes on map
    # changed by MF: may have "forRT=$ix" instead
    set maprttag (mkRTedge||forRT=$GMEd(RT,index))
    if { [set is [$Map find withtag (stno=$n)&&$maprttag]] == {} } {
	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 \
	    GMEd MAPCOLOUR DEFTRTWIDTH

    if { ! $MapMakingRT || ! $MapEditingRS } { return }
    set maprttag (mkRTedge||forRT=$GMEd(RT,index))
    $Map itemconfigure (stno=$MapEditedRS)&&$maprttag -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 $DEFTRTWIDTH \
	    -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
}

## editing RT stage

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 DEFTRTWIDTH

    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 $DEFTRTWIDTH \
	    -tags [list mkRT mkRTtoline mkRTtrans]
    set MapEditingRS 1
    return
}

### displaying or clearing sets of items

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
    # slow operation dialog used if there are more than 100 WPs
    global WPName WPPosn WPDatum WPDispl EdWindow GMEd TXT

    set wpixs [array names WPName]
    if { [lindex $wpixs 100] != "" } {
	set slow 1
	set sid [SlowOpWindow $TXT(displ)]
    } else {
	set slow 0
	SetCursor . watch
    }
    if { [winfo exists $EdWindow(WP)] } {
	set edix $GMEd(WP,Index)
    } else { set edix -1 }
    set displ [string compare $how clear]
    set p1 $WPPosn($ix) ; set d1 $WPDatum($ix)
    SetDatumData $d1
    foreach ix2 $wpixs {
	if { $slow && [SlowOpAborted] } { break }
	if { $ix2 != $ix && (($displ && ! $WPDispl($ix2)) || \
		             (! $displ && $WPDispl($ix2))) } {
	    set p2 $WPPosn($ix2) ; set d2 $WPDatum($ix2)
	    if  { $d1 != $d2 } {
		set p2 [ToDatum [lindex $p2 0] [lindex $p2 1] $d2 $d1]
	    }
	    if { $d >= [lindex [ComputeDistFD $p1 $p2] 0] } {
		MapOrClear WP $displ $ix2 $edix
	    }
	}
    }
    SetMapBounds
    if { $slow } {
	SlowOpFinish $sid ""
    } else { 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 WP with index $ix1 will not be cleared
    # slow operation dialog used if there are more than 100 WPs
    global WPName WPPosn WPDatum WPDispl EdWindow GMEd

    set wpixs [array names WPName]
    if { [lindex $wpixs 100] != "" } {
	set slow 1
	set sid [SlowOpWindow $TXT(displ)]
    } else {
	set slow 0
	SetCursor . watch
    }
    if { [winfo exists $EdWindow(WP)] } {
	set edix $GMEd(WP,Index)
    } 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 [ToDatum [lindex $p2 0] [lindex $p2 1] $d2 $d1]
    }
    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 $wpixs {
	if { $slow && [SlowOpAborted] } { break }
	if { $ixn != $ix1 && (($displ && ! $WPDispl($ixn)) || \
		              (! $displ && $WPDispl($ixn))) } {
	    set pn $WPPosn($ixn) ; set dn $WPDatum($ixn)
	    if  { $d1 != $dn } {
		set pn [ToDatum [lindex $pn 0] [lindex $pn 1] $dn $d1]
	    }
	    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
    if { $slow } {
	SlowOpFinish $sid ""
    } else { 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 GMEd

    set displ [string compare $how clear]
    if { [winfo exists $EdWindow(RT)] } {
	set edix $GMEd(RT,Index)
    } 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 GMEd ${wh}Displ EdWindow

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

##### background image

### geo-referencing an image

proc MapLoadWPSelect {n} {
    # select WPs (existing or to be defined) for geo-referencing
    #  $n is either ">=INT" or number of WPs needed
    # global variables set:
    #  $MapLoadWPDefs is the maximum number of WPs that may be defined
    #   (will be 0 at the end)
    #  $MapLoadWPs is list with indices of WPs (-1 for those to be defined)
    #  $MapLoadWPNs is list of names of WPs ("(?)" for those to be defined)
    # return number of points selected on success, -1 if operation cancelled
    global Number MapLoadWPDefs MapLoadWPs MapLoadWPNs MapLoading WPName \
	TXT MESS

    set MapLoadWPs "" ; set MapLoadWPNs ""
    if { [regexp {^>=([1-9])$} $n x min] } {
	while 1 {
	    if { $Number(WP) < $min } {
		set MapLoadWPDefs [expr $min-$Number(WP)]
	    } else { set MapLoadWPDefs 0 }
	    set wps [ChooseItems WP many_0 MapLoadWPDefs [list =$TXT(cwpsdef)]]
	    if { $wps == -1 } { return -1 }
	    if { ! [regexp {^ *(0|([1-9][0-9]*)) *$} $MapLoadWPDefs \
			x MapLoadWPDefs] } {
		GMMessage [format $MESS(nan) $MapLoadWPDefs]
		continue
	    }
	    set n [expr $MapLoadWPDefs+[llength $wps]]
	    if { $n >= $min } { break }
	    GMMessage [format $MESS(needNpoints) 3]
	}
	if { ! [regexp {^([a-zA-Z0-9_]+)=} $MapLoading x how] } {
	    BUG bad contents of MapLoading in proc MapLoadWPSelect
	    return -1
	}
	set MapLoading ${how}=$n
	set MapLoadWPs $wps
	foreach ix $wps {
	    lappend MapLoadWPNs $WPName($ix)
	}
    } else {
	if { $Number(WP) < $n } {
	    set missing [expr $n-$Number(WP)]
	} else { set missing 0 }
	set no [expr $n-$missing]
	set MapLoadWPDefs $missing
	while { $no > 0 } {
	    set ds $MapLoadWPDefs
	    for { set i [expr $MapLoadWPDefs+1] } { $i <= $n } { incr i } {
		lappend ds $i
	    }
	    set wps [ChooseItems WP many_0 MapLoadWPDefs \
			 [list +$TXT(cwpsdef)/$ds]]
	    if { $wps == -1 } { return -1 }
	    foreach ix $wps {
		set nn $WPName($ix) ; set d 0
		foreach name $MapLoadWPNs {
		    if { $name == $nn } { set d 1 ; break }
		}
		if { $d } {
		    GMMessage [format $MESS(duplicate) $nn]
		} else {
		    lappend MapLoadWPs $ix ; lappend MapLoadWPNs $nn
		    incr no -1 ; incr n -1
		    if { $no == 0 } { break }
		}
	    }
	    if { $MapLoadWPDefs >= $n } {
		set MapLoadWPDefs $n ; break
	    }
	}
    }
    # number of WPs to be defined later
    while { $MapLoadWPDefs > 0 } {
	lappend MapLoadWPs -1 ; lappend MapLoadWPNs "(?)"
	incr MapLoadWPDefs -1
    }
    return $n
}

proc LoadMapBack {args} {
    # load map background
    # if $args==""  load either an image to be geo-ref'd, or information on
    #          an image and geo-referencing information
    # otherwise $args is list with name of a background definition and
    #          menu (not used)
    global Map File MESS

    if { [$Map find all] != "" && ! [GMConfirm $MESS(clrcurrmap)] } {
	return
    }
    if { $args == "" } {
	set r [LoadMapFixedBk ""]
	switch -- [lindex $r 0] {
	    0 {
		LoadMapBackImage $File(MapBkInfo)
	    }
	    1 {
		eval LoadMapBackGeoRef [lreplace $r 0 0]
	    }
	}
    } elseif { [set fn [GetDefFields backgrnd [lindex $args 0] file]] == ""  } {	BUG backgrnd definition with empty file
    } else {
	set r [LoadMapFixedBk $fn]
	if { [lindex $r 0] == 1 } {
	    eval LoadMapBackGeoRef [lreplace $r 0 0]
	}
    }
    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.fr3.mn configure -state disabled
    $MpW.frm.frmap3.fr3.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 pfdatum 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 MapProjection MapProjTitle \
	    MapTransf MAPPROJDATA MAPPARTPDATA MAPPARTPROJ MAPPROJAUX

    set MapScale $scale
    catch {unset MPData} ; catch {unset MTData}
    MapProjectionIs [lindex $pdata 0]
    set MPData(datum) $datum
    if { [catch {set mp $MAPPARTPROJ($MapProjection)}] } {
	set mp $MapProjection
	foreach p [lindex $pdata 1] {
	    set MPData([lindex $p 0]) [lindex $p 1]
	}
	if { $MapProjection == "UTM" } {
	    regexp {^([0-9]+)[ ]*([A-Z])$} $MPData(UTMzone) x ze zn
	    set MPData(UTMzone) [list $ze $zn]
	}
    } else {
	foreach e $MAPPROJDATA($mp) v $MAPPARTPDATA($MapProjection) {
	    set MPData($e) $v
	}
	if { [lsearch -exact $MAPPROJAUX $mp] != -1 } {
	    Proj${mp}ComputeAux MPData $datum
	}
    }
    ChangeMapDatum $datum
    # do not reorder this:
    ChangeMapPFormat $pformt ; ChangeMPFDatum $pfdatum
    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.fr3.cv.val configure -text $txt
    return
}

proc LoadMapBackGeoRef {path datum pdata tdata scale ixps csps} {
    # 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 in
    #   grid
    #  $csps: list of image canvas coordinates (NW) and path for subsidiary
    #   images not in grid
    global Map MapImageFile MapImageItems MapImageHeight MapImageWidth \
	    MapImageGrid MapImageNGrid MapImageNGCs MapEmpty MapPFormat MESS \
	    MapImageNGW MapImageNGH MapPFDatum

    foreach ixp $ixps {
	set p [lindex $ixp 2]
	if { [BadImage MapImage[lindex $ixp 0],[lindex $ixp 1] $p] } {
	    GMMessage "$MESS(badimage): $p"
	    return
	}
    }
    set MapImageNGrid 0
    foreach csp $csps {
	set p [lindex $csp 2]
	if { [BadImage MapImage$MapImageNGrid $p] } {
	    GMMessage "$MESS(badimage): $p"
	    return
	}
	incr MapImageNGrid
    }
    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 {
	foreach "dx dy p" $ixp {}
	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]
    set ni 0
    foreach csp $csps {
	foreach "x y p" $csp {}
	set MapImageFile($ni) $p ; set MapImageNGCs($ni) $x,$y
	set MapImageNGW($ni) [image width MapImage$ni]
	set MapImageNGH($ni) [image height MapImage$ni]
	set it [$Map create image $x $y -image MapImage$ni -anchor nw \
		-tags [list map mapimage forIm=$ni]]
	$Map lower $it
	lappend MapImageItems $it
	incr ni
    }
    SetMapBounds
    LoadMapParams $datum $pdata $tdata $MapPFormat $MapPFDatum $scale
    set MapEmpty 0
    ChangeOnState mapstateback normal
    return
}

proc LoadMapBackImage {filename} {
    # load map background image to be geo-referenced, from file under $filename
    global MpW MapLoading MapScale MapLdOldScale MapScInitVal EdWindow \
	MAPKNOWNTRANSFS MAPTRANSFNPTS CDPData MPData LSqsTransf MESS TXT TYPES

    # select transformation
    set ts "" ; set rs "" ; set rlsq "" ; set rlsqf ""
    foreach t $MAPKNOWNTRANSFS {
	lappend ts $TXT(TRNSF$t) ; lappend rs $t
	lappend rlsq lsq=$t ; lappend rlsqf lsqf=$t
    }
    lappend ts "@[linsert $ts 0 $TXT(lstsqs)]" \
	"@[linsert $ts 0 $TXT(lstsqsfile)]" $TXT(tfwfile) \
	$TXT(ozimapfile) $TXT(cancel)
    lappend rs $rlsq $rlsqf TFW OziMap 0
    switch -glob -- [set how [GMSelect $MESS(georefhow) $ts $rs]] {
	0 { return }
	lsq=* {
	    if { ! [regexp {lsq=(.+)$} $how x LSqsTransf] } {
		BUG LoadMapBackImage regexp lsq= failed
	    }
	    set how LeastSquares
	}
	lsqf=* {
	    if { ! [regexp {lsqf=(.+)$} $how x LSqsTransf] } {
		BUG LoadMapBackImage regexp lsqf= failed
	    }
	    set how LeastSquaresFile
	}
    }

    # load and check image
    if { [BadImage MapImage $filename] } {
	GMMessage $MESS(badimage)
	return
    }
    MapCreateOriginImage [file join [pwd] $filename]
    # save scale
    set s [$MpW.frm.frmap3.fr3.cv.val cget -text]
    if { [scan $s %d MapLdOldScale] != 1 } {
	set MapLdOldScale $MapScInitVal
    }
    switch $how {
	LeastSquaresFile -  OziMap -  TFW {
	    ReadApplyTransfData $how $filename 
	}
	default {
	    # disable display of items being edited
	    foreach wh $TYPES {
		if { [winfo exists $EdWindow($wh)] } {
		    $EdWindow($wh).fr.frdw.displayed configure -state disabled
		}
	    }
	    # find number of control waypoints needed
	    set n $MAPTRANSFNPTS($how)
	    set MapLoading ${how}=$n
	    # dialog to select/define waypoints and supervise their placement
	    MapLoadBkDial $how $n
	}
    }
    return
}

proc ReadApplyTransfData {fmt filename} {
    # load or import transformation data from file and set up projection and
    #  transformation
    #  $fmt in {LeastSquaresFile, OziMap, TFW}
    # reading procs must return 0 on error or a list whose head is a list of
    #  latd,longd,datum to be projected (possibly empty); the whole list is
    #  passed as a parameter to the transformation initialization proc
    # initializion procs return 0 on error, or may return a list of WP
    #  names to be displayed (but see below!)
    global MPData MTData CDPData MESS MapScale MapLoading

    set MapLoading importing
    if { $fmt == "LeastSquaresFile" } {
	set indata [LoadLeastSquaresInfo]
	set fmt LeastSquares
    } else { set indata [Import$fmt $filename] }
    if { $indata != 0 } {
	set ps [lindex $indata 0]
	if { [set proj [ChooseDatumProjection $ps]] == 0 } {
	    set indata 0
	}
    }
    if { $indata == 0 } {
	MapLoadBkCancel
	return
    }
    catch {unset MPData} ; catch {unset MTData}
    array set MPData [array get CDPData]
    if { [set res [MapInit${fmt}Transf $indata $CDPData(main_proj)]] == 0 } {
	GMMessage $MESS(badTransfargs)
	MapLoadBkCancel
	return
    }
    MapProjectionIs $proj
    ChangeMapDatum $CDPData(datum)
    MapScaleChange $MapScale
    set MapLoading 0
    MapLoadBkDialDone
    # display WPs if needs be
    if { $fmt == "LeastSquares" } {
	foreach name $res { PutMap WP [IndexNamed WP $name] }
    }
    return
}

proc MapLoadBkDial {how n} {
    # dialog used during map background loading
    #  $how in $MAPKNOWNTRANSFS or LeastSquares
    #  $n is either ">=INT", or number of WPs used for geo-referencing
    # this dialog is changed by proc DefineCtrlPoint
    global WPName MapLoadWPs MapLoadWPNs LISTWIDTH TXT MESS COLOUR EPOSX EPOSY

    if { [set n [MapLoadWPSelect $n]] == -1 } {
	MapLoadBkCancel
	return
    }
    destroy .wmapload
    # used elsewhere
    set w .wmapload
    GMToplevel $w mapload +[expr $EPOSX+100]+$EPOSY {} \
        {WM_DELETE_WINDOW MapLoadBkCancel} {}

    frame $w.fr -borderwidth 5 -bg $COLOUR(messbg)
    label $w.fr.title -text $TXT(mapload) -relief sunken
    message $w.fr.text -aspect 800 -text $MESS(mapadjust)

    frame $w.fr.frbx
    listbox $w.fr.frbx.bx -width $LISTWIDTH -relief flat \
 	    -selectmode single -exportselection 1
    bind $w.fr.frbx.bx <Button-1> "$w.fr.frbx.bx selection clear 0 end"
    if { $n < 8 } {
	$w.fr.frbx.bx configure -height $n
	pack $w.fr.frbx.bx
    } else {
	$w.fr.frbx.bx configure -height 8 \
	    -yscrollcommand "$w.fr.frbx.bscr set"
	scrollbar $w.fr.frbx.bscr -command "$w.fr.frbx.bx yview"
	grid $w.fr.frbx.bx $w.fr.frbx.bscr -sticky ns
    }
    frame $w.fr.bns
    button $w.fr.bns.ok -text $TXT(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.frbx $w.fr.bns -side top -pady 5
    if { $how == "NoRot" } {
	# show WPs in the order they were selected
	set ix end
    } else {
	# show in reverse order because in these cases WPs will be taken
	#  from right to left of $MapLoadWPs by the cursor procedures
	set ix 0
    }
    foreach name $MapLoadWPNs {
	$w.fr.frbx.bx insert $ix $name
    }
    raise $w
    update idletasks

    if { $how == "NoRot" } {
	MapComputePositions
    }
    # 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.frdw.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 GMEd MESS MPData MTData MapImageNGrid

    if { $MapLoading != 0 } {
	catch {unset MTData}
	set remap 0
	switch -glob $MapLoading {
	    Affine* {
		regexp {(Affine[a-zA-Z_]*)=} $MapLoading x tr
		if { ! [MapInit${tr}Transf] } {
		    GMMessage $MESS(cantsolve)
		    MapLoadBkCancel
		    return
		}
	    }
	    LeastSquares=* {
		if { [MapInitLeastSquaresTransf] == 0 } {
		    GMMessage $MESS(cantsolve)
		    MapLoadBkCancel
		    return
		}
		# must re-map all control points
		incr remap
	    }
	    NoRot=* {
		MapInitNoRotTransf $MapScale $MapLoadPos(xt0) \
			$MapLoadPos(yt0) $MapLoadPos(origin,x) \
			$MapLoadPos(origin,y)
	    }
	}
	MapScaleChange $MapScale
	MapLoadRestore
	$Map delete mapadjust
	set MapEmpty 0
	foreach wpix $MapLoadWPs {
	    if { $remap } {
		UnMapWP $wpix ; PutMapWP $wpix
	    }
	    set WPDispl($wpix) 1
	    if { [winfo exists $EdWindow(WP)] && $GMEd(WP,Index) == $wpix } {
		set GMEd(WP,Displ) 1
		set GMEd(WP,Data) [lreplace $GMEd(WP,Data) end end 1]
		$EdWindow(WP).fr.frdw.displayed select
	    } else {
		SetDisplShowWindow WP $wpix select
	    }
	}
    }
    set MapEmpty 0
    set MapImageNGrid 0
    ChangeOnState mapstateback normal
    return
}

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

    if { [winfo exists .wmapload.frd] } {
	set Dfctrl 0
	return
    }
    eval $Map delete [$Map find all]
    set MapEmpty 1
    set MapImageItems ""
    MapMeasureEnd
    SetMapBounds
    if { $MapLoading != 0 } {
	MapLoadRestore
	# now $MapLoading is 0
	$MpW.frm.frmap3.fr3.mn configure -state normal
	MapScaleChange $MapLdOldScale
    }
    return
}

proc DefineCtrlPoint {w mpix lbox cancel} {
    # change map loading dialog to define a control waypoint
    #  $w is parent of frame that will be created and destroyed for
    #   entering the information
    #  $mpix is index of control waypoint in $MapLoadWPs and $MapLoadWPNs
    #   which will be updated with WP index and name on success
    #  $lbox is either "", or listbox in which names of defined waypoints
    #   must be replaced at index $mpix
    #  $cancel is true if Cancel button must be created
    # binding: Return for create
    # return WP index, or -1 on failure
    global PositionFormat TXT MESS NAMEWIDTH Datum CPDatum CPChangedPosn \
	    CREATIONDATE Dfctrl COLOUR MapLoadWPs MapLoadWPNs DefCPWindow \
	    INVTXT

    # used in ancillary procs
    set DefCPWindow $w
    destroy $w.frd
    set Dfctrl 0
    set CPChangedPosn 1 ; set CPDatum $Datum
    frame $w.frd -relief flat -borderwidth 2 -bg $COLOUR(dialbg)
    label $w.frd.ntitle -text "$TXT(name):"
    entry $w.frd.id -width $NAMEWIDTH -exportselection 1
    ShowTEdit $w.frd.id "" 1
    ShowPosnDatum $w.frd $PositionFormat [list ""] DefCPChangeDatum CPDatum \
	CPDatum normal 1 CPChangedPosn
    frame $w.frd.frb -relief flat -borderwidth 0
    button $w.frd.frb.ct -text $TXT(create) \
	    -command "$w.frd.frb.ct configure -state normal ; set Dfctrl 1"
    button $w.frd.frb.cnc -text $TXT(cancel) \
	    -command "$w.frd.frb.cnc configure -state normal ; set Dfctrl 0"
    grid configure $w.frd.ntitle -column 0 -row 0 -sticky w
    grid configure $w.frd.id -column 1 -row 0 -sticky w
    grid configure $w.frd.frp -column 0 -row 1 -columnspan 2 -pady 3
    grid configure $w.frd.frd -column 0 -row 2 -columnspan 2
    grid configure $w.frd.frb.ct -column 0 -row 0
    if { $cancel } {
	grid configure $w.frd.frb.cnc -column 1 -row 0
    }
    grid configure $w.frd.frb -column 0 -row 3 -columnspan 2 -pady 5
    pack $w.frd -side top -pady 5

    update idletasks
    set pw [grab current]
    grab $w
    bind $w <Return> { set Dfctrl 1 ; break }
    raise $w
    focus $w.frd.id
    while 1 {
	tkwait variable Dfctrl

	if { $Dfctrl } {
	    set p [PosnGetCheck $w.frd.frp.frp1 $CPDatum GMMessage \
		       CPChangedPosn]
	    if { $p == "nil" } { bell ; continue }
	    if { [string trim [$w.frd.id get]] == "" } {
		set name [NewName WP]
	    } else {
		set name [CheckEntries GMMessage "" \
			               [list [list $w.frd.id CheckName]]]
		if { $name == "" } { continue }
		if { [CheckArrayElement WPName $name] } {
		    GMMessage $MESS(idinuse)
		    continue
		}
	    }
	    set pf $INVTXT([$w.frd.frp.pfmt cget -text])
	    if { $CREATIONDATE } {
		set data [FormData WP \
			      [list Name Posn PFrmt Datum Date Symbol] \
			      [list $name $p $pf $CPDatum [Now] mark_x]]
	    } else {
		set data [FormData WP [list Name Posn PFrmt Datum Symbol] \
			           [list $name $p $pf $CPDatum mark_x]]
	    }
	    set ix [CreateItem WP $data]
	    set MapLoadWPs [lreplace $MapLoadWPs $mpix $mpix $ix]
	    set MapLoadWPNs [lreplace $MapLoadWPNs $mpix $mpix $name]
	    if { $lbox != "" } {
		$lbox delete $mpix ; $lbox insert $mpix $name
	    }
	    break
	} else { set ix -1 ; break }
    }
    grab release $w
    foreach pg $pw {
	if { [winfo exists $pg] } { grab $pg }
    }
    pack forget $w.frd
    destroy $w.frd
    return $ix
}

proc DefCPChangeDatum {datum args} {
    # change datum of control WP being defined
    #  $args is not used but is needed as this is called-back from a menu
    global DefCPWindow

    ChangeDatum $datum CPDatum CPDatum CPChangedPosn $DefCPWindow.frd.frp
    return
}

proc MapGeoRefPoints {n} {
    # in command line mode just return the projected coordinates given
    #  by proc CmdProjCoords
    # in graphical mode compute planar Cartesian coordinates of $n WPs
    #  for geo-referencing and initialize projection procedure
    #    $MapLoadWPs is list of indices of relevant WPs
    #  assume that .wmapload is being used
    # return list of coordinates, or -1 on cancel
    global Datum MapLoadWPs WPPosn WPDatum MapProjInitProc MapProjPointProc \
	    MapProjection MPData Datum CMDLINE

    if { $CMDLINE } {
	return [CmdProjCoords $n]
    }
    for { set i 0 ; set ps "" } { $i < $n } { incr i } {
       if { [set ix [lindex $MapLoadWPs $i]] == -1 && \
            [set ix [DefineCtrlPoint .wmapload $i \
			 .wmapload.fr.frbx.bx 0]] == -1 } {
	   MapLoadBkCancel
	   return -1
       }
       set p $WPPosn($ix)
       set latd [lindex $p 0] ; set longd [lindex $p 1]
       if { [set datum $WPDatum($ix)] != $Datum } {
	   set p [ToDatum $latd $longd $datum $Datum]
	   set latd [lindex $p 0] ; set longd [lindex $p 1]
       }
       lappend ps [list $latd $longd $Datum]
   }
   catch {unset MPData}
   $MapProjInitProc $MapProjection 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

    if { [set tcs [MapGeoRefPoints 3]] == -1 } { return }
    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
    # start with 3rd WP, then 2nd
    foreach a "2 1" {
	set p [lindex $tcs $a]
	set xta [lindex $p 0] ; set yta [lindex $p 1]
	# difference in projected coordinates from first point
	set MapLoadPos(dmx,$a) [set dx [expr $xta-$xt0]]
	set MapLoadPos(dmy,$a) [set dy [expr $yta-$yt0]]
	# $dx/$l is cos of angle of line from 1st point to point and x-axis
	# $dy/$l is sin of same angle
	# distance from point to first point
	set l [expr sqrt(1.0*$dx*$dx+1.0*$dy*$dy)]
	# difference in canvas coordinates between point and a point on the
	#  line from first point but at distance $mx (out of canvas)
        set MapLoadPos(dx,$a) [set dxc [expr $mx/$l*$dx]]
	set MapLoadPos(dy,$a) [set dyc [expr -$mx/$l*$dy]]
	# position of line from (100,100) to out of canvas, parallel to
	#  line from 1st point to point
	set MapLoadPos(pos,$a) [list 100 100 [expr 100+$dxc] [expr 100+$dyc]]
    }
    # for 2nd WP, using $dx,$dy and $l computed above
    # axis along which difference in coordinates is larger
    if { abs($dx) >= abs($dy) } {
	set MapLoadPos(dir) x
    } else {
	set MapLoadPos(dir) y
    }
    set MapLoadPos(dist) $l
    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.fr3.mn configure -state normal
	ChangeOnState mapstateback disabled
	return 1
    }
    return 0
}

proc SaveMapBack {args} {
    # save map background image information
    # in graphical mode
    #  $args is either "" or file
    # in command line mode
    #  $args is list with path to image file and file to write on
    global Map MapImageFile MapScale MapProjection MPData MapTransf MTData \
	    MAPPARTPROJ MAPPROJDATA MAPTRANSFDATA MapImageNGCs CMDLINE

    if { $CMDLINE } {
	set MapImageFile(0,0) [lindex $args 0]
	set args [lindex $args 1]
    } elseif { [$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 lg "" ; set lc ""
    foreach n [array names MapImageFile] {
	if { [string first "," $n] != -1 } {
	    # image in grid
	    if { $n != "0,0" } {
		lappend lg [list $n $MapImageFile($n)]
	    }
	} else {
	    lappend lc [list $MapImageNGCs($n) $MapImageFile($n)]
	}
    }
    SaveFileTo $args mapback MapBkInfo $MapImageFile(0,0) $pd $pt $MapScale \
	    $lg $lc
    return
}

proc ExportMapTFW {} {
    # export parameters of the transformation used for map background image
    #  as a TFW file
    global Map

    if { [$Map find withtag mapimage] == "" } { return }
    ExportTFW [MapAffineParams]
    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 MapPFDatum

    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 $MapPFDatum $MapScale
    return
}

proc ChangeMapBack {} {
    # dialog used to change map background images
    # this dialog may be changed by proc DefineCtrlPoint
    global MapImageGrid MapImageFile TXT EPOSX EPOSY COLOUR MAPCOLOUR \
	    MapBackNGSelect MapBackNGIxs MapBackCellW MapBackCellH \
	    FixedFont

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

    GMToplevel $w mpbkchg +$EPOSX+$EPOSY {} \
        [list WM_DELETE_WINDOW  "destroy $w"] {}

    set MapBackNGSelect ""
    # width and height of grid cell
    set MapBackCellW 43 ; set MapBackCellH 21

    frame $w.fr -borderwidth 5 -bg $COLOUR(messbg)
    label $w.fr.title -text $TXT(mpbkchg) -relief sunken
    frame $w.fr.frg -relief flat -borderwidth 0
    frame $w.fr.frng -relief flat -borderwidth 0

    ## images in a grid
    set rw $MapBackCellW ; set rh $MapBackCellH
    set wd [expr 3*$rw] ; set hg [expr 3*$rh]
    set cv $w.fr.frg.grid
    canvas $cv -width $wd -height $hg -relief sunken \
	    -xscrollincrement $rw -yscrollincrement $rh
    # make central 3x3 grid: 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
    }
    # 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
		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
		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.frg.cs
    label $w.fr.frg.cs.tit -text $TXT(mpbkgrcs):
    label $w.fr.frg.cs.cs -text 0,0

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

    frame $w.fr.frg.bns
    button $w.fr.frg.bns.ld -text $TXT(load) \
	    -command "MapBackGridLoad ; \
	              $w.fr.frg.bns.ld configure -state normal"
    button $w.fr.frg.bns.clr -text $TXT(clear) -state disabled \
	    -command "MapBackGridClear ; \
	              $w.fr.frg.bns.clr configure -state normal"

    ## images out of grid
    listbox $w.fr.frng.bx -width 50 -height 8 -relief flat -exportselection 1 \
	    -yscrollcommand "$w.fr.frng.bscr set" \
 	    -selectmode single -font $FixedFont
    bind $w.fr.frng.bx <Button-1> { MapBackBoxSetSelect [%W nearest %y] }
    bind $w.fr.frng.bx <Enter> { MapBackBoxShow }
    bind $w.fr.frng.bx <Leave> { .wchgmapbak.fr.frg.grid delete nongrid }
    set MapBackNGIxs ""
    foreach n [lsort [array names MapImageFile]] {
	if { [string first "," $n] == -1 } {
	    $w.fr.frng.bx insert end $MapImageFile($n)
	    lappend MapBackNGIxs $n
	}
    }
    scrollbar $w.fr.frng.bscr -command "$w.fr.frng.bx yview"
    frame $w.fr.frng.bns
    button $w.fr.frng.bns.ld -text $TXT(load) \
	    -command "MapBackNGridLoad ; \
	              $w.fr.frng.bns.ld configure -state normal"
    button $w.fr.frng.bns.clr -text $TXT(clear) -state disabled \
	    -command "MapBackNGridClear ; \
	              $w.fr.frng.bns.clr configure -state normal"
    # frame for defining control waypoint (used by proc DefineCtrlPoint)
    frame $w.fr.frng.df

    frame $w.fr.bns
    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 $TXT(ok) -command "destroy $w"

    pack $w.fr.frg.cs.tit $w.fr.frg.cs.cs -side left
    pack $w.fr.frg.pt.tit $w.fr.frg.pt.pt -side left
    pack $w.fr.frg.bns.ld $w.fr.frg.bns.clr -side left
    pack $w.fr.frg.grid $w.fr.frg.cs $w.fr.frg.pt $w.fr.frg.bns -side top \
	    -pady 5

    pack $w.fr.frng.bns.ld $w.fr.frng.bns.clr -side left
    grid configure $w.fr.frng.bx -row 0 -column 0 -sticky nesw
    grid configure $w.fr.frng.bscr -row 0 -column 1 -sticky ns
    grid configure $w.fr.frng.bns -row 1 -column 0 -columnspan 2 -pady 5
    grid configure $w.fr.frng.df -row 2 -column 0 -columnspan 2 -pady 5

    pack $w.fr.bns.clrall $w.fr.bns.ok -side left
    grid configure $w.fr.title -row 0 -column 0 -columnspan 2
    grid configure $w.fr.frg -row 1 -column 0 -sticky nesw -pady 5
    grid configure $w.fr.frng -row 1 -column 1 -sticky nesw -pady 5 -padx 3
    grid configure $w.fr.bns -row 2 -column 0 -columnspan 2 -pady 5

    pack $w.fr

    update idletasks
    return
}

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

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

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

    if { [catch {set MapImageFile($dx,$dy)}] } {
	set c emptygrid
    } else { set c fullgrid }
    .wchgmapbak.fr.frg.grid 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.frg ; 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.frg.cs.cs configure -text $dx,$dy
    .wchgmapbak.fr.frg.pt.pt configure -text $p
    return
}

proc MapBackGridLoad {} {
    # (re-)load one image for map background
    global Map MapImageFile MapImageWidth MapImageHeight MapImageItems \
	    MapImageGrid File MESS TXT MAPCOLOUR

    set fr .wchgmapbak.fr.frg
    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)
	MapWideBackGrid $cv y $dy Row \
		$MapImageGrid(dxmin) $MapImageGrid(dxn)
	$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.frg
    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}
	catch {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} {
    # 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
    global MapImageGrid MAPCOLOUR MapBackCellW MapBackCellH

    set m [expr $dymin+$dyn]
    set rw $MapBackCellW ; set rh $MapBackCellH
    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} {
    # 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
    global MapImageGrid MAPCOLOUR MapBackCellW MapBackCellH

    set m [expr $dxmin+$dxn]
    set rw $MapBackCellW ; set rh $MapBackCellH
    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} {
    # 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
    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
	} 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
	}
	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 MapBackBoxSetSelect {i} {
    # non-grided image selected in listbox corresponds to $i-th file there
    global MapBackNGSelect MapBackNGIxs

    .wchgmapbak.fr.frg.grid delete nongrid
    set MapBackNGSelect [lindex $MapBackNGIxs $i]
    .wchgmapbak.fr.frng.bns.clr configure -state normal
    MapBackBoxShow
    return
}

proc MapBackBoxShow {} {
    # show selected non-grided image over grid if grid canvas is not too small
    global Map MapBackNGSelect MapBackCellW MapBackCellH MapImageHeight \
	    MapImageWidth MAPCOLOUR MapImageNGW MapImageNGH

    if { $MapBackNGSelect != "" } {
	foreach "x0 y0" [$Map coords forIm=$MapBackNGSelect] {}
	set scx [expr 1.0*$MapBackCellW/$MapImageWidth]
	set scy [expr 1.0*$MapBackCellH/$MapImageHeight]
	set gx0 [expr $MapBackCellW+$x0*$scx]
	set gy0 [expr $MapBackCellH+$y0*$scy]
	set gxn [expr $MapBackCellW+($x0+$MapImageNGW($MapBackNGSelect))*$scx]
	set gyn [expr $MapBackCellH+($y0+$MapImageNGH($MapBackNGSelect))*$scy]
	.wchgmapbak.fr.frg.grid create rectangle $gx0 $gy0 $gxn $gyn \
		-fill $MAPCOLOUR(mapsel) -tags nongrid
    }
    return
}

proc MapBackNGridClear {} {
    # delete selected non-grided image
    global Map MapBackNGSelect MapBackNGIxs MapImageNGrid MapImageFile \
	    MapImageNGCs MapImageItems MapImageNGW MapImageNGH

    if { $MapBackNGSelect != "" && \
	    [set it [$Map find withtag forIm=$MapBackNGSelect]] != "" } {
	$Map delete $it
	if { $MapImageNGrid == $MapBackNGSelect+1 } { incr MapImageNGrid -1 }
	catch { unset MapImageFile($MapBackNGSelect) }
	catch { unset MapImageNGCs($MapBackNGSelect) }
	catch { unset MapImageNGW($MapBackNGSelect) }
	catch { unset MapImageNGH($MapBackNGSelect) }
	if { [set i [lsearch -exact $MapImageItems $it]] != -1 } {
	    set MapImageItems [lreplace $MapImageItems $i $i]
	}
	if { [set i [lsearch -exact $MapBackNGIxs $MapBackNGSelect]] != -1 } {
	    set MapBackNGIxs [lreplace $MapBackNGIxs $i $i]
	    .wchgmapbak.fr.frng.bx delete $i
	    .wchgmapbak.fr.frng.bx selection clear 0 end
	    .wchgmapbak.fr.frng.bns.clr configure -state disabled
	}
	set MapBackNGSelect ""
    }
    return
}

proc MapBackNGridLoad {} {
    # (re-) load a non-grided image to background
    global Map MapImageItems TXT MESS File MapImageNGrid MapImageFile \
	    MapImageNGCs MapBackNGIxs MapLoadWPs MapLoadPos WPPosn WPDatum \
	    MapImageNGW MapImageNGH

    if { [set f [GMOpenFile $TXT(loadfrm) Image r]] != ".." } {
	set filename $File(Image) ; set n $MapImageNGrid
	if { [BadImage MapImage$n $filename] } {
	    GMMessage $MESS(badimage)
	    return
	}
	set iwd [image width MapImage$n] ; set iht [image height MapImage$n]
	# geo-reference with 1 ctrl waypoint
	if { [MapLoadWPSelect 1] == -1 || \
	     ( $MapLoadWPs == -1 && \
	       [DefineCtrlPoint .wchgmapbak.fr.frng.df 0 "" 1] == -1 ) || \
	     [MapBackNGPlaceWP $n $iwd $iht] == -1 } {
	    image delete MapImage$n
	    return
	}
	# compute image NW corner canvas coordinates $x,$y
	#  WP canvas coordinates
	set ix $MapLoadWPs
	set p [MapFromPosn [lindex $WPPosn($ix) 0] [lindex $WPPosn($ix) 1] \
	              $WPDatum($ix)]
	set x [expr round([lindex $p 0]-$MapLoadPos(0,x))]
	set y [expr round([lindex $p 1]-$MapLoadPos(0,y))]
	# display image
	set it [$Map create image $x $y -image "MapImage$n" -anchor nw \
		-tags [list map mapimage forIm=$n]]
	$Map lower $it
	lappend MapImageItems $it
	SetMapBounds
	# update image data
	set MapImageFile($n) [file join [pwd] $filename]
	set MapImageNGCs($n) $x,$y
	set MapImageNGW($n) $iwd ; set MapImageNGH($n) $iht
	incr MapImageNGrid
	# update dialog
	.wchgmapbak.fr.frng.bx insert end $MapImageFile($n)
	.wchgmapbak.fr.frng.bx selection clear 0 end
	lappend MapBackNGIxs $n
    }
    return
}

proc MapBackNGPlaceWP {imno wd ht} {
    # display image MapImage$imno ($wd x $ht) in a canvas and let the user
    #  place WP with index $MapLoadWPs (!= -1) in it
    # return -1 if operation is cancelled; otherwise WP canvas coordinates
    #  (NW corner of image at 0,0) will be stored in MapLoadPos(0,_)
    global MapLoadWPs TXT MESS Dfctrl MPOSX MPOSY MapHeight MapWidth COLOUR \
	    MapNGLoading MapNGRangex MapNGRangey

    # window name used elsewhere
    set w .mapng ; set Dfctrl 0
    if { [set mw $MapWidth] > $wd } { set mw $wd }
    if { [set mh $MapHeight] > $ht } { set mh $ht }
    destroy $w
    GMToplevel $w mpbkchg +$MPOSX+$MPOSY {} \
        {WM_DELETE_WINDOW {set Dfctrl 0}} {}

    set MapNGLoading 1
    set MapNGRangex $wd ; set MapNGRangey $ht

    frame $w.fr -relief flat -borderwidth 2 -bg $COLOUR(dialbg)
    message $w.fr.text -aspect 800 -text $MESS(mapadjust)
    set map $w.fr.map
    canvas $map -borderwidth 5 -relief groove -confine true \
	    -scrollregion [list 0 0 $wd $ht] -width $mw -height $mh \
	    -xscrollincrement 1 -yscrollincrement 1 \
	    -xscrollcommand "$w.fr.mhscr set" \
	    -yscrollcommand "$w.fr.mvscr set"
    scrollbar $w.fr.mhscr -orient horizontal -command "MapNGScroll x"
    scrollbar $w.fr.mvscr -command "MapNGScroll y"
    $map create image 0 0 -anchor nw -image MapImage$imno
    MapNGSetVOrigin x ; MapNGSetVOrigin y
    $map configure -cursor crosshair
    bind $map <Enter> "focus $map ; MapNGCursor"
    bind $map <Leave> { focus . ; UnMapNGCursor }
    bind $map <Motion> "$map scan mark %x %y; MapNGCursorMotion %x %y"
    bind $map <Button-1> { MarkMapNGPoint %x %y }
    bind $map <Return> { MarkMapNGPoint %x %y }

    # scrolling/panning bindings as for $Map
    bind $map <Key-Up> { MapNGScroll y scroll -1 units ; MapNGCursorUpdate }
    bind $map <Key-Delete> { MapNGScroll y scroll -1 pages
       MapNGCursorUpdate }
    bind $map <Key-space> { MapNGScroll y scroll 1 pages ; MapNGCursorUpdate }
    bind $map <Key-Down> { MapNGScroll y scroll 1 units ; MapNGCursorUpdate }
    bind $map <Key-Left> { MapNGScroll x scroll -1 units ; MapNGCursorUpdate }
    bind $map <Key-Right> { MapNGScroll x scroll 1 units ; MapNGCursorUpdate }
    bind $map <Shift-Up> { MapNGScroll y scroll -1 units
       MapNGScroll x scroll 1 units ; MapNGCursorUpdate }
    bind $map <Shift-Down> { MapNGScroll y scroll 1 units
       MapNGScroll x scroll -1 units ; MapNGCursorUpdate }
    bind $map <Shift-Left> { MapNGScroll y scroll -1 units
       MapNGScroll x scroll -1 units ; MapNGCursorUpdate }
    bind $map <Shift-Right> { MapNGScroll y scroll 1 units
       MapNGScroll x scroll 1 units ; MapNGCursorUpdate }
    bind $map <Control-Motion> "$map scan dragto %x %y 1; \
	    MapNGSetVOrigin x ; MapNGSetVOrigin y ; MapNGCursorUpdate"
    bind $map <B2-Motion> "$map scan dragto %x %y ; MapNGSetVOrigin x ; \
	    MapNGSetVOrigin y ; MapNGCursorUpdate"
    bind $map <Button-5> { MapNGScroll y scroll 25 units ; MapNGCursorUpdate }
    bind $map <Button-4> { MapNGScroll y scroll -25 units ; MapNGCursorUpdate }
    bind $map <Shift-Button-5> { MapNGScroll y scroll 1 pages
	MapNGCursorUpdate }
    bind $map <Shift-Button-4> { MapNGScroll y scroll -1 pages
	MapNGCursorUpdate }
    bind $map <Control-Button-5> { MapNGScroll x scroll 1 pages
	MapNGCursorUpdate }
    bind $map <Control-Button-4> { MapNGScroll x scroll -1 pages
	MapNGCursorUpdate }
    bind $map <Alt-Button-5> { MapNGScroll x scroll 25 units
	MapNGCursorUpdate }
    bind $map <Alt-Button-4> { MapNGScroll x scroll -25 units
	MapNGCursorUpdate }

    frame $w.fr.frbs
    button $w.fr.frbs.ok -text $TXT(ok) -command { set Dfctrl 1 } \
	-state disabled
    button $w.fr.frbs.cnc -text $TXT(cancel) -command { set Dfctrl 0 }

    pack $w.fr.frbs.ok $w.fr.frbs.cnc -side left
    grid configure $w.fr.text -row 0 -column 0 -columnspan 2
    grid configure $map -row 1 -column 0 -sticky nesw
    grid configure $w.fr.mvscr -row 1 -column 1 -sticky ns
    grid configure $w.fr.mhscr -row 2 -column 0 -sticky ew
    grid configure $w.fr.frbs -row 3 -column 0 -columnspan 2 -pady 5
    pack $w.fr
    # control is taken by the cursor procs; the "Ok" button is only
    #  enabled when the WP is placed in which case the relevant coordinates
    #  are stored in $MapLoadPos(0,x) and $MapLoadPos(0,y)
    update idletasks
    set gs [grab current]
    grab $w
    RaiseWindow $w
    tkwait variable Dfctrl
    DestroyRGrabs $w $gs
    if { $Dfctrl == 0 } { return -1 }
    return 0
}

proc MapNGScroll {dim args} {
    # scroll non-grid image map and set corresponding coordinate of origin
    #  of visible region
    # $dim in {x, y}, $args suitable to xview/yview commands
    #  scrollbar

    eval .mapng.fr.map ${dim}view $args
    MapNGSetVOrigin $dim
    return
}

proc MapNGSetVOrigin {dim} {
    # set coordinate of origin of visible region of non-grid image map
    # $dim in {x, y}
    global MapNGOV$dim MapNGRange$dim

    set sc [lindex [.mapng.fr.map ${dim}view] 0]
    set MapNGOV$dim [expr $sc*[set MapNGRange$dim]]
    return
}

proc MapNGCursor {} {
    # start following pointer on non-grid image map while waypoint is not
    #  placed
    # name of WP to place is in $MapLoadWPNs
    global MapLoadWPNs MAPCOLOUR MapNGLoading

    if { $MapNGLoading } {
	set map .mapng.fr.map
	$map delete mapfix
	$map create text 100 100 -fill $MAPCOLOUR(mapsel) -anchor sw \
		-text $MapLoadWPNs -justify left -tags mapfix
    }
    return
}

proc UnMapNGCursor {} {
    # stop following pointer on non-grid image map

    .mapng.fr.map delete mapfix
    return
}

proc MapNGCursorMotion {x y} {
    # follow pointer on non-grid image map
    global MapNGOVx MapNGOVy CRHAIRx CRHAIRy MapNGCursorPos

    set MapNGCursorPos [list $x $y]
    .mapng.fr.map coords mapfix [expr $MapNGOVx+$x-$CRHAIRx] \
	    [expr $MapNGOVy+$y-$CRHAIRy]
    return
}

proc MapNGCursorUpdate {} {
    # update cursor coordinates after scrolling
    global MapNGCursorPos

    if { ! [catch {set MapNGCursorPos}] } {
	eval MapNGCursorMotion $MapNGCursorPos
    }
    return
}

proc MarkMapNGPoint {x y} {
    # place waypoint on non-grid image map
    global MapNGOVx MapNGOVy CRHAIRx CRHAIRy MapLoadPos MapNGLoading \
	    MAPCOLOUR ICONHEIGHT MapFont MapLoadWPs MapLoadWPNs WPSymbol

    if { $MapNGLoading } {
	set MapNGLoading 0
	set map .mapng.fr.map
	$map delete mapfix
	set x [expr $MapNGOVx+$x-$CRHAIRx] ; set y [expr $MapNGOVy+$y-$CRHAIRy]
	set MapLoadPos(0,x) $x ; set MapLoadPos(0,y) $y
	$map create rectangle [expr $x-1] [expr $y-1] \
		[expr $x+1] [expr $y+1] -fill $MAPCOLOUR(WP) \
		-outline $MAPCOLOUR(WP)
	$map create text $x [expr $y-6-$ICONHEIGHT/2.0] \
		-text $MapLoadWPNs -fill $MAPCOLOUR(WP) -font $MapFont \
		-justify center
	set syim [lindex [SymbolImageName $WPSymbol($MapLoadWPs)] 0]
	$map create image $x $y -anchor center -image $syim
	.mapng.fr.frbs.ok configure -state normal
    }
    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]
	}
    }
    return
}


#### locate or clear items on map

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

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

proc LocatePrevious {} {
    # scroll map to get back to previous centre
    global Map PrevCentre

    if { [set p $PrevCentre] != "" } {
	set PrevCentre [list [lindex [$Map xview] 0] [lindex [$Map yview] 0]]
	ScrollMap x moveto [lindex $p 0]
	ScrollMap y moveto [lindex $p 1]
    }
    return
}

proc SelectApplyMapped {wh mode comm} {
    # select one or more items currently displayed on map and apply
    #  a command to them
    #  $wh is type (in $TYPES except GR) of items
    #  $mode is selection mode (1st arg to proc GMChooseFrom)
    #  $comm is command to invoke with the following arguments:
    #     $wh, item index and map item
    #     if $wh in {RT, TR, LN} the map item is for the first point
    #     of the selected item
    global Map TXT LISTWIDTH RTIdNumber RTWPoints TRName LNName

    set ns "" ; set ixmits ""
    switch $wh {
	WP {
	    foreach it [$Map find withtag WP&&sq2] {
		set ts [$Map gettags $it]
		if { [set k1 [lsearch -glob $ts WP=*]] != -1 && \
			[set k2 [lsearch -glob $ts forWP=*]] != -1 } {
		    regsub WP= [lindex $ts $k1] "" n
		    regsub forWP= [lindex $ts $k2] "" ix
		    lappend ns [list $n $ix $it]
		}
	    }
	}
	RT {
	    foreach it [$Map find withtag WP&&sq2] {
		set ts [$Map gettags $it]
		if { [set k1 [lsearch -glob $ts inRT=*]] != -1 && \
			[set k2 [lsearch -glob $ts WP=*]] != -1 } {
		    regsub inRT= [lindex $ts $k1] "" ix
		    regsub WP= [lindex $ts $k2] "" wpn
		    if { [lindex $RTWPoints($ix) 0] == $wpn } {
			lappend ns [list $RTIdNumber($ix) $ix $it]
		    }
		}
	    }
	}
	TR -   LN {
	    foreach it [$Map find withtag ${wh}first] {
		set ts [$Map gettags $it]
		if { [set k [lsearch -glob $ts ${wh}=*]] != -1 } {
		    regsub ${wh}= [lindex $ts $k] "" ix
		    if { $ix != -1 } {
			# test as in previous version...
			lappend ns [list [set ${wh}Name($ix)] $ix $it]
		    }
		}
	    }
	}
    }
    if { [set ns [lsort -dictionary -index 0 $ns]] == "" } { return }
    set lns "" ; set lvs ""
    foreach t $ns {
	lappend lns [lindex $t 0]
	lappend lvs [lreplace $t 0 0]
    }
    foreach p [GMChooseFrom $mode [list $TXT(select) $TXT(name$wh)] \
	                    $LISTWIDTH $lns $lvs] {
	$comm $wh [lindex $p 0] [lindex $p 1]
    }
    return
}

proc SelectApplyUnmapped {wh mode comm} {
    # select one or more items not currently displayed on map and apply
    #  a command to them
    #  $wh is type (in $TYPES) of items
    #  $mode is selection mode (1st arg to proc GMChooseFrom)
    #  $comm is command to invoke with the following arguments:
    #     $wh, item index
    global Map TXT TYPES LISTWIDTH Storage

    set ids [lindex $Storage($wh) 0]
    global $ids ${wh}Displ

    set ns ""
    foreach ix [array names $ids] {
	if { ! [set ${wh}Displ($ix)] } {
	    lappend ns [list [set [set ids]($ix)] $ix]
	}
    }
    if { [set ns [lsort -dictionary -index 0 $ns]] == "" } { return }
    set lns "" ; set lvs ""
    foreach p $ns {
	lappend lns [lindex $p 0] ; lappend lvs [lindex $p 1]
    }
    foreach ix [GMChooseFrom $mode [list $TXT(select) $TXT(name$wh)] \
	                    $LISTWIDTH $lns $lvs] {
	$comm $wh $ix
    }
    return
}

### DJG contribution
proc NewGroupFromMap {mapped} {
    # Create a group based on the currently mapped (or unmapped) data
    global TXT Storage TYPES

    set ixmits ""
    # MF change: using $TYPES
    set whs [Delete $TYPES GR]
    #--
    if ($mapped)  {
	set namebase $TXT(dispitems)
	foreach wh $whs {
	    set ${wh}ns ""
	    set ids [lindex $Storage($wh) 0]
	    global $ids ${wh}Displ
	    foreach ix [array names $ids] {
		if { [set ${wh}Displ($ix)] } {
		    lappend ${wh}ns [set [set ids]($ix)]
		}
	    }
	}
    } else {
	set namebase $TXT(hiditems)
	foreach wh $whs {
	    set ${wh}ns ""
	    set ids [lindex $Storage($wh) 0]
	    global $ids ${wh}Displ
	    foreach ix [array names $ids] {
		if { ! [set ${wh}Displ($ix)] } {
		    lappend ${wh}ns [set [set ids]($ix)]
		}
	    }
	}
    }
    # MF change: leaving out void types and returning if there are no items
    set contents ""
    foreach wh $whs {
	if { [set ${wh}ns] != "" } {
	    lappend contents [list $wh [set ${wh}ns]]
	}
    }
    if { $contents == "" } { bell ; return }
    #--
    # Now find a name for this group
    # MF change: using proc CreateGRFor
    CreateGRFor "=$namebase" "" $contents
    return
}