#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2009 Miguel Filgueiras mig@ncc.up.pt Universidade do Porto
#
#    This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 2 of the License, or
#      (at your option) any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program.
#
#  File: projections.tcl
#  Last change:  12 February 2009
#

# Includes contributions by
#  - Sandor Laky (laky.sandor_AT_freemail.hu) marked "SL contribution"

## some information and algorithms used here adopted from
#  - libproj, PROJ4.4 and PROJ4.3.3 - cartographic projection software
#      by Gerald I. Evenden (gie@kai.er.usgs.gov)
#  - Guidance Note Number 7, European Petroleum Survey Group
#      Revised November 1999
#  - Formulas and constants for the calculation of the Swiss conformal
#      cylindrical projection and for the transformation between coordinate
#      systems (http://www.swisstopo.ch/pub/data/geo/refsyse.pdf),
#      September 2001
#  - Het stelsel van de Rijksdriehoeksmeting en het European Terrestrial
#    Reference System 1989 (containing formulas and constants for the
#    Schreiber projection and the RD grid, used in The Netherlands;
#    partial English translation kindly provided by Rob Buitenhuis,
#    rob@buitenhs.demon.nl), http://www.rdnap.nl
#  - "Le carte topografiche CTR ed il loro uso GPS"
#    (http://www.gpscomefare.com/guide/tutorialgps/mapdatum.htm)
#    May 2003 (information kindly sent by Alessandro Palmas)
#  - IGN site (http://www.ign.fr), August 2003: French projections and
#    grids
#  - The California Spatial Library (http://www.gis.ca.gov/albers.epl),
#    October 2003: Teale-Albers projection and grid

##
## some algorithms and formulae adopted from:
#     - GKK grid conversion by Andreas Lange (Andreas.C.Lange@GMX.de)
#       in GPStrans 0.36
#     - Swedish grid conversion by Anders Lennartsson
#       (anders.lennartsson@sto.foa.se) in GPStrans 0.36
##
## information kindly provided by
#     - Dan Jacobson (jidanni@yahoo.com.tw) on the Taiwan Grid projection
#     - Alessandro Palmas (alpalmas@tin.it) on the French and Austrian grids
##

## "projection" here means the conversion from geodetic position to
# planar Cartesian coordinates im meters in the terrain
#  these coordinates can then be converted to map coordinates by the
# transformations defined in maptransf.tcl
#
# projection procs (direct and inverse) must work with longitude values in
#  the -179,180 range although they should use internally the equivalent
#  value in the -359,360 range that is closer to the central or false
#  longitude (if there is one):
#
#  no changes in the map datum ($Datum) will occur after initialization
##

## when adding new projection procedures these variables must be updated
#  as well as PRJ$name and parameters (except reserved ones) in files lang*.tcl
# see also the comments preceding each procedure for the UTM projection
##

set MAPKNOWNPROJS {UTM TM BMN BNG BWI CMP CTR GKK ITM KKJY KKJP SEG TWG
                   LCC1 LCC2 IcG Merc1 Merc2 CS APOLY Stereogr Schreiber RDG
                   SOM LV03 Lamb93 LambNTFe LambNTF AEA LEAC TAlbers EOV}

     # indices of parameters array used for each main projection
     #  index "datum" is also used, but is dealt with in a different way
     #  indices starting with "_" are used for other values whose meanings
     #  are defined in the corresponding proc Proj${proj}ComputeAux
array set MAPPROJDATA {
    UTM   {UTMzone m_0}
    TM    {lat0 long0 k0}
    BMN   {bmnlong0 m_0}
    CTR   {ctrlong0 m_0}
    GKK   {gkklong0 m_0}
    KKJP  {kkjplong0 m_0}
    TWG   {twglong0 m_0}
    LCC1  {lat0 long0 k0 m_e m_a lcc_n lcc_rho0F lcc_sn}
    LCC2  {lat1 lat2 latF longF m_e m_a lcc_n lcc_rho0F lcc_sn}
    LambNTF {NTFzone m_e m_a lcc_n lcc_rho0F lcc_sn}
    AEA   {lat1 lat2 lat0 long0 m_e m_a m_0 m_1 m_2 m_3 m_4 m_5}
    LEAC  {lat1 polasp lat0 long0 m_e m_a m_0 m_1 m_2 m_3 m_4 m_5}
    Merc1 {long0 k0 m_e m_a m_1 m_2 m_3 m_4}
    Merc2 {lat1 long0 m_e m_a m_1 m_2 m_3 m_4}
    CS    {lat0 long0 m_e m_a m_0 m_1 m_2 m_3 m_4 m_5 m_6 m_7 m_8}
    APOLY {lat0 m_a m_0 m_1 m_2 m_3 m_4 m_5 m_6}
    Stereogr   {lat0 long0 k0 m_a m_e m_0 m_1 m_2 m_3}
    Schreiber  {m_0 m_1 m_2 m_3 m_4 m_5}
    SOM   {lat0 long0 k0 m_e m_0 m_1 m_2 m_3 m_4 m_5 m_6}
    EOV   {}
}

     # new types here imply changing proc BadParam in check.tcl
     # not in use, but defined: lat=MIN,MAX  long=MIN,MAX
array set MAPPROJDTYPE {
    lat0      lat        lat1      lat         lat2      lat
    latF      lat
    long0     long       longF     long
    k0        float>0
    bmnlong0  list=10.333333333,13.333333333,16.333333333
    ctrlong0  list=9,15
    gkklong0  list=0,3,6,9,12,15
    kkjplong0 list=21,24,27,30
    twglong0  list=115,117,119,121,123,125
    UTMzone   zone=UTM
    NTFzone   zone=LambNTF
    polasp    list:north,south
    lcc_n     reserved    lcc_rho0F reserved    lcc_sn    reserved
    m_e       reserved    m_a       reserved
    m_0       reserved    m_1       reserved
    m_2       reserved    m_3       reserved
    m_4       reserved    m_5       reserved
    m_6       reserved    m_7       reserved
    m_8       reserved
}

     # projections needing auxiliary parameters computed from the main ones
     #  a specific proc is needed to compute the auxiliary parameters
     #  (see, e.g., proc ProjLCC1ComputeAux)
set MAPPROJAUX {UTM LCC1 LCC2 Merc1 Merc2 CS APOLY Stereogr Schreiber SOM
                AEA LEAC}
     # auxiliary parameters depend on datum?
array set MAPPROJDEPDATUM {
    UTM  0      LCC1 1   LCC2  1      Merc1 1    Merc2 1    CS    1   APOLY 1
    Stereogr 1  SOM  1   Schreiber 0  LambNTF 1  AEA   1    LEAC  1
}

     # main projections admitting particular cases
set MAINPROJS {TM LCC1 LCC2 Merc1 Merc2 CS APOLY Stereogr SOM AEA LEAC}

     # parameters for special cases of Transverse Mercator:
     #  prefix of long0 parameter name, minimum and maximum values for
     #  central longitude, longitude range in each zone, scale factor
     
array set TMPARAM {
    BMN  {bmn 10.333333333 16.333333333 3 1}
    CTR  {ctr 9 15 6 0.9996}
    GKK  {gkk 0 15 3 1}
    KKJP {kkjp 21 30 3 1}
    TWG  {twg 115 125 2 0.9999}
}

     # parameters for the zones of Lambert NTF projection (LCC2)
     #  longitude of false origin, list of zones aligned with pairs
     #  of extreme zone latitudes and longitudes, for each zone
     #  false easting and false northing

array set LNTFPARAMS {
    longF 2.33720833333333333333
    zones {I II III IV}
    extrlats {48.15 51.3 45.45 48.15 42.3 45.45 41 42.5}
    extrlongs {-6 10 -6 10 -6 10 8 10}
    fen,I {600000 200000}
    fen,II {600000 200000}
    fen,III {600000 200000}
    fen,IV {234.358 185861.369}
}

    # pre-computed parameters for each zone of Lambert NTF projection (LCC2)

array set LNTFzI {
    NTFzone I
    lat1  50.3959116667
    lat2  48.5985227778
    longF  2.33720833333
    latF  49.5
    datum  {NTF (Nouvelle Triangulation de France)}
    lcc_rho0F  5457616.6655
    lcc_sn  1
    m_a  11603796.7976
    m_e  0.0824834000442
    lcc_n  0.760405965438
}

array set LNTFzII {
    NTFzone II
    lat1  45.8989188889
    lat2  47.6960144444
    longF  2.33720833333
    latF  46.8
    datum  {NTF (Nouvelle Triangulation de France)}
    lcc_rho0F  5999695.76018
    lcc_sn  1
    m_a  11745793.2222
    m_e  0.0824834000442
    lcc_n  0.72896862668
}

array set LNTFzIII {
    NTFzone III
    lat1  43.1992913889
    lat2  44.9960938889
    longF  2.33720833333
    latF  44.1
    datum  {NTF (Nouvelle Triangulation de France)}
    lcc_rho0F  6591905.05462
    lcc_sn  1
    m_a  11947992.3451
    m_e  0.0824834000442
    lcc_n  0.695912797771
}

array set LNTFzIV {
    NTFzone IV
    lat1  41.5603877778
    lat2  42.0000593542
    longF  2.33720833333
    latF  42.165
    datum  {NTF (Nouvelle Triangulation de France)}
    lcc_rho0F  7106637.87866
    lcc_sn  1
    m_a  12178813.9766
    m_e  0.0824834000442
    lcc_n  0.666276778805
}

     # particular cases of main projections:
     #  CMP  - used in Portuguese Military Maps
     #  BNG  - used for the British National Grid
     #  BWI  - used for the British West Indies Grid
     #  IcG  - used for the Iceland Grid
     #  ITM  - used for the Irish TM Grid
     #  KKJY - used for the Uniform Finnish Grid
     #  Lamb93   - used in the new French geodetic system RGF93
     #  LambNTFe - used for the French grid NTF II etendue
     #  LV03 - used for the Swiss grid in the LV03 frame
     #  RDG  - used for the Netherlands Grid
     #  SEG  - used for the Swedish Grid
     #  TAlbers - used for the Teale Albers grid (California, USA)
array set MAPPARTPROJ {
    CMP  TM
    BNG  TM
    BWI  TM
    EOV  EOV
    IcG  LCC2
    ITM  TM
    KKJY TM
    Lamb93   LCC2
    LambNTFe LCC2
    LV03 SOM
    RDG  Schreiber
    SEG  TM
    TAlbers AEA
}

     # parameters aligned with MAPPROJDATA above
array set MAPPARTPDATA {
    CMP  {39.66666666666667 -8.13190611111111 1}
    BNG  {49.0 -2.0 0.9996012717}
    BWI  {0 -62.0 0.9995}
    EOV  {}
    IcG  {64.75 64.25 65 -19}
    ITM  {53.5 -8.0 1.000035}
    KKJY {0 27.0 1}
    Lamb93  {44.0 49.0 46.5 3.0}
    LambNTFe {45.8989188888888888889 47.69601444444444444444
                 46.8 2.33720833333333333333}
    LV03 {46.9524055556 7.43958333333 1}
    RDG  {}
    SEG  {0 15.808277777778 1}
    TAlbers {34.0 40.5 0 -120.0}
}

     # projections and known grids
array set GRIDFOR {
    AEA  UTM/UPS
    APOLY UTM/UPS
    BMN  BMN
    BNG  BNG
    BWI  BWI
    CMP  CMP
    CS   UTM/UPS
    CTR  CTR
    EOV  EOV
    GKK  GKK
    IcG  IcG
    ITM  ITM
    KKJY KKJY
    KKJP KKJP
    Lamb93   Lamb93
    LambNTF  LambNTF
    LambNTFe LambNTFe
    LCC1 UTM/UPS
    LCC2 UTM/UPS
    LEAC UTM/UPS
    LV03 LV03
    Merc1 UTM/UPS
    Merc2 UTM/UPS
    RDG  RDG
    SEG  SEG
    Schreiber RDG
    SOM  UTM/UPS
    Stereogr UTM/UPS
    TAlbers  TAlbers
    TM   UTM/UPS
    TWG  TWG
    UTM  UTM/UPS
}

     # grids with no zones
array set GRIDDEF {
    BWI {BWI 400000 0 KM {0 1e6 0 1e6} {0 10 -66 -55}}
    CMP {CMP 200000 300000 KM {64e3 368e3 0 580e3} {36.95 42.17 -9.66 -6.08}
         Lisboa}
    EOV {EOV 650000 200000 KM {400e3 950e3 0 400e3} {45 49 16 23}
	 {Hungarian Datum 1972}}
    IcG {IcG 500000 500000 KM {0 1e6 0 1e6} {63.5 65 -30 -10} {WGS 84}}
    Lamb93 {Lamb93 700000 6600000 KM {0 1e10 0 1e10}
            {41 52 -6 11} {WGS 84}}
    LambNTFe {LambNTFe 600000 2200000 KM {0 1e10 0 1e10}
 	      {41 52 -6 11} {NTF (Nouvelle Triangulation de France)}}
    LV03 {LV03 600000 200000 KM {0 1e6 0 1e6} {45 48 6 11} CH-1903}
    RDG {RDG 155000 463000 KM {0 29e4 29e4 63e4} {50.3 53.45 3 7.45}
         {Rijks Driehoeksmeting}}
    SEG {SEG 1500000 0 KM {12e5 19e5 61e5 77e5} {54 70 10 26}}
    TAlbers {TAlbers 0 -4000000 KM {-1.5e6 1.5e6 -1.5e6 1.5e6}
	     {25 45 -130 -110} {NAD27 CONUS}}
}

     # zones of grids (regular expressions to recognize valid zones)
     #  UTM is added below after use of this array in colecting the grid
     #  names
array set GRIDZN {
    BMN  {^M((28)|(31)|(34))$}
    BNG  {^([A-H]|[J-Z])([A-H]|[J-Z])$}
    CTR  {^[1-2]$}
    GKK  {^[0-5]$}
    ITM  {^[A-H]|[J-Z]$}
    KKJY {^27E$}
    KKJP {^[1-4]$}
    LambNTF {^I(I|II|V)?$}
    TWG  {^[1-6]$}
}

     # position formats; $GRIDS may change dynamically
     # type for grids set below and in proc SetUpNZGrid
     #  x,y indices set only for numeric formats
array set POSTYPE {
    DDD  latlong
    DDD,xyixs  {1 0}
    DMS  latlong
    DMM  latlong
    GRA  latlong
    GRA,xyixs  {3 2}
    UTM/UPS  utm
    UTM/UPS,xyixs {4 5}
    MH   mh
}

     # non-numeric position formats
set NNUMPFORMATS {DMM DMS MH}
set PFORMATS ""
foreach f [set NONGRIDFMTS {DMS DMM DDD GRA UTM/UPS MH}] {
    lappend PFORMATS $TXT($f)
    # but UTM/UPS is set to 1 below
    set ZGRID($f) 0
}
set GRIDS [lsort [concat [array names GRIDZN] [array names GRIDDEF]]]
set PFORMATS [concat $PFORMATS $GRIDS]

     # must be here, after computing $GRIDS
     #  there is a redundancy here: UTM for the projection and UTM/UPS for
     #  the position format...
array set GRIDZN {
    UTM  {^([0-5]?[0-9]|60)[A-HJ-NP-Z]$}
    UTM/UPS  {^([0-5]?[0-9]|60)[A-HJ-NP-Z]$}
}

     # initialize projection and grid information
set ZGRID(UTM/UPS) 1
set TXT(PRJUTM/UPS) $TXT(UTM/UPS)

foreach g [array names TMPARAM] {
    # central longitude parameter
    set TXT([lindex $TMPARAM($g) 0]long0) $TXT(long0)
}

foreach g $GRIDS {
    # all grids named as they should appear in TXT
    set TXT($g) $g ; set INVTXT($g) $g
    # grid has more than 1 zone (see SetUpNZGrid for those that do not)
    set ZGRID($g) 1
    set POSTYPE($g) grid ; set POSTYPE($g,xyixs) {3 4}
    # at present, all grids with >1 zone with fixed datum must be given
    #  after this foreach
    set GRD${g}(datum) ""
}

    # all grids with >1 zone with fixed datum must be given here!
set GRDLambNTF(datum) "NTF (Nouvelle Triangulation de France)"

## grids

proc SetUpNZGrids {} {
    # initialize grids with no zones defined in array GRIDDEF
    global GRIDDEF

    foreach g [array names GRIDDEF] {
	SetUPNZGrid $g $GRIDDEF($g)
    }
    return
}

proc SetUPNZGrid {gr params} {
    # initialize grid with no zones
    #  $params is list of values as in array GRIDDEF
    global ZGRID GRIDZN MAPPROJAUX MAPPROJDEPDATUM MAPPARTPROJ MESS \
	    DSCALEFOR GRD$gr POSTYPE

    set ZGRID($gr) 0 ; set GRIDZN($gr) {}
    set POSTYPE($gr) nzgrid ; set POSTYPE($gr,xyixs) {2 3}
    if { [llength $params] < 6 } { BUG bad params for SetUPNZGrid }
    foreach "proj fe fn unit xybounds llbounds datum" $params {}
    if { $datum == "" } {
	set fixdatum 0
	if { [lsearch -exact $MAPPROJAUX $proj] != -1 && \
		$MAPPROJDEPDATUM($proj) } {
	    GMMessage [format $MESS(gridneedsdatum) $TXT($proj)]
	    set datum "WGS 84" ; set fixdatum 1
	}
    } else { set fixdatum 1 }
    ProjInitPart $proj GRD$gr $datum
    set GRD${gr}(_proj) $MAPPARTPROJ($proj)
    foreach f "fe fn" {
	set GRD${gr}(_$f) [set $f]
    }
    set GRD${gr}(_unit) $unit
    # scale factor to get metre from user unit
    set GRD${gr}(_uscale) \
	    [expr 1000.0*$DSCALEFOR(sub,$unit)/$DSCALEFOR($unit)]
    foreach f "xmin xmax ymin ymax" b $xybounds {
	set GRD${gr}(_$f) $b
    }
    foreach f "lamin lamax lomin lomax" b $llbounds {
	set GRD${gr}(_$f) $b
    }
    if { $fixdatum } { set GRD${gr}(datum) $datum }
    return
}

proc DegreesToNZGrid {grid latd longd datum} {
    # convert lat/long in signed degrees to coordinates in no-zone grid
    # return "-- 0" on error
    global GRD$grid

    if { $latd < [set GRD${grid}(_lamin)] || \
	    $latd > [set GRD${grid}(_lamax)] || \
	    $longd < [set GRD${grid}(_lomin)] || \
	    $longd > [set GRD${grid}(_lomax)] } {
	return "-- 0"
    }
    set proj [set GRD${grid}(_proj)]
    if { [set GRD${grid}(datum)] == "" } {
	set GRD${grid}(datum) $datum
	set nodatum 1
    } else { set nodatum 0 }
    set p [Proj${proj}Point GRD$grid $latd $longd $datum]
    if { $nodatum } { set GRD${grid}(datum) "" }
    set s [set GRD${grid}(_uscale)]
    set x [expr int(round(1.0*[lindex $p 0]/$s+[set GRD${grid}(_fe)]))]
    set y [expr int(round(1.0*[lindex $p 1]/$s+[set GRD${grid}(_fn)]))]
    if { $x < [set GRD${grid}(_xmin)] || \
	    $x > [set GRD${grid}(_xmax)] || \
	    $y < [set GRD${grid}(_ymin)] || \
	    $y > [set GRD${grid}(_ymax)] } {
	return "-- 0"
    }
    return [list $x $y]
}

proc GridToDegrees {grid zone x y datum} {
    # convert grid coords to lat/long in signed degrees
    # return 0 on error, -1 if $datum is not that of $grid,
    #  otherwise list with lat and long
    global ZGRID GRD$grid

    if { $ZGRID($grid) } { return [${grid}ToDegrees $zone $x $y $datum] }
    # no-zone grid
    if { $x < [set GRD${grid}(_xmin)] || \
	    $x > [set GRD${grid}(_xmax)] || \
	    $y < [set GRD${grid}(_ymin)] || \
	    $y > [set GRD${grid}(_ymax)] } {
	return 0
    }
    set s [set GRD${grid}(_uscale)]
    set x [expr $s*($x-[set GRD${grid}(_fe)])]
    set y [expr $s*($y-[set GRD${grid}(_fn)])]
    if { [set gdatum [set GRD${grid}(datum)]] == "" } {
	set GRD${grid}(datum) $datum
	set nodatum 1
    } elseif { $gdatum != $datum } {
	return -1
    } else { set nodatum 0 }
    set proj [set GRD${grid}(_proj)]
    set p [Proj${proj}Invert GRD$grid $x $y]
    if { $nodatum } { set GRD${grid}(datum) "" }
    set latd [lindex $p 0] ; set longd [lindex $p 1]
    if { $latd < [set GRD${grid}(_lamin)] || \
	    $latd > [set GRD${grid}(_lamax)] || \
	    $longd < [set GRD${grid}(_lomin)] || \
	    $longd > [set GRD${grid}(_lomax)] } {
	return 0
    }
    return $p
}

proc GridDatum {grid args} {
    # return datum needed by grid, or first element of $args if none
    global GRD$grid

    if { [set d [set GRD${grid}(datum)]] == "" } {
	return [lindex $args 0]
    }
    return $d
}

## grids having zones
# UTM grid (see also posncomp.tcl)

proc CompUTMOnZone {lat long longz} {
    # UTM/UPS position representation of position with lat/long signed degrees
    #  on zone containing meridian with longitude $longz (signed degrees)
    global UTMlat0 UTMk0 Datum

    if { $lat>=-80 && $lat<=84 } {
	set long0 [expr 6*int(floor($longz/6.0))+3]
	set cs [ConvToTM $lat $long $UTMlat0 $long0 $UTMk0 $Datum]
	set x [expr int(5e5+[lindex $cs 0])] ; set y [lindex $cs 1]
	if { $lat < 0 } { set y [expr int(1e7+$y)] }
	return [list $x $y]
    }
    return [ConvToUPS $lat $long $Datum]
}

# BMN, CTR, GKK, basic KKJ, and Taiwan grid coordinates

proc DegreesToBMN {lat long datum} {
    # convert from lat/long in signed degrees to Austrian BMN grid coords
    # zone codes: M28, M31, M34

    if { $long < 8.833333333 || $long > 17.833333333 || $lat < 0 } {
	return "-- 0 0"
    }
    set z [expr int(($long-8.833333333)/3)]
    set fe [expr 150000+300000*$z]
    set long0 [expr 10.833333333+3*$z]
    set cs [ConvToTM $lat $long 0 $long0 1 $datum]
    if { [set x [expr round([lindex $cs 0]+$fe)]] < 0 || \
	    [set y [expr round([lindex $cs 1])]] < 0 } {
	return "-- 0 0"
    }
    return [list M[expr $z*3+28] $x $y]
}

proc BMNToDegrees {zone x y datum} {
    # convert from Austrian BMN grid coords to lat/long in signed degrees
    global GRIDZN

    if { $x < 0 || $y < 0 || $x > 6e6 || $y > 1e7 || \
	    ! [regexp $GRIDZN(BMN) $zone] } {
	return 0
    }
    set z [expr ([string range $zone 1 2]-28)/3]
    set fe [expr 150000+300000*$z]
    set long0 [expr 10.833333333+3*$z]
    return [ConvFromTM [expr $x-$fe] $y 0 $long0 1 $datum]
}

proc DegreesToCTR {lat long datum} {
    # convert from lat/long in signed degrees to Italian CTR grid coords
    # zone codes: 1-2

    if { $long < 6 || $long > 18 || $lat < 0 } {
	return "-- 0 0"
    }
    if { [set z [expr int(($long-6)/6)+1]] == 1 } {
	set fe 150e4
    } else { set fe 252e4 }
    set long0 [expr 3+6*$z]
    set cs [ConvToTM $lat $long 0 $long0 0.9996 $datum]
    if { [set x [expr round([lindex $cs 0]+$fe)]] < 0 || \
	    [set y [expr round([lindex $cs 1])]] < 0 } {
	return "-- 0 0"
    }
    return [list $z $x $y]
}

proc CTRToDegrees {zone x y datum} {
    # convert from Italian CTR grid coords to lat/long in signed degrees
    global GRIDZN

    if { $x < 0 || $y < 0 || $x > 6e6 || $y > 1e7 || \
	    ! [regexp $GRIDZN(CTR) $zone] } {
	return 0
    }
    if { $z == 1 } {
	set fe 150e4
    } else { set fe 252e4 }
    set long0 [expr 3+6*$z]
    return [ConvFromTM [expr $x-$fe] $y 0 $long0 0.9996 $datum]
}

proc DegreesToGKK {lat long datum} {
    # convert from lat/long in signed degrees to German Krueger grid coords
    # zone codes: 0-5

    if { $long < -1.5 || $long > 16.5 || $lat < 0 } {
	return "-- 0 0"
    }
    set z [expr int(($long+1.5)/3)]
    set long0 [expr 3.0*$z]
    set cs [ConvToTM $lat $long 0 $long0 1.0 $datum]
    if { [set x [expr round([lindex $cs 0]+5e5+1e6*$z)]] < 0 || \
	    [set y [expr round([lindex $cs 1])]] < 0 } {
	return "-- 0 0"
    }
    return [list $z $x $y]
}

proc GKKToDegrees {zone x y datum} {
    # convert from German Krueger grid coords to lat/long in signed degrees
    global GRIDZN

    if { $x < 0 || $y < 0 || $x > 6e6 || $y > 1e7 || \
	    ! [regexp $GRIDZN(GKK) $zone] } {
	return 0
    }
    set long0 [expr 3.0*$zone]
    set x [expr $x-5e5-1e6*$zone]
    return [ConvFromTM $x $y 0 $long0 1.0 $datum]
}

proc DegreesToKKJP {lat long datum} {
    # convert from lat/long in signed degrees to basic Finnish grid coords
    # zone codes: 1-4

    if { $long < 19.5 || $long > 31.5 || $lat < 0 } {
	return "-- 0 0"
    }
    set z [expr int(($long-16.5)/3)]
    set long0 [expr 3.0*$z+18]
    set cs [ConvToTM $lat $long 0 $long0 1.0 $datum]
    if { [set x [expr round([lindex $cs 0]+5e5+1e6*$z)]] < 0 || \
	    [set y [expr round([lindex $cs 1])]] < 0 } {
	return "-- 0 0"
    }
    return [list $z $x $y]
}

proc KKJPToDegrees {zone x y datum} {
    # convert from basic Finnish grid coords to lat/long in signed degrees
    global GRIDZN

    if { $x < 0 || $y < 0 || $x > 5e6 || $y > 1e7 || \
	    ! [regexp $GRIDZN(KKJP) $zone] } {
	return 0
    }
    set long0 [expr 3.0*$zone+18]
    set x [expr $x-5e5-1e6*$zone]
    return [ConvFromTM $x $y 0 $long0 1.0 $datum]
}

proc DegreesToTWG {lat long datum} {
    # convert from lat/long in signed degrees to Taiwan grid coords
    # zone codes: 1-6

    if { $long < 114 || $long > 126 || $lat < 0 } {
	return "-- 0 0"
    }
    set z [expr int(($long-114)/2)+1]
    set long0 [expr 2.0*$z+113]
    set cs [ConvToTM $lat $long 0 $long0 0.9999 $datum]
    if { [set x [expr round([lindex $cs 0]+25e4)]] < 0 || \
	    [set y [expr round([lindex $cs 1])]] < 0 } {
	return "-- 0 0"
    }
    return [list $z $x $y]
}

proc TWGToDegrees {zone x y datum} {
    # convert from Taiwan grid coords to lat/long in signed degrees
    global GRIDZN

    if { $x < 0 || $y < 0 || $x > 5e6 || $y > 1e7 || \
	    ! [regexp $GRIDZN(TWG) $zone] } {
	return 0
    }
    set long0 [expr 2.0*$zone+113]
    set x [expr $x-25e4]
    return [ConvFromTM $x $y 0 $long0 0.9999 $datum]
}

# Lambert NTF grid coordinates

proc DegreesToLambNTF {lat long datum} {
    # convert from lat/long in signed degrees to French Lambert NTF grid coords
    # zone codes: I, II, III, IV
    global LNTFPARAMS

    set projdatum "NTF (Nouvelle Triangulation de France)"
    if { $datum !=  $projdatum } {
	foreach "lat long" \
	    [ToDatum $lat $long $datum $projdatum] { break }
    }
    set zone "--"
    foreach z $LNTFPARAMS(zones) "lamin lamax" $LNTFPARAMS(extrlats) \
	    "lomin lomax" $LNTFPARAMS(extrlongs) {
	if { $lamin <= $lat && $lat <= $lamax && $lomin <= $long && \
		 $long <= $lomax } {
	    set zone $z ; break
	}
    }
    if { $zone == "--" } { return "-- 0 0" }
    foreach "x y" [ProjLCC2Point LNTFz$zone $lat $long $projdatum] {}
    foreach "fe fn" $LNTFPARAMS(fen,$zone) {}
    return [list $zone [expr round($x+$fe)] [expr round($y+$fn)]]
}

proc LambNTFToDegrees {zone x y datum} {
    # convert from French NTF grid coords to lat/long in signed degrees
    global GRIDZN LNTFPARAMS

    if { $x < 0 || $y < 0 || $x > 1e6 || $y > 1e6 || \
	     ! [regexp $GRIDZN(LambNTF) $zone] } {
	return 0
    }
    foreach "fe fn" $LNTFPARAMS(fen,$zone) {}
    set p [ProjLCC2Invert LNTFz$zone [expr $x-$fe] [expr $y-$fn]]
    set projdatum "NTF (Nouvelle Triangulation de France)"
    if { $datum !=  $projdatum } {
	set p [ToDatum [lindex $p 0] [lindex $p 1] $projdatum $datum]
    }
    return $p
}

## Maidenhead locators

set MHCHARS ABCDEFGHIJKLMNOPQRSTUVWX

proc DegreesToMHLoc {latd longd} {
    # convert from lat/long in signed degrees to Maidenhead locator
    #  (6 characters)
    global MHCHARS

    set longd [expr $longd+180] ; set latd [expr $latd+90]
    set k [expr int(floor($longd/20))] ; set c1 [string index $MHCHARS $k]
    set longd [expr $longd-$k*20]
    set k [expr int(floor($latd/10))]
    set c2 [string index $MHCHARS $k]
    set latd [expr $latd-$k*10]
    set c3 [expr int(floor($longd/2))]
    set longd [expr $longd-$c3*2]
    set c4 [expr int(floor($latd))]
    set latd [expr $latd-$c4]
    set c5 [string index $MHCHARS [expr int(floor(($longd*60)/5))]]
    set c6 [string index $MHCHARS [expr int(floor(($latd*60)/2.5))]]
    return ${c1}${c2}${c3}${c4}${c5}${c6}
}

proc MHLocToDegrees {mhl} {
    # convert from Maidenhead locator (6 characters) to degrees
    global MHCHARS

    foreach i "0 1 2 3 4 5" {
	set c$i [string index $mhl $i]
    }
    set longd [expr 20*[string first $c0 $MHCHARS]+2*$c2+ \
	    5*[string first $c4 $MHCHARS]/60.0-180]
    set latd [expr 10*[string first $c1 $MHCHARS]+$c3+ \
	    2.5*[string first $c5 $MHCHARS]/60.0-90]
    return [list $latd $longd]
}

## user-defined projections and grids

proc DefineProjection {} {
    # set-up a user-defined case of a main projection
    global MAINPROJS MAPKNOWNPROJS MAPPROJDATA MAPPROJDTYPE MAPPARTPDATA \
	    MAPPARTPROJ GRIDFOR UPName UPAbbrev UPData UProjs TXT MESS

    catch {unset UPData} ; catch {unset UPName} ; catch {unset UPAbbrev}
    set nps ""
    foreach mp $MAINPROJS {
	lappend nps $TXT(PRJ$mp)
    }
    while 1 {
	set mp [GMChooseFrom single $TXT(baseproj) 20 $nps $MAINPROJS \
		"UPName UPAbbrev" [list "=$TXT(name)" "=$TXT(abbrev)"]]
	if { $mp == "" } { return }
	if { [ProjNamesOk] } { break }
    }
    foreach e $MAPPROJDATA($mp) {
	if { $MAPPROJDTYPE($e) != "reserved" } {
	    set UPData($e) ""
	}
    }
    set UPData(_grid) $GRIDFOR($mp)
    set UPData(_abbr) $UPAbbrev
    set UPData(datum) ""
    if { ! [ProjParams define $mp UPData] } { return }
    lappend UProjs $UPAbbrev ; lappend MAPKNOWNPROJS $UPAbbrev
    set MAPPARTPROJ($UPAbbrev) $mp
    set TXT(PRJ$UPAbbrev) $UPName
    set vals ""
    foreach e $MAPPROJDATA($mp) {
	if { $MAPPROJDTYPE($e) != "reserved" } {
	    lappend vals $UPData($e)
	}
    }
    set MAPPARTPDATA($UPAbbrev) $vals
    if { [set GRIDFOR($UPAbbrev) $UPData(_grid)] == $UPAbbrev } {
	SetUPNZGrid $UPAbbrev $UPData(_gparams)
	AddUserGrid $UPAbbrev
    }
    SaveUserProjsGrids
    return
}

proc ProjNamesOk {} {
    # check that projection name and abbreviation in $UPName and $UPAbbrev
    #  are acceptable
    global UPName UPAbbrev MAPKNOWNPROJS TXT MESS

    if { $UPName == "" || $UPAbbrev == "" } {
	GMMessage $MESS(projnameabbr) ; return 0
    } elseif { [regexp {[ ]} $UPAbbrev] } {
	GMMessage $MESS(abbrevhasspaces) ; return 0
    } elseif { [lsearch -exact $MAPKNOWNPROJS $UPAbbrev] != -1 } {
	GMMessage $MESS(abbrevinuse) ; return 0
    } else {
	foreach p $MAPKNOWNPROJS {
	    if { $TXT(PRJ$p) == $UPName } {
		GMMessage $MESS(nameinuse) ; return 0
	    }
	}
    }
    return 1
}

proc OpenUserProjection {proj} {
    # edit user-defined projection
    global MAPKNOWNPROJS MAPPROJDATA MAPPROJDTYPE MAPPARTPROJ MAPPARTPDATA \
	    GRIDFOR ZGRID MapProjection UPData UProjs TXT MESS MapPFormat \
	    UPName UPAbbrev

    catch {unset UPData}
    set mp $MAPPARTPROJ($proj)
    foreach e $MAPPROJDATA($mp) v $MAPPARTPDATA($proj) {
	if { $MAPPROJDTYPE($e) != "reserved" } {
	    set UPData($e) $v
	}
    }
    set gr $GRIDFOR($proj)
    if { $ZGRID($gr) } {
	set UPData(datum) ""
    } else {
	global GRD$gr
	set UPData(datum) [set GRD${gr}(datum)]
    }
    set UPData(_grid) $gr
    set UPData(_abbr) $proj
    if { $MapProjection == $proj } {
	GMMessage $MESS(projinuse)
	ProjParams edit $mp UPData
	return
    }
    set grinuse 0
    if { $gr == $proj } {
	set selfgrid 1 ; set lp ""
	foreach p [array names GRIDFOR] {
	    if { $GRIDFOR($p) == $proj && $p != $proj } {
		lappend lp $p ; set grinuse 1
	    }
	}
	if { $MapPFormat == $gr } {
	    lappend lp $TXT(nameMap) ; set grinuse 1
	}
	if { $grinuse && ! \
		[GMConfirm [format $MESS(gridinuse) $lp]] } { return }
    } else { set selfgrid 0 }
    if { [set op [ProjParams edit $mp UPData]] == 0 } {
	return
    }
    if { $op == 2 } {
	# create new projection
	set proj $UPAbbrev
	set projname $UPName
	set grinuse 0
    }
    set nogrid [string compare $UPData(_grid) $proj]
    if { $grinuse && ($op == -1 || $nogrid) } {
	GMMessage [format $MESS(gridinusenochg) $lp]
	return
    }
    switch -- $op {
	1 {
	    # save new parameters
	    set vals ""
	    foreach e $MAPPROJDATA($mp) {
		if { $MAPPROJDTYPE($e) != "reserved" } {
		    lappend vals $UPData($e)
		}
	    }
	    set MAPPARTPDATA($proj) $vals
	    set GRIDFOR($proj) $UPData(_grid)
	    if { ! $nogrid } {
		SetUPNZGrid $proj $UPData(_gparams)
		if { ! $selfgrid } {
		    AddUserGrid $proj
		}
	    } elseif { $selfgrid } {
		ForgetUserGrid $proj
	    }
	}
	2 {
	    # create new
	    lappend UProjs $UPAbbrev ; lappend MAPKNOWNPROJS $UPAbbrev
	    set MAPPARTPROJ($UPAbbrev) $mp
	    set TXT(PRJ$UPAbbrev) $UPName
	    set vals ""
	    foreach e $MAPPROJDATA($mp) {
		if { $MAPPROJDTYPE($e) != "reserved" } {
		    lappend vals $UPData($e)
		}
	    }
	    set MAPPARTPDATA($UPAbbrev) $vals
	    if { [set GRIDFOR($UPAbbrev) $UPData(_grid)] == $UPAbbrev } {
		SetUPNZGrid $UPAbbrev $UPData(_gparams)
		AddUserGrid $UPAbbrev
	    }
	    SaveUserProjsGrids
	}
	-1 {
	    # forget projection
	    set UProjs [Delete $UProjs $proj]
	    set MAPKNOWNPROJS [Delete $MAPKNOWNPROJS $proj]
	    if { $selfgrid } {
		ForgetUserGrid $proj
	    }
	    unset MAPPARTPROJ($proj)
	    unset TXT(PRJ$proj)
	    unset MAPPARTPDATA($proj)
	    unset GRIDFOR($proj)
	}
    }
    SaveUserProjsGrids
    return
}

proc AddUserGrid {grid} {
    # add user grid to list of known grids
    global GRIDS PFORMATS TXT INVTXT POSTYPE

    set TXT($grid) $grid ; set INVTXT($grid) $grid
    set GRIDS [lsort [linsert $GRIDS 0 $grid]]
    set PFORMATS [concat [list $TXT(DMS) $TXT(DMM) $TXT(DDD) $TXT(UTM/UPS)] \
	    $GRIDS]
    set POSTYPE($grid) nzgrid ; set POSTYPE($grid,xyixs) {2 3}
    return
}

proc ForgetUserGrid {grid} {
    # delet user grid from list of known grids
    global GRIDS PFORMATS TXT INVTXT GRD$grid

    unset TXT($grid) ; unset INVTXT($grid)
    set GRIDS [Delete $GRIDS $grid]
    set PFORMATS [Delete $PFORMATS $grid]
    unset GRD$grid
    return
}

proc SaveUserProjsGrids {} {
    # save user-defined projections and grids
    global UFile UProjs MAPPARTPROJ MAPPARTPDATA GRIDFOR ZGRID TXT INVTXT \
	    MESS

    if { [catch {set f [open $UFile(proj,grid) w]}] } {
	GMMessage $MESS(cantwrtprgr)
	return
    }
    puts $f ""
    puts $f "# $MESS(written) GPSMan [NowTZ]"
    puts $f "# $MESS(editrisk)"
    puts $f ""
    puts $f "set UProjs \{$UProjs\}"
    puts $f ""
    foreach p $UProjs {
	puts $f "set MAPPARTPROJ($p) $MAPPARTPROJ($p)"
	puts $f "set MAPPARTPDATA($p) \{$MAPPARTPDATA($p)\}"
	puts $f "set GRIDFOR($p) $GRIDFOR($p)"
	puts $f "set TXT(PRJ$p) \"$TXT(PRJ$p)\""
	if { $GRIDFOR($p) == $p } {
	    global GRD$p

	    puts $f "global GRD$p"
	    puts $f "array set GRD$p \{"
	    foreach a [array names GRD$p] {
		puts $f "    $a  \"[set GRD${p}($a)]\""
	    }
	    puts $f "\}"
	    puts $f "AddUserGrid $p"
	    puts $f "set ZGRID($p) 0"
	}
	puts $f ""
    }
    if { $UProjs != "" } {
	puts $f "set MAPKNOWNPROJS \[concat \$MAPKNOWNPROJS \$UProjs\]"
	puts $f ""
    }
    close $f
    return
}

proc SetupUserProjs {} {
    # process information on user-defined projections and grids
    global UFile UProjs MAPKNOWNPROJS MAPPARTPROJ MAPPARTPDATA GRIDFOR \
	    ZGRID TXT INVTXT MESS

    # assumed to be in system encoding
    source $UFile(proj,grid)
    # check for multiple entries in $MAPKNOWNPROJS
    set l $MAPKNOWNPROJS ; set MAPKNOWNPROJS ""
    while { $l != "" } {
	set p [lindex $l 0] ; set l [lreplace $l 0 0]
	if { [set i [lsearch -exact $l $p]] != -1 } {
	    GMMessage [format $MESS(redefproj) $TXT(PRJ$p)]
	    set l [lreplace $l $i $i]
	    while { [set i [lsearch -exact $l $p]] != -1 } {
		set l [lreplace $l $i $i]
	    }
	}
	lappend MAPKNOWNPROJS $p
    }
    return
}

## changing, defining and editing parameters

proc ProjParams {how proj data} {
    # open dialog for defining or confirming the projection parameters
    #  $how in {set, change, define, edit}
    #  $proj in $MAPKNOWNPROJS is
    #    set, change: projection whose parameters must be set or may be changed
    #    define, edit: main projection, a particular case of which is
    #     being defined or edited
    #  $data is name of global array with projection parameters
    # if $how==change may turn ASKPROJPARAMS to false in current session
    # return 1 if there were changes or the parameters were defined;
    #        0 if there were no changes or the operation was cancelled;
    #        -1 if the projection is to be forgotten, when editing;
    #        2 if a new projection is to be created, when editing, with
    #          name and abbreviation given by $UPName and $UPAbbrev
    global $data MAPPROJDATA MAPPROJDTYPE GRIDS TXT MESS COLOUR ASKPROJPARAMS \
	    EPOSX EPOSY ProjRes Param DLUNIT DISTUNIT Datum MAPPROJAUX \
	    MAPPROJDEPDATUM MAPPARTPROJ UPName UPAbbrev

    catch {unset Param}
    GMToplevel .proj projection +$EPOSX+$EPOSY {} \
        {WM_DELETE_WINDOW {set ProjRes ok}} \
        {<Key-Return> {set ProjRes ok}}

    frame .proj.fr -relief flat -borderwidth 5 -bg $COLOUR(selbg)
    label .proj.fr.title -text "???" -relief sunken
    label .proj.fr.text -text $MESS(projchg)
    set frs .proj.fr.frsel
    frame $frs -relief flat -borderwidth 0
    set n 0
    foreach p $MAPPROJDATA($proj) {
	set rs 1
	switch -glob $MAPPROJDTYPE($p) {
	    lat -  long -  lat=* -
	    long=* {
		regsub {=.+} $MAPPROJDTYPE($p) "" cw
		set Param($p) DDD
		set fr $frs.f$p
		frame $fr -relief flat -borderwidth 0
		menubutton $fr.pfmt -text $TXT(DDD) -relief raised \
			-width 6 -direction below -menu $fr.pfmt.m
		menu $fr.pfmt.m -tearoff 0
		foreach f "DMS DMM DDD" {
		    $fr.pfmt.m add command -label $TXT($f) \
			    -command "ParamPFormt $fr $cw $f $p"
		}
		entry $fr.val -width 12
		$fr.val insert 0 [set ${data}($p)]
		grid configure $fr.pfmt -column 0 -row 0 -sticky nesw
		grid configure $fr.val -column 1 -row 0 -sticky nesw
		grid configure $fr -column 1 -row $n -sticky nesw
	    }
	    list=* -  list:* {
		set val [set ${data}($p)]
		set fr $frs.f$p
		frame $fr -relief flat -borderwidth 0
		set type $MAPPROJDTYPE($p)
		set l [split [string range $type 5 end] ,]
		if { [string index $type 4] == ":" } {
		    set lt ""
		    foreach v $l {
			lappend lt $TXT($v)
		    }
		} else { set lt $l }
		set r 0 ; set c 0 ; set vc 0 ; set bi ""
		foreach v $l tv $lt {
		    radiobutton $fr.r$r_$c -text $tv -variable Param($p) \
			    -value $v -anchor w -selectcolor $COLOUR(check)
		    grid configure $fr.r$r_$c -column $c -row $r -sticky nesw
		    if { $val == $v } { set bi $r_$c }
		    if { [incr c] > 2 } { set c 0 ; incr r ; incr rs }
		    incr vc
		}
		if { $bi != "" } { $fr.r$bi invoke }
		grid configure $fr -column 1 -row $n -sticky nesw
	    }
	    reserved {
		continue
	    }
	    default {
		entry $frs.e$p -width 12
		$frs.e$p insert 0 [set ${data}($p)]
		grid configure $frs.e$p -column 1 -row $n \
			-sticky nesw
	    }
	}
	label $frs.l$p -text $TXT($p)
	grid configure $frs.l$p -column 0 -row $n -rowspan $rs \
		-sticky w
	incr n
    }
    if { $n == 0 } {
	destroy .proj
	return 0
    }
    if { $how != "change" && $how != "set" } {
	set grid 1
	set oldgr [set ${data}(_grid)]
	set abbr [set ${data}(_abbr)]
	if { $how == "edit" && $oldgr == $abbr } {
	    set selfgrid 1 ; set t UTM/UPS
	} else { set selfgrid 0 ; set t $oldgr }
	label $frs.lgr -text "$TXT(grid):"
	menubutton $frs.m_guse -text $TXT($t) -relief raised \
		-direction below -menu $frs.m_guse.m
	radiobutton $frs.r_guse -text $TXT(use) -variable Param(_guse) \
		-value 1 -anchor w -selectcolor $COLOUR(check) \
		-command "ParamGrid $abbr $data"
	menu $frs.m_guse.m -tearoff 0
	foreach g [linsert $GRIDS 0 UTM/UPS] {
	    if { $g != $abbr } {
		$frs.m_guse.m add command -label $TXT($g) \
			-command "set ${data}(_grid) {$g} ;\
			          $frs.m_guse configure -text {$TXT($g)}"
	    }
	}
	radiobutton $frs.r_gdef -text $TXT(create) -variable Param(_guse) \
		-value 0 -anchor w -selectcolor $COLOUR(check) \
		-command "ParamGrid $abbr $data"
	label $frs.l_gdef -text [set ${data}(_abbr)] -width 8
	frame $frs.zg -relief flat -borderwidth 0
	label $frs.zg.lu -text $TXT(unit)
	set Param(_gunit) $DISTUNIT
	menubutton $frs.zg.mu -text $DLUNIT($DISTUNIT,subdist) -relief raised \
		-direction below -menu $frs.zg.mu.m
	menu $frs.zg.mu.m -tearoff 0
	foreach u "KM NAUTMILE STATMILE" {
	    set nm $DLUNIT($u,subdist)
	    $frs.zg.mu.m add command -label $nm \
		    -command "$frs.zg.mu configure -text {$nm} ; \
		              set Param(_gunit) $u"
	}
	foreach k "fe fn" t "easting northing" {
	    label $frs.zg.l$k -text $TXT(f$t)
	    entry $frs.zg.e$k -width 12
	}
	frame $frs.zg.zb -relief flat -borderwidth 0
	label $frs.zg.zb.lbd -text "$TXT(bounds):"
	label $frs.zg.zb.lbdn -text $TXT(min)
	label $frs.zg.zb.lbdx -text $TXT(max)
	set zbn 0
	grid configure $frs.zg.zb.lbd -column 0 -row $zbn -sticky w
	grid configure $frs.zg.zb.lbdn -column 1 -row $zbn -sticky snew
	grid configure $frs.zg.zb.lbdx -column 2 -row $zbn -sticky snew
	incr zbn
	foreach k "x y la lo" t "easting northing lat long" {
	    label $frs.zg.zb.l$k -text $TXT($t)
	    entry $frs.zg.zb.e${k}n -width 12
	    entry $frs.zg.zb.e${k}x -width 12
	    grid configure $frs.zg.zb.l$k -column 0 -row $zbn -sticky w
	    grid configure $frs.zg.zb.e${k}n -column 1 -row $zbn -sticky snew
	    grid configure $frs.zg.zb.e${k}x -column 2 -row $zbn -sticky snew
	    incr zbn
	}
	if { [set datum [set ${data}(datum)]] == "" } {
	    set datum $Datum ; set nodatum 1
	} else { set nodatum 0 }
	menubutton $frs.zg.datum -text $datum -relief raised \
		-direction below -menu $frs.zg.datum.m
	menu $frs.zg.datum.m -tearoff 0
	FillDatumMenu $frs.zg.datum.m ParamGNewDatum

	if { [lsearch -exact $MAPPROJAUX $proj] != -1 && \
		$MAPPROJDEPDATUM($proj) } {
	    label $frs.zg.cfd -text $TXT(fixeddatum)
	    set Param(_gfdatum) 1
	} else {
	    checkbutton $frs.zg.cfd -text $TXT(fixeddatum) \
		    -variable Param(_gfdatum) -onvalue 1 -offvalue 0 \
		    -selectcolor $COLOUR(check) -command ParamGDatum
	    if { $nodatum } {
		$frs.zg.cfd deselect
	    } else { $frs.zg.cfd invoke }
	}

	if { $selfgrid } {
	    ParamGridSet $oldgr
	} else {
	    # defaults: use pre-defined grid
	    $frs.r_guse invoke
	}

	set zgn 0
	grid configure $frs.zg.lu -column 0 -row $zgn -sticky w
	grid configure $frs.zg.mu -column 1 -row $zgn -sticky snew
	incr zgn
	grid configure $frs.zg.lfe -column 0 -row $zgn -sticky w
	grid configure $frs.zg.efe -column 1 -row $zgn -sticky snew
	incr zgn
	grid configure $frs.zg.lfn -column 0 -row $zgn -sticky w
	grid configure $frs.zg.efn -column 1 -row $zgn -sticky snew
	incr zgn
	grid configure $frs.zg.zb -column 0 -row $zgn -columnspan 2 -sticky e \
		-ipadx 10
	incr zgn
	grid configure $frs.zg.cfd -column 0 -row $zgn -sticky w
	grid configure $frs.zg.datum -column 1 -row $zgn -sticky snew

	grid configure $frs.lgr -column 0 -row $n -columnspan 2 \
		-sticky w -ipady 4
	incr n
	grid configure $frs.r_guse -column 0 -row $n -sticky w
	grid configure $frs.m_guse -column 1 -row $n -sticky snew
	incr n
	grid configure $frs.r_gdef -column 0 -row $n -sticky w
	grid configure $frs.l_gdef -column 1 -row $n -sticky w
	incr n
	grid configure $frs.zg -column 0 -row $n -columnspan 2 -sticky e \
		-ipadx 10
    } else {
	set grid 0 ; set oldgr "" ; set selfgrid 0
    }
    frame .proj.fr.frbs -relief flat -borderwidth 0
    # text of next button is reconfigured below
    button .proj.fr.frbs.ok -text $TXT(ok) \
	    -command { .proj.fr.frbs.ok configure -state normal
		       set ProjRes ok }
    button .proj.fr.frbs.rv -text $TXT(revert) \
	    -command ".proj.fr.frbs.rv configure -state normal ; \
	              ProjParamsRevert $proj $data $grid \"$oldgr\" $selfgrid"
    button .proj.fr.frbs.cnc -text $TXT(cancel) -command {set ProjRes cancel}
    switch $how {
	set {
	    pack .proj.fr.frbs.ok .proj.fr.frbs.rv .proj.fr.frbs.cnc \
		    -side left -padx 5
	    pack .proj.fr.title .proj.fr.text $frs .proj.fr.frbs \
		    -side top -pady 5
	}
	change {
	    checkbutton .proj.fr.stop -text $TXT(dontaskagain) \
		    -variable ASKPROJPARAMS -onvalue 0 -offvalue 1 \
		    -selectcolor $COLOUR(check)
	    pack .proj.fr.frbs.ok .proj.fr.frbs.rv -side left -padx 5
	    pack .proj.fr.title .proj.fr.text $frs .proj.fr.stop \
		    .proj.fr.frbs -side top -pady 5
	}
	define {
	    .proj.fr.frbs.ok configure -text $TXT(create)
	    pack .proj.fr.frbs.ok .proj.fr.frbs.cnc -side left -padx 5
	    pack .proj.fr.title .proj.fr.text $frs .proj.fr.frbs \
		    -side top -pady 5
	}
	edit {
	    .proj.fr.frbs.ok configure -text $TXT(change)
	    button .proj.fr.frbs.fgt -text $TXT(forget) \
		    -command ".proj.fr.frbs.fgt configure -state normal ; \
		              set ProjRes forget"
	    button .proj.fr.frbs.crt -text $TXT(create) \
		    -command ".proj.fr.frbs.crt configure -state normal ; \
		              set ProjRes new"
	    pack .proj.fr.frbs.ok .proj.fr.frbs.rv .proj.fr.frbs.crt \
		     .proj.fr.frbs.fgt .proj.fr.frbs.cnc -side left -padx 2
	    pack .proj.fr.title .proj.fr.text $frs .proj.fr.frbs \
		    -side top -pady 5
	}
    }
    pack .proj.fr -side top
    update idletasks
    # cannot use RaiseWindow because of menus
    set gs [grab current]
    grab .proj
    while 1 {
	tkwait variable ProjRes
	switch $ProjRes {
	    cancel {
		set r 0 ; break
	    }
	    forget {
		if { ! [GMConfirm \
			[format $MESS(askforget) $TXT(projection)]] } {
		    set ProjRes 1
		    continue
		}
		set r -1 ; break
	    }
	}
	set l "" ; set newdata same
	foreach p $MAPPROJDATA($proj) {
	    switch -glob [set type $MAPPROJDTYPE($p)] {
		lat -  long -  lat=* -
		long=* {
		    regsub {=.+} $type "" cw
		    set nv [ParamGetCoord $p $cw [$frs.f$p.val get]]
		    if { $nv == "nil" } { set newdata error ; break }
		    set nv [lindex $nv 0]
		    set pw $frs.f$p.val
		}
		list=* -  list:* {
		    # there can be no wrong values in list; no need for $pw
		    set nv $Param($p)
		}
		reserved { continue }
		default {
		    set nv [$frs.e$p get]
		    set pw $frs.e$p
		}
	    }
	    if { $nv != [set ${data}($p)] } {
		if { [BadParam $TXT($p) $type $nv] } {
		    focus $pw
		    set newdata error
		    break
		}
		lappend l $p $nv
		set newdata diff
	    }
	}
	if { $newdata != "error" } {
	    if { $ProjRes == "new" } {
		while 1 {
		    if { [GMChooseParams $TXT(projection) "UPName UPAbbrev" \
			    [list "=$TXT(name)" "=$TXT(abbrev)"]] } {
			if { [ProjNamesOk] } { set canc 0 ; break }
		    } else {
			set canc 1 ; break
		    }
		}
		if { $canc } { continue }
		set abbr $UPAbbrev
	    }
	    if { $newdata == "diff" } {
		array set $data $l
	    }
	    if { $grid } {
		global GRD$oldgr

		set newgrid same
		if { $Param(_guse) } {
		    if { $oldgr != [set ${data}(_grid)] } {
			set newgrid diff
		    }
		} else {
		    # check parameters for new/self grid
		    set unit $Param(_gunit)
		    set ${data}(_grid) $abbr
		    if { $selfgrid && \
			     $unit != [set GRD${oldgr}(_unit)] } {
			set sameunit 0
		    } else { set sameunit 1 }
		    set diff 0
		    foreach e "efe efn zb.exn zb.exx zb.eyn zb.eyx \
			    zb.elan zb.elax zb.elon zb.elox" \
			    t "float float float float float float \
			    lat lat long long" \
			    v "fe fn xmin xmax ymin ymax lamin lamax \
			    lomin lomax" \
			    n "feasting fnorthing bounds bounds bounds bounds \
			    bounds bounds bounds bounds" {
			set $v [$frs.zg.$e get]
			if { $selfgrid && $sameunit && \
				 [set $v] == [set GRD${oldgr}(_$v)] } {
			    continue
			}
			if { [BadParam $TXT($n) $t [set $v]] } {
			    focus $frs.zg.$e
			    set newgrid error
			    break
			}
			set diff 1
		    }
		    if { $newgrid == "error" } { continue }
		    if { $diff } {
			if { $xmin >= $xmax || $ymin >= $ymax || \
				$lamin >= $lamax || $lomin >= $lomax } {
			    GMMessage [format $MESS(badparam) $TXT(bounds)]
			    continue
			}
			set newgrid diff
		    }
		    if { $Param(_gfdatum) } {
			set datum [$frs.zg.datum cget -text]
			set newgrid diff
		    } elseif { ! $nodatum } {
			set datum ""
			set newgrid diff
		    } else { set datum "" }
		}
		if { $newgrid == "diff" } {
		    set newdata diff
		} else {
		    # make sure grid parameters are set
		    foreach v "fe fn unit xmin xmax ymin ymax \
                               lamin lamax lomin lomax" {
			set $v [set GRD${oldgr}(_$v)]
		    }
		}
		set ${data}(_gparams) \
		    [list $abbr $fe $fn $unit \
			 [list $xmin $xmax $ymin $ymax] \
			 [list $lamin $lamax $lomin $lomax] \
			 $datum]
	    }
	    if { $ProjRes == "new" } {
		set r 2
	    } elseif { $newdata == "diff" } {
		set r 1
	    } else { set r 0 }
	    break
	}
    }
    DestroyRGrabs .proj $gs
    update idletasks
    return $r
}

proc ParamGridSet {gr} {
    # show parameters for grid $gr
    global GRD$gr Param DLUNIT

    set frs .proj.fr.frsel
    $frs.r_gdef invoke
    set Param(_gunit) [set GRD${gr}(_unit)]
    $frs.zg.mu configure -text $DLUNIT($Param(_gunit),subdist)
    foreach k "fe fn" {
	$frs.zg.e$k delete 0 end
	$frs.zg.e$k insert 0 [set GRD${gr}(_$k)]
    }
    foreach k "x y la lo" {
	foreach kk "n x" p "min max" {
	    $frs.zg.zb.e${k}$kk delete 0 end
	    $frs.zg.zb.e${k}$kk insert 0 [set GRD${gr}(_${k}$p)]
	}
    }
    return
}

proc ParamGDatum {} {
    # fixed datum for grid has been de-/selected
    global Param

    if { $Param(_gfdatum) } {
	.proj.fr.frsel.zg.datum configure -state normal
    } else {
	.proj.fr.frsel.zg.datum configure -state disabled
    }
    return
}

proc ParamGNewDatum {datum args} {
    # new datum has been chosen for grid

    .proj.fr.frsel.zg.datum configure -text $datum
    return
}

proc ParamGrid {gr data} {
    # choice of grid type has changed
    global Param $data INVTXT

    if { $Param(_guse) } {
	.proj.fr.frsel.m_guse configure -state normal
	set ${data}(_grid) $INVTXT([.proj.fr.frsel.m_guse cget -text])
	foreach w [winfo children .proj.fr.frsel.zg] {
	    catch {$w configure -state disabled}
	}
	foreach w [winfo children .proj.fr.frsel.zg.zb] {
	    catch {$w configure -state disabled}
	}
    } else {
	.proj.fr.frsel.m_guse configure -state disabled
	set ${data}(_grid) $gr
	foreach w [winfo children .proj.fr.frsel.zg] {
	    catch {$w configure -state normal}
	}
	foreach w [winfo children .proj.fr.frsel.zg.zb] {
	    catch {$w configure -state normal}
	}
	if { [winfo class .proj.fr.frsel.zg.cfd] != "Label" && \
		! $Param(_gfdatum) } {
	    .proj.fr.frsel.zg.datum configure -state disabled	    
	}
    }
    return
}

proc ParamGetCoord {param whc val} {
    # convert coordinate $val to signed degrees and check it
    #  $whc in {lat, long}
    #  $param is parameter name
    # return "empty" if empty, "nil" on error, otherwise
    #  list with value in signed degrees, heading (as letter) and
    #  absolute value in degrees
    global Param

    if { $val == "" } { return empty }
    if { $whc == "lat" } {
	set negh S ; set posh N ; set wC Lat
    } else { set negh W ; set posh E ; set wC Long }
    if { ! [Check$wC GMMessage $val $Param($param)] } { return nil }
    set val [Coord $Param($param) $val $negh]
    if { $val < 0 } {
	return [list $val $negh [expr -$val]]
    }
    return [list $val $posh $val]
}

proc ParamPFormt {fr whc pfmt param} {
    # change format of lat/long in dialog on the projection parameters
    #  $whc in {lat, long}
    #  $param is parameter name
    global TXT Param

    if { $pfmt == $Param($param) } { return }
    set val [ParamGetCoord $param $whc [$fr.val get]]
    if { $val == "nil" } { return }
    if { $val != "empty" } {
	$fr.val delete 0 end
	$fr.val insert 0 [lindex $val 1][ExtDegrees $pfmt [lindex $val 2]]
    }
    $fr.pfmt configure -text $TXT($pfmt)
    set Param($param) $pfmt
    return
}

proc ProjParamsRevert {proj data grid oldgr selfgrid} {
    # revert to initial values in dialog on the projection parameters
    #  $selfgrid is set if editing a projection defining a grid
    global $data MAPPROJDATA MAPPROJDTYPE TXT Param DLUNIT DISTUNIT Datum

    foreach p $MAPPROJDATA($proj) {
	switch -glob $MAPPROJDTYPE($p) {
	    lat -  long -  lat=* -
	    long=* {
		set fr .proj.fr.frsel.f$p
		$fr.pfmt configure -text $TXT(DDD)
		$fr.val delete 0 end
		$fr.val insert 0 [set ${data}($p)]
	    }
	    list=* -  list:* {
		.proj.fr.frsel.f$p.r[set ${data}($p)] invoke
	    }
	    reserved { }
	    default {
		.proj.fr.frsel.e$p delete 0 end
		.proj.fr.frsel.e$p insert 0 [set ${data}($p)]
	    }
	}
    }
    if { $grid } {
	set ${data}(_grid) $oldgr
	if { [set datum [set ${data}(datum)]] == "" } {
	    set datum $Datum
	    catch {.proj.fr.frsel.zg.cfd deselect}
	} else {
	    catch {.proj.fr.frsel.zg.cfd select}
	}
	.proj.fr.frsel.zg.datum configure -text $datum
	foreach e "efe efn zb.exn zb.exx zb.eyn zb.eyx \
		zb.elan zb.elax zb.elon zb.elox" {
	    .proj.fr.frsel.zg.$e delete 0 end
	}
	if { $selfgrid } {
	    ParamGridSet $oldgr
	} else {
	    .proj.fr.frsel.m_guse configure -text $TXT($oldgr)
	    .proj.fr.frsel.r_guse invoke
	    set Param(_gunit) $DISTUNIT
	    .proj.fr.frsel.zg.mu configure -text $DLUNIT($DISTUNIT,subdist)
	}
    }
    update idletasks
    return
}

## dialog for selecting datum and projection

proc ChooseDatumProjection {args} {
    # dialog for selection of datum and projection
    #  $args is "" or contains a list of latd,longd,datum to be projected
    # return 0 on failure, or projection internal name on success, in which
    #  case datum and projection parameters are stored in global array CDPData
    global Datum MapProjection CDPDatum CDPProj CDPProjT CDPData ProjRes \
	    MAPPROJDATA MAPPARTPROJ MAPPARTPDATA MAPPROJAUX EPOSX EPOSY \
	    TXT COLOUR DATUMWIDTH

    set CDPDatum $Datum ; set CDPProj $MapProjection
    set CDPProjT $TXT(PRJ$MapProjection)
    GMToplevel .cdp projection +$EPOSX+$EPOSY {} \
        {WM_DELETE_WINDOW {set ProjRes ok}} \
        {<Key-Return> {set ProjRes ok}}

    frame .cdp.fr -relief flat -borderwidth 5 -bg $COLOUR(selbg)
    label .cdp.fr.title -text "???" -relief sunken

    set frs .cdp.fr.fbs1
    frame $frs  -relief flat -borderwidth 0
    menubutton $frs.datum -textvariable CDPDatum -menu $frs.datum.m \
	    -width $DATUMWIDTH
    menu $frs.datum.m \
	    -postcommand "FillDatumMenu $frs.datum.m CDPChangeDatum"
    menubutton $frs.cdp -textvariable CDPProjT -width 20 -menu $frs.cdp.m
    menu $frs.cdp.m -postcommand "FillProjsMenu $frs.cdp.m \
		                     MAPKNOWNPROJS CDPChangeProjection"

    set frb .cdp.fr.fbs2
    frame $frb  -relief flat -borderwidth 0
    button $frb.ok -text $TXT(ok) -command { set ProjRes ok }
    button $frb.cnc -text $TXT(cancel) -command { set ProjRes cancel }

    pack $frs.datum $frs.cdp -side left -padx 2
    pack $frb.ok $frb.cnc -side left -padx 2
    pack .cdp.fr.title $frs $frb -side top -pady 5
    pack .cdp.fr
    update idletasks
    # cannot use RaiseWindow because of menus
    # RaiseWindow .cdp
    Raise .cdp
    set gs [grab current]
    grab .cdp
    tkwait variable ProjRes
    DestroyRGrabs .cdp $gs
    if { $ProjRes == "cancel" } {
	return 0
    }
    # initialize projection parameters
    catch {unset CDPData}
    set CDPData(datum) $CDPDatum

    if { [catch {set mp $MAPPARTPROJ($CDPProj)}] } {
	set ps [lindex $args 0]
	if { $ps == "" } {
	    # main projection: ask parameters
	    foreach p $MAPPROJDATA($CDPProj) {
		set CDPData($p) ""
	    }
	    if { [ProjParams set $CDPProj CDPData] == 0 } { return 0 }
	} else {
	    ProjInit $CDPProj CDPData $CDPDatum $ps
	}
	set mp $CDPProj
    } else {
	foreach e $MAPPROJDATA($mp) v $MAPPARTPDATA($CDPProj) {
	    set CDPData($e) $v
	}
    }
    if { [lsearch -exact $MAPPROJAUX $mp] != -1 } {
	Proj${mp}ComputeAux CDPData $CDPDatum
    }
    set CDPData(main_proj) $mp
    return $CDPProj
}

proc CDPChangeDatum {datum args} {
    # record selected datum
    #  $args not used but is needed as this is called-back from a menu
    global CDPDatum

    set CDPDatum $datum
    return
}

proc CDPChangeProjection {proj} {
    # record selected projection
    global CDPProj CDPProjT TXT

    set CDPProj $proj ; set CDPProjT $TXT(PRJ$proj)
    return
}

## menus with projections and grids

proc FillProjsMenu {menu listname comm} {
    # create menu entries from projections in list given by $listname for
    #  calling command whose argument is each projection
    global $listname MAXMENUITEMS TXT

    if { [winfo exists $menu] } {
	$menu delete 0 end
    }
    set n 0 ; set m 0
    foreach pr [set $listname] {
	if { $n > $MAXMENUITEMS } {
	    $menu add cascade -label "$TXT(more) ..." -menu $menu.m$m
	    set menu $menu.m$m ; destroy $menu
	    menu $menu -tearoff 0
	    set n 0 ; incr m
	}
	$menu add command -label $TXT(PRJ$pr) -command "$comm $pr"
	incr n
    }
    return
}

## initialization of particular cases of main projections

proc MapInitPartProj {proj data datum ps} {
    # initialize particular projection for the map
    #  $data is name of global array for parameters
    # return projection of first position

    set mp [ProjInitPart $proj $data $datum]
    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    return [Proj${mp}Point $data $latd $longd $pdatum]
}

proc ProjInitPart {proj data datum} {
    # set fixed parameters for a particular case of a main projection
    #  $data is name of global array for parameters
    # return name of main projection
    global $data MAPPARTPROJ MAPPARTPDATA MAPPROJDATA MAPPROJAUX

    set mp $MAPPARTPROJ($proj)
    foreach e $MAPPROJDATA($mp) v $MAPPARTPDATA($proj) {
	set ${data}($e) $v
    }
    if { [lsearch -exact $MAPPROJAUX $mp] != -1 } {
	Proj${mp}ComputeAux $data $datum
    }
    set ${data}(datum) $datum
    return $mp
}

## setting up the map coordinates format and datum

proc ChangeMapPFormat {pfmt} {
    # change position format to use with map cursor coordinates
    # if it is a grid with a fixed datum, change $MapPFDatum
    global GRIDS ZGRID Datum MapPFormat MapPFDatum MapPFNeedsDatum MapEmpty

    set MapPFormat $pfmt
    set MapPFNeedsDatum 0
    if { [lsearch -exact $GRIDS $pfmt] != -1 && ! $ZGRID($pfmt) } {
	global GRD$pfmt
	if { [set datum [set GRD${pfmt}(datum)]] != "" } {
	    set MapPFDatum $datum
	    set MapPFNeedsDatum 1
	}	
    }
    return
}

proc ChangeMPFDatum {datum args} {
    # change datum of map cursor coordinates
    #  $args is not used but is needed as this is called-back from
    #  menus built by proc FillDatumMenu (geod.tcl)
    # do nothing if datum is not appropriate to current cursor position format
    global MapPFDatum MapPFNeedsDatum MapEmpty

    if { $MapPFDatum != $datum } {
	if { $MapPFNeedsDatum } { return }
	set MapPFDatum $datum
    }
    return
}

## setting up of a projection for the map

proc MapProjectionIs {proj} {
    # set global variables so that map projection is $proj
    #  $proj in $MAPKNOWNPROJS
    global MapProjection MapProjTitle MapProjInitProc GRIDFOR MAPPARTPROJ TXT \
	    CMDLINE MapPFNeedsDatum MapPFDatum

    set MapProjection $proj ; set MapProjTitle $TXT(PRJ$proj)
    if { ! $CMDLINE } {
	ChangeMapPFormat $GRIDFOR($proj)
	if { $MapPFNeedsDatum } { ChangeMapDatum $MapPFDatum }
    }
    # names of projection procs
    if { [catch {set mp $MAPPARTPROJ($proj)}] } {
	# main projection
	set MapProjInitProc ProjInit
    } else {
	# particular case of a main projection
	set MapProjInitProc MapInitPartProj
	set proj $mp
    }
    foreach a "Point Invert" {
	global MapProj${a}Proc

	set MapProj${a}Proc Proj${proj}$a
    }
    return
}

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

    set Datum $datum
    return
}

### the code that used to be after this line is now in file projs_main.tcl
