#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
#  Copyright (c) 2002 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:  6 January 2002
#

## some information used here adopted from
#  - PROJ4.0 - cartographic projection software
#      by Gerald I. Evenden (gie@kai.er.usgs.gov)
#  - Guidance Note Number 7, European Petroleum Survey Group
#      Revised November 1999
##
## some algorithms and formulae adopted from:
#     - GKK grid conversion by Andreas Lange (andreas.lange@rhein-main.de)
#       in GPStrans 0.36
#     - Swedish grid conversion by Anders Lennartsson
#       (anders.lennartsson@sto.foa.se) in GPStrans 0.36
##
## information on the Taiwan Grid projection provided by
# Dan Jacobson (jidanni@yahoo.com.tw)
##

## "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
#
#  no changes in the map datum ($Datum) will occur after initialization
##

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

     # 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 long0}
    TM    {lat0 long0 k0}
    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}
    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_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}
}

     # 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
    gkklong0  list=0,3,6,9,12,15
    kkjplong0 list=21,24,27,30
    twglong0  list=115,117,119,121,123,125
    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 {LCC1 LCC2 Merc1 Merc2 CS APOLY Stereogr}
     # auxiliary parameters depend on datum?
array set MAPPROJDEPDATUM {
    LCC1  1    LCC2  1    Merc1 1    Merc2 1    CS    1    APOLY  1
    Stereogr 1
}

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

     # particular cases of main projections:
     #  CMP  - projection used in Portuguese Military Maps
     #  BNG  - projection used for the British National Grid
     #  BWI  - projection used for the British West Indies Grid
     #  ITM  - projection used for the Irish TM Grid
     #  KKJY - projection used for the Uniform Finnish Grid
     #  SEG  - projection used for the Swedish Grid
array set MAPPARTPROJ {
    CMP  TM
    BNG  TM
    BWI  TM
    ITM  TM
    KKJY TM
    SEG  TM
}

     # 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}
    ITM  {53.5 -8.0 1.000035}
    KKJY {0 27.0 1}
    SEG  {0 15.808277777778 1}
}

     # projections and known grids
array set GRIDFOR {
    APOLY UTM/UPS
    BNG  BNG
    BWI  BWI
    CMP  CMP
    CS   UTM/UPS
    GKK  GKK
    ITM  ITM
    KKJY KKJY
    KKJP KKJP
    LCC1 UTM/UPS
    LCC2 UTM/UPS
    Merc1 UTM/UPS
    Merc2 UTM/UPS
    SEG  SEG
    Stereogr UTM/UPS
    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}
    SEG {SEG 1500000 0 KM {12e5 19e5 61e5 77e5} {54 70 10 26}}
}

     # zones of grids (regular expressions to recognize valid zones)
array set GRIDZN {
    BNG  {([A-H]|[J-Z])([A-H]|[J-Z])}
    GKK  {[0-5]}
    ITM  {[A-H]|[J-Z]}
    KKJY {27E}
    KKJP {[1-4]}
    TWG  {[1-6]}
}

set GRIDS [lsort [concat [array names GRIDZN] [array names GRIDDEF]]]
set PFORMATS [concat [list $TXT(DMS) $TXT(DMM) $TXT(DDD) $TXT(UTM/UPS) \
	                   $TXT(MH)] \
	             $GRIDS]

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

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 SetUpGrids for those that do not)
    set ZGRID($g) 1
    # at present, all grids with >1 zone have no fixed datum
    set GRD[set g](datum) ""
}

## 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

    set ZGRID($gr) 0 ; set GRIDZN($gr) {}
    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[set gr](_proj) $MAPPARTPROJ($proj)
    foreach f "fe fn" {
	set GRD[set gr](_$f) [set $f]
    }
    set GRD[set gr](_unit) $unit
    # scale factor to get metre from user unit
    set GRD[set gr](_uscale) \
	    [expr 1000.0*$DSCALEFOR(sub,$unit)/$DSCALEFOR($unit)]
    foreach f "xmin xmax ymin ymax" b $xybounds {
	set GRD[set gr](_$f) $b
    }
    foreach f "lamin lamax lomin lomax" b $llbounds {
	set GRD[set gr](_$f) $b
    }
    if { $fixdatum } { set GRD[set 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[set grid](_lamin)] || \
	    $latd > [set GRD[set grid](_lamax)] || \
	    $longd < [set GRD[set grid](_lomin)] || \
	    $longd > [set GRD[set grid](_lomax)] } {
	return "-- 0"
    }
    set proj [set GRD[set grid](_proj)]
    if { "[set GRD[set grid](datum)]" == "" } {
	set GRD[set grid](datum) $datum
	set nodatum 1
    } else { set nodatum 0 }
    set p [Proj${proj}Point GRD$grid $latd $longd $datum]
    if { $nodatum } { set GRD[set grid](datum) "" }
    set s [set GRD[set grid](_uscale)]
    set x [expr int(round(1.0*[lindex $p 0]/$s+[set GRD[set grid](_fe)]))]
    set y [expr int(round(1.0*[lindex $p 1]/$s+[set GRD[set grid](_fn)]))]
    if { $x < [set GRD[set grid](_xmin)] || \
	    $x > [set GRD[set grid](_xmax)] || \
	    $y < [set GRD[set grid](_ymin)] || \
	    $y > [set GRD[set 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[set grid](_xmin)] || \
	    $x > [set GRD[set grid](_xmax)] || \
	    $y < [set GRD[set grid](_ymin)] || \
	    $y > [set GRD[set grid](_ymax)] } {
	return 0
    }
    set s [set GRD[set grid](_uscale)]
    set x [expr $s*($x-[set GRD[set grid](_fe)])]
    set y [expr $s*($y-[set GRD[set grid](_fn)])]
    if { "[set gdatum [set GRD[set grid](datum)]]" == "" } {
	set GRD[set grid](datum) $datum
	set nodatum 1
    } elseif { "$gdatum" != "$datum" } {
	return -1
    } else { set nodatum 0 }
    set proj [set GRD[set grid](_proj)]
    set p [Proj${proj}Invert GRD$grid $x $y DDD]
    if { $nodatum } { set GRD[set grid](datum) "" }
    set latd [lindex $p 0] ; set longd [lindex $p 1]
    if { $latd < [set GRD[set grid](_lamin)] || \
	    $latd > [set GRD[set grid](_lamax)] || \
	    $longd < [set GRD[set grid](_lomin)] || \
	    $longd > [set GRD[set grid](_lomax)] } {
	return 0
    }
    return $p
}

proc GridDatum {grid} {
    # return datum for no-zone grid
    global GRD$grid

    return [set GRD[set grid](datum)]
}

## 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]
}

# GKK, basic KKJ, and Taiwan grid coordinates

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]
}

## 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 { "$UPName" == "" || "$UPAbbrev" == "" } {
	    GMMessage $MESS(projnameabbr)
	} elseif { [lsearch -exact $MAPKNOWNPROJS $UPAbbrev] != -1 } {
	    GMMessage $MESS(abbrevinuse)
	} else {
	    set ok 1
	    foreach p $MAPKNOWNPROJS {
		if { "$TXT(PRJ$p)" == "$UPName" } {
		    GMMessage $MESS(nameinuse)
		    set ok 0
		    break
		}
	    }
	    if { $ok } 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 OpenUserProjection {proj} {
    # edit user-defined projection
    global MAPKNOWNPROJS MAPPROJDATA MAPPROJDTYPE MAPPARTPROJ MAPPARTPDATA \
	    GRIDFOR ZGRID MapProjection UPData UProjs TXT MESS MapPFormat

    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[set 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]] } { return }
    set nogrid [string compare $UPData(_grid) $proj]
    if { $grinuse && ($op == -1 || $nogrid) } {
	GMMessage [format $MESS(gridinusenochg) $lp]
	return
    }
    if { $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
	}
    } else {
	# 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

    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]
    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 UPrGrFile UProjs MAPPARTPROJ MAPPARTPDATA GRIDFOR ZGRID TXT INVTXT \
	    MESS

    if { [catch "set f [open $UPrGrFile 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[set 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 UPrGrFile UProjs MAPKNOWNPROJS MAPPARTPROJ MAPPARTPDATA GRIDFOR \
	    ZGRID TXT INVTXT

    source $UPrGrFile
    return
}

## changing, defining and editing parameters

proc ProjParams {how proj data} {
    # open dialog for defining or confirming the projection parameters
    #  $how in {change, define, edit}
    #  $proj in $MAPKNOWNPROJS is
    #    change: projection whose parameters may be changed
    #    define, edited: 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
    global $data MAPPROJDATA MAPPROJDTYPE GRIDS TXT MESS COLOUR ASKPROJPARAMS \
	    EPOSX EPOSY waitp Param DLUNIT DISTUNIT Datum MAPPROJAUX \
	    MAPPROJDEPDATUM MAPPARTPROJ

    catch "unset Param"
    set waitp 1
    toplevel .proj
    wm protocol .proj WM_DELETE_WINDOW "set waitp 0"
    wm title .proj "GPS Manager: $TXT(projection)"
    wm transient .proj
    wm geometry .proj +$EPOSX+$EPOSY
    bind .proj <Key-Return> "set waitp 0"

    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 [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=* {
		set val [set [set data]($p)]
		set fr $frs.f$p
		frame $fr -relief flat -borderwidth 0
		regsub list= $MAPPROJDTYPE($p) "" l
		set r 0 ; set c 0
		foreach v [split $l ,] {
		    radiobutton $fr.r$v -text $v -variable Param($p) \
			    -value $v -anchor w -selectcolor $COLOUR(check)
		    grid configure $fr.r$v -column $c -row $r -sticky nesw
		    if { [incr c] > 2 } { set c 0 ; incr r ; incr rs }
		}
		$fr.r$val 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 [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" } {
	set grid 1
	set oldgr [set [set data](_grid)]
	set abbr [set [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 [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 [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 [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
    button .proj.fr.frbs.ok -text Ok \
	    -command ".proj.fr.frbs.ok configure -state normal ; set waitp 0"
    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 waitp -1"
    switch $how {
	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 {
	    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 {
	    button .proj.fr.frbs.fgt -text $TXT(forget) \
		    -command ".proj.fr.frbs.fgt configure -state normal ; \
		              set waitp -2"
	    pack .proj.fr.frbs.ok .proj.fr.frbs.rv .proj.fr.frbs.fgt \
		    .proj.fr.frbs.cnc -side left -padx 5
	    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
    # RaiseWindow .proj
    grab .proj
    while 1 {
	tkwait variable waitp
	if { $waitp < 0 } {
	    if { [set r [expr $waitp+1]] == -1 } {
		if { ! [GMConfirm \
			[format $MESS(askforget) $TXT(projection)]] } {
		    set waitp 1
		    continue
		}
	    }
	    break
	}
	set l "" ; set r 0
	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 r -1 ; break }
		    set nv [lindex $nv 0]
		    set pw $frs.f$p.val
		}
		long=* {
		    set nv [ParamGetCoord $p long [$frs.f$p.val get]]
		    set pw $frs.f$p.val
		}
		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 [set data]($p)] } {
		if { [BadParam $TXT($p) $type $nv] } {
		    focus $pw
		    set r -1
		    break
		}
		lappend l $p $nv
		set r 1
	    }
	}
	if { $r != -1 } {
	    if { $r == 1 } {
		array set $data $l
	    }
	    if { $grid } {
		if { $Param(_guse) } {
		    if { "$oldgr" != "[set [set data](_grid)]" } {
			set r 1
		    }
		} else {
		    global GRD$oldgr
		    # check parameters for new/self grid
		    set unit $Param(_gunit)
		    set [set data](_grid) $abbr
		    if { $selfgrid && \
			    "$unit" != "[set GRD[set 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>0 float>0 float>0 \
			    float>0 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[set oldgr](_$v)] } {
			    continue
			}
			if { [BadParam $TXT($n) $t [set $v]] } {
			    focus $frs.zg.$e
			    set r -1
			    break
			}
			set diff 1
		    }
		    if { $r == -1 } { continue }
		    if { $diff } {
			if { $xmin >= $xmax || $ymin >= $ymax || \
				$lamin >= $lamax || $lomin >= $lomax } {
			    GMMessage [format $MESS(badparam) $TXT(bounds)]
			    set r -1
			    continue
			}
			set r 1
		    }
		    if { $Param(_gfdatum) } {
			set datum [$frs.zg.datum cget -text]
			set r 1
		    } elseif { ! $nodatum } {
			set datum ""
			set r 1
		    } else { set datum "" }
		    if { $r == 1 } {
			set [set data](_gparams) \
				[list $abbr $fe $fn $unit \
				   [list $xmin $xmax $ymin $ymax] \
				   [list $lamin $lamax $lomin $lomax] \
				   $datum]
		    }
		}
	    }
	    break
	}
    }
    destroy .proj
    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[set 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[set 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[set 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 [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 [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

puts "Calling ProjParamsRevert with: $proj $data $grid $oldgr $selfgrid"
    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 [set data]($p)]
	    }
	    list=* {
puts [set [set data]($p)]
		.proj.fr.frsel.f$p.r[set [set data]($p)] invoke
	    }
	    reserved { }
	    default {
		.proj.fr.frsel.e$p delete 0 end
		.proj.fr.frsel.e$p insert 0 [set [set data]($p)]
	    }
	}
    }
    if { $grid } {
	set [set data](_grid) $oldgr
	if { "[set datum [set [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
}

## 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 ; 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 {data datum ps} {
    # initialize particular projection for the map
    #  $data is name of global array for parameters
    # return projection of first position
    global MapProjection

    set mp [ProjInitPart $MapProjection $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 [set data]($e) $v
    }
    if { [lsearch -exact $MAPPROJAUX $mp] != -1 } {
	Proj${mp}ComputeAux $data $datum
    }
    set [set data](datum) $datum
    return $mp
}

## setting up use of a projection for the map

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

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

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

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

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

## projection procedures for UTM projection

# initialization projection proc sets initial values for the projection
#  proc given a list of latd,longd,datum to be projected
# for use with the map, it will be called only when the map is empty
# should call proc ProjParams if its parameters may be changed by
#  the user and if $ASKPROJPARAMS is true (see, e.g., ProjTMInit)
# should call proc to compute auxiliary parameters if any
# must return projection of first position

proc ProjUTMInit {data datum ps} {
    # set parameters for UTM projection
    # only the first position is used
    # no parameters can be changed by the user
    # return projection of first position
    global $data

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set p [DegreesToUTM $latd $longd $datum]
    set ze [lindex $p 0] ; set zn [lindex $p 1]
    set [set data](UTMzone) [format %d%s $ze $zn]
    set [set data](long0) [expr 6*int(floor($longd/6.0))+3]
    set [set data](datum) $datum
    return [list [lindex $p 2] [lindex $p 3]]
}

# projection proc is a function of latd,longd,datum to planar Cartesian
#  coordinates x,y in the terrain

proc ProjUTMPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set p [DegreesToUTM $latd $longd $pdatum]
    set pze [lindex $p 0] ; set pzn [lindex $p 1]
    set px [lindex $p 2] ; set py [lindex $p 3]
    scan [set [set data](UTMzone)] %d%s mze mzn
    if { $mze!=$pze || "$mzn" != "$pzn" } {
	set cs [CompUTMOnZone $latd $longd [set [set data](long0)]]
	set px [lindex $cs 0] ; set py [lindex $cs 1]
    }
    return [list $px $py]
}

# invert projection proc is a function of planar Cartesian coordinates in the
#  terrain to position in given format (same datum)

proc ProjUTMInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    scan [set [set data](UTMzone)] %d%s ze zn
    set datum [set [set data](datum)]
    set p [UTMToDegrees $ze $zn $x $y $datum]
    set p [CreatePos [lindex $p 0] [lindex $p 1] $pfmt [PosType $pfmt] $datum]
    return $p
}

# convert to UTM projection proc is a function of planar Cartesian coordinates
#  in the terrain to UTM position

proc ProjUTMInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    scan [set [set data](UTMzone)] %d%s pze pzn
    set datum [set [set data](datum)]
    set p [UTMToDegrees $pze $pzn $x $y $datum]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] $datum]
}

## Transverse Mercator projection

proc ProjTMInit {data datum ps} {
    # set parameters for TM projection
    # take averages of latitudes and of longitudes as central coordinates
    #  and use k0=0.9996
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set sla $latd ; set slo $longd ; set n 1
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set la [lindex $p 0] ; set lo [lindex $p 1]
	}
	set sla [expr $sla+$la] ; set slo [expr $slo+$lo]
	incr n
    }
    set lat0 [expr 1.0*$sla/$n] ; set long0 [expr 1.0*$slo/$n]
    set [set data](lat0) $lat0 ; set [set data](long0) $long0
    set [set data](k0) 0.9996 ; set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change TM $data
    }
    return [ConvToTM $latd $longd [set [set data](lat0)] \
	    [set [set data](long0)] [set [set data](k0)] $datum]
}

proc ProjTMPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    return [ConvToTM $latd $longd [set [set data](lat0)] \
	    [set [set data](long0)] [set [set data](k0)] $pdatum]
}

proc ProjTMInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    set datum [set [set data](datum)]
    set p [ConvFromTM $x $y [set [set data](lat0)] [set [set data](long0)] \
	    [set [set data](k0)] $datum]
    set p [CreatePos [lindex $p 0] [lindex $p 1] $pfmt [PosType $pfmt] $datum]
    return $p
}

proc ProjTMInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set datum [set [set data](datum)]
    set p [ConvFromTM $x $y [set [set data](lat0)] [set [set data](long0)] \
	    [set [set data](k0)] $datum]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] $datum]
}

## German Grid (Gauss-Krueger-Koordinatensystem) projection
# Information provided by Andreas Lange (Andreas.Lange@Rhein-Main.de)
# This is a Transverse Mercator projection with zone in [0-6], lat0=0,
#  lon0=zone*3 (0, 3, 6, 9, 12, 15E), and scale factor at central meridian
#  of k0=1.0

#  Basic Finnish Grid (KKJP) projection
# Similar with zone in [1-4], lon0=zone*3+18 (21, 24, 27, 30E)

# Taiwan Grid projection
# Information provided by Dan Jacobson (jidanni@yahoo.com.tw)
# Similar with zone in [1-6], lon0=zone*2+113 (115, 117, ..., 125E),
#  and k0=0.9999

proc ProjGKKInit {data datum ps} {
    # set parameters for GKK projection
    # return projection of first position

    return [Proj_TMZ_Init GKK gkk 0 15 3 1 $data $datum $ps]
}

proc ProjKKJPInit {data datum ps} {
    # set parameters for KKJP projection
    # return projection of first position

    return [Proj_TMZ_Init KKJP kkjp 21 30 3 1 $data $datum $ps]
}

proc ProjTWGInit {data datum ps} {
    # set parameters for TWG projection
    # return projection of first position

    return [Proj_TMZ_Init TWG twg 115 125 2 0.9999 $data $datum $ps]
}

proc Proj_TMZ_Init {proj pr lmin lmax delta k0 data datum ps} {
    # set parameters for $proj (in {GKK, KKJP, TWG})
    #  $pr is prefix of long0 parameter index
    #  $lmin, $lmax are the extreme values for long0
    #  $delta is longitude range of each zone
    # take averages of longitudes to find long0
    #  and use lat0=0
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set slo $longd ; set n 1
    foreach p [lrange $ps 1 end] {
	set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum [lindex $p 0] $lo $pdatum $datum DDD]
	    set lo [lindex $p 1]
	}
	set slo [expr $slo+$lo]
	incr n
    }
    set lat0 0 ; set long0 [expr 1.0*$slo/$n]
    if { $long0 < $lmin } {
	set long0 $lmin
    } elseif { $long0 > $lmax } {
	set long0 $lmax
    } else {
	set long0 [expr int(1.0*($long0-$lmin+0.5*$delta)/$delta)*$delta+$lmin]
    }
    set [set data](${pr}long0) $long0
    set [set data](datum) $datum
    set [set data](m_0) $k0
    if { $ASKPROJPARAMS } {
	ProjParams change $proj $data
    }
    return [ConvToTM $latd $longd 0 [set [set data](${pr}long0)] $k0 $datum]
}

proc ProjGKKPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position

    return [Proj_TMZ_Point gkk $data $latd $longd $datum]
}

proc ProjKKJPPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position

    return [Proj_TMZ_Point kkjp $data $latd $longd $datum]
}

proc ProjTWGPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position

    return [Proj_TMZ_Point twg $data $latd $longd $datum]
}

proc Proj_TMZ_Point {pr data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    return [ConvToTM $latd $longd 0 [set [set data](${pr}long0)] \
	             [set [set data](m_0)] $datum]
}

proc ProjGKKInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain

    return [Proj_TMZ_Invert gkk $data $x $y $pfmt]
}

proc ProjKKJPInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain

    return [Proj_TMZ_Invert kkjp $data $x $y $pfmt]
}

proc ProjTWGInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain

    return [Proj_TMZ_Invert twg $data $x $y $pfmt]
}

proc Proj_TMZ_Invert {pr data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    set datum [set [set data](datum)]
    set p [ConvFromTM $x $y 0 [set [set data](${pr}long0)] \
	              [set [set data](m_0)] $datum]
    set p [CreatePos [lindex $p 0] [lindex $p 1] $pfmt [PosType $pfmt] $datum]
    return $p
}

proc ProjGKKInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain

    return [Prok_TMZ_InvUTM gkk $data $x $y]
}

proc ProjKKJPInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain

    return [Prok_TMZ_InvUTM kkjp $data $x $y]
}

proc ProjTWGInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain

    return [Prok_TMZ_InvUTM twg $data $x $y]
}

proc Prok_TMZ_InvUTM {pr data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set datum [set [set data](datum)]
    set p [ConvFromTM $x $y 0 [set [set data](${pr}long0)] \
	              [set [set data](m_0)] $datum]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] $datum]
}

## Lambert Conic Conformal projections

# single standard parallel

proc ProjLCC1Init {data datum ps} {
    # set parameters for Lambert Conformal Conic projection, single parallel
    # take averages of latitudes and of longitudes as central coordinates
    #  and use k0=1
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set sla $latd ; set slo $longd ; set n 1
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set la [lindex $p 0] ; set lo [lindex $p 1]
	}
	set sla [expr $sla+$la] ; set slo [expr $slo+$lo]
	incr n
    }
    set lat0 [expr 1.0*$sla/$n] ; set long0 [expr 1.0*$slo/$n]
    set [set data](lat0) $lat0 ; set [set data](long0) $long0
    set [set data](k0) 1.0 ; set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change LCC1 $data
    }
    # compute other parameters
    ProjLCC1ComputeAux $data $datum
    return [ProjLCC1Point $data $latd $longd $datum]
}

proc ProjLCC1ComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data 

    set d [EllipsdData $datum]
    set a [lindex $d 0] ; set f [lindex $d 1]
    set es [expr $f*(2-$f)]
    set e [set [set data](m_e) [expr sqrt($es)]]
    set phi0 [expr [set [set data](lat0)]*0.01745329251994329576]
    if { [set n [set [set data](lcc_n) [expr sin($phi0)]]] < 0 } {
	set [set data](lcc_sn) -1
    } else { set [set data](lcc_sn) 1 }
    set m0 [expr cos($phi0)/sqrt(1-$es*$n*$n)]
    set t0n [expr pow([ExpRedLat $phi0 $n $e],$n)]
    set F [expr $m0/($n*$t0n)]
    set aFk0 [set [set data](m_a) [expr $a*$F*[set [set data](k0)]]]
    set [set data](lcc_rho0F) [expr $aFk0*$t0n]
    return
}

proc ProjLCC1Point {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set phi [expr $latd*0.01745329251994329576]
    set theta [expr [set [set data](lcc_n)]* \
	            ($longd-[set [set data](long0)])*0.01745329251994329576]
    set t [ExpRedLat $phi [expr sin($phi)] [set [set data](m_e)]]
    set rho [expr [set [set data](m_a)]* \
	          pow($t,[set [set data](lcc_n)])]
    set x [expr $rho*sin($theta)]
    set y [expr [set [set data](lcc_rho0F)]-$rho*cos($theta)]
    return [list $x $y]
}

proc ProjLCC1Invert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    set z [expr [set [set data](lcc_rho0F)]-$y]
    set thetap [expr atan2($x,$z)]
    set rhop [expr [set [set data](lcc_sn)]*sqrt($x*$x+$z*$z)]
    set tp [expr pow($rhop/([set [set data](m_a)]), \
	             1.0/[set [set data](lcc_n)])]
    set longd [expr $thetap/[set [set data](lcc_n)]*57.29577951308232087684+ \
	            [set [set data](long0)]]
    set latd [expr [LatFromRedLat $tp [set [set data](m_e)]]* \
	           57.29577951308232087684]
    return [CreatePos $latd $longd $pfmt [PosType $pfmt] \
	    [set [set data](datum)]]
}

proc ProjLCC1InvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjLCC1Invert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

# two standard parallels

proc ProjLCC2Init {data datum ps} {
    # set parameters for Lambert Conformal Conic projection, two parallels
    # take extremes of latitudes as latitudes of standard parallels,
    #  averages of latitudes and longitudes as false origin coordinates
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set n 1
    set sla [set lamx [set lamn $latd]] ; set slo $longd
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set la [lindex $p 0] ; set lo [lindex $p 1]
	}
	set sla [expr $sla+$la] ; set slo [expr $slo+$lo]
	if { $la > $lamx } { set lamx $la }
	if { $la < $lamn } { set lamn $la }
	incr n
    }
    set latF [expr 1.0*$sla/$n] ; set longF [expr 1.0*$slo/$n]
    set [set data](latF) $latF ; set [set data](longF) $longF
    set [set data](lat1) $lamn ; set [set data](lat2) $lamx
    set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change LCC2 $data
    }
    # compute other parameters
    ProjLCC2ComputeAux $data $datum
    return [ProjLCC2Point $data $latd $longd $datum]
}

proc ProjLCC2ComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data 

    set d [EllipsdData $datum]
    set a [lindex $d 0] ; set f [lindex $d 1]
    set es [expr $f*(2-$f)]
    set e [set [set data](m_e) [expr sqrt($es)]]
    set phi1 [expr [set [set data](lat1)]*0.01745329251994329576]
    set phi2 [expr [set [set data](lat2)]*0.01745329251994329576]
    set phiF [expr [set [set data](latF)]*0.01745329251994329576]
    set s1 [expr sin($phi1)] ; set s2 [expr sin($phi2)]
    set m1 [expr cos($phi1)/sqrt(1-$es*$s1*$s1)]
    set m2 [expr cos($phi2)/sqrt(1-$es*$s2*$s2)]
    set t1 [ExpRedLat $phi1 $s1 $e]
    set t2 [ExpRedLat $phi2 $s2 $e]
    set n [set [set data](lcc_n) \
	    [expr (log($m1)-log($m2))/(log($t1)-log($t2))]]
    if { $n < 0 } {
	set [set data](lcc_sn) -1
    } else { set [set data](lcc_sn) 1 }
    set F [expr $m1/($n*pow($t1,$n))]
    set aF [set [set data](m_a) [expr $a*$F]]
    set tF [ExpRedLat $phiF [expr sin($phiF)] $e]
    set [set data](lcc_rho0F) [expr $aF*pow($tF,$n)]
    return
}

proc ProjLCC2Point {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set phi [expr $latd*0.01745329251994329576]
    set theta [expr [set [set data](lcc_n)]* \
	            ($longd-[set [set data](longF)])*0.01745329251994329576]
    set t [ExpRedLat $phi [expr sin($phi)] [set [set data](m_e)]]
    set rho [expr [set [set data](m_a)]* \
	          pow($t,[set [set data](lcc_n)])]
    set x [expr $rho*sin($theta)]
    set y [expr [set [set data](lcc_rho0F)]-$rho*cos($theta)]
    return [list $x $y]
}

proc ProjLCC2Invert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    set z [expr [set [set data](lcc_rho0F)]-$y]
    set thetap [expr atan2($x,$z)]
    set rhop [expr [set [set data](lcc_sn)]*sqrt($x*$x+$z*$z)]
    set tp [expr pow($rhop/([set [set data](m_a)]), \
	             1.0/[set [set data](lcc_n)])]
    set longd [expr $thetap/[set [set data](lcc_n)]*57.29577951308232087684+ \
	            [set [set data](longF)]]
    set latd [expr [LatFromRedLat $tp \
	             [set [set data](m_e)]]*57.29577951308232087684]
    return [CreatePos $latd $longd $pfmt [PosType $pfmt] \
	    [set [set data](datum)]]
}

proc ProjLCC2InvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjLCC2Invert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

# auxiliary procs for LCC projections

proc ExpRedLat {phi sinphi e} {
    # compute exp of reduced latitude for $phi
    #  $e is first eccentricity of ellipsoid

    set se [expr $sinphi*$e]
    return [expr tan((1.5707963267948966-$phi)/2.0) / \
	    pow((1.0-$se)/(1.0+$se), $e/2.0)]
}

proc LatFromRedLat {ts e} {
    # compute latitude from reduced latitude

    set eccnth [expr $e/2.0]
    set phi [expr 1.5707963267948966-2*atan($ts)]
    set i 16 ; set d 1
    while { abs($d) > 1e-10 && [incr i -1] } {
	set con [expr $e*sin($phi)]
	set d [expr 1.5707963267948966- \
		    2*atan($ts*pow((1-$con)/(1+$con),$eccnth))-$phi]
	set phi [expr $phi+$d]
    }
    return $phi
}

## Mercator projection: a special case of Lambert Conic Conformal
#   with the equator as standard parallel

# single standard parallel

proc ProjMerc1Init {data datum ps} {
    # set parameters for Mercator projection, single parallel
    # take average of longitudes as central longitude
    #  and use k0=1
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set longd [lindex $p 1] ; set latd [lindex $p 0]
    }
    set slo $longd ; set n 1
    foreach p [lrange $ps 1 end] {
	set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set lo [lindex $p 1]
	}
	set slo [expr $slo+$lo]
	incr n
    }
    set long0 [expr 1.0*$slo/$n]
    set [set data](long0) $long0
    set [set data](k0) 1.0 ; set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change Merc1 $data
    }
    # compute other parameters
    ProjMerc1ComputeAux $data $datum
    return [ProjMerc1Point $data $latd $longd $datum]
}

proc ProjMerc1ComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data 

    set d [EllipsdData $datum]
    set a [lindex $d 0] ; set f [lindex $d 1]
    set [set data](m_a) [expr 1.0*$a*[set [set data](k0)]]
    set es [expr $f*(2-$f)]
    set [set data](m_e) [expr sqrt($es)]
    set e4 [expr $es*$es] ; set e6 [expr $e4*$es]
    set [set data](m_1) [expr $es* \
	    (0.5+0.20833333333333333333*$es+0.08333333333333333333*$e4+ \
             0.03611111111111111111*$e6)]
    set [set data](m_2) [expr $es* \
	    (0.14583333333333333333*$es+0.12083333333333333333*$e4+ \
	     0.07039930555555555555*$e6)]
    set [set data](m_3) [expr $es* \
	    (0.05833333333333333333*$e4+0.07232142857142857142*$e6)]
    set [set data](m_4) [expr 0.02653149801587301587*$es*$e6]
    return
}

proc ProjMerc1Point {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set phi [expr $latd*0.01745329251994329576]
    set se [expr sin($phi)*[set [set data](m_e)]]
    set mm [expr tan((1.5707963267948966+$phi)/2.0)* \
     	         pow((1.0-$se)/(1.0+$se), [set [set data](m_e)]/2.0)]
    set x [expr [set [set data](m_a)]* \
	    ($longd-[set [set data](long0)])*0.01745329251994329576]
    set y [expr [set [set data](m_a)]*log($mm)]
    return [list $x $y]
}

proc ProjMerc1Invert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    set ksi [expr 1.5707963267948966- \
	          2*atan(exp(-$y/[set [set data](m_a)]))]
    set latd [expr ($ksi+[set [set data](m_1)]*sin($ksi+$ksi)+ \
	            [set [set data](m_2)]*sin(4*$ksi)+ \
	            [set [set data](m_3)]*sin(6*$ksi)+ \
	            [set [set data](m_4)]*sin(8*$ksi))* \
		   57.29577951308232087684]
    set longd [expr $x/[set [set data](m_a)]*57.29577951308232087684+ \
	            [set [set data](long0)]]
    return [CreatePos $latd $longd $pfmt [PosType $pfmt] \
	    [set [set data](datum)]]
}

proc ProjMerc1InvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjMerc1Invert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

# two standard parallels (symmetrical with respect to the equator)

proc ProjMerc2Init {data datum ps} {
    # set parameters for Mercator projection, two parallels
    # take average of longitudes as central longitude and extreme latitude
    #  (in absolute value) as first standard parallel
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set longd [lindex $p 1] ; set latd [lindex $p 0]
    }
    set slo $longd ; set lamax [expr abs($latd)] ; set n 1
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set lo [lindex $p 1] ; set la [lindex $p 0]
	}
	set slo [expr $slo+$lo]
	if { abs($la) > $lamax } { set lamax [expr abs($la)] }
	incr n
    }
    set long0 [expr 1.0*$slo/$n]
    set [set data](long0) $long0 ; set [set data](lat1) $lamax
    set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change Merc2 $data
    }
    # compute other parameters
    ProjMerc2ComputeAux $data $datum
    return [ProjMerc1Point $data $latd $longd $datum]
}

proc ProjMerc2ComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data 

    set d [EllipsdData $datum]
    set a [lindex $d 0] ; set f [lindex $d 1]
    set es [expr $f*(2-$f)]
    set [set data](m_e) [expr sqrt($es)]
    set phi1 [expr abs([set [set data](lat1)])*0.01745329251994329576]
    set s [expr sin($phi1)]
    set k0 [expr cos($phi1)/sqrt(1-$es*$s*$s)]
    set [set data](m_a) [expr 1.0*$a*$k0]
    set e4 [expr $es*$es] ; set e6 [expr $e4*$es]
    set [set data](m_1) [expr $es* \
	    (0.5+0.20833333333333333333*$es+0.08333333333333333333*$e4+ \
             0.03611111111111111111*$e6)]
    set [set data](m_2) [expr $es* \
	    (0.14583333333333333333*$es+0.12083333333333333333*$e4+ \
	     0.07039930555555555555*$e6)]
    set [set data](m_3) [expr $es* \
	    (0.05833333333333333333*$e4+0.07232142857142857142*$e6)]
    set [set data](m_4) [expr 0.02653149801587301587*$es*$e6]
    return
}

proc ProjMerc2Point {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    return [ProjMerc1Point $data $latd $longd $datum]
}

proc ProjMerc2Invert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    return [ProjMerc1Invert $data $x $y $pfmt]
}

proc ProjMerc2InvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjMerc1Invert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

## Cassini-Soldner projection

proc ProjCSInit {data datum ps} {
    # set parameters for CS projection
    # take averages of latitudes and of longitudes as central coordinates
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set sla $latd ; set slo $longd ; set n 1
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set la [lindex $p 0] ; set lo [lindex $p 1]
	}
	set sla [expr $sla+$la] ; set slo [expr $slo+$lo]
	incr n
    }
    set lat0 [expr 1.0*$sla/$n] ; set long0 [expr 1.0*$slo/$n]
    set [set data](lat0) $lat0 ; set [set data](long0) $long0
    set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change CS $data
    }
    ProjCSComputeAux $data $datum
    return [ProjCSPoint $data $latd $longd $datum]
}

proc ProjCSComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data 

    set d [EllipsdData $datum]
    set a [set [set data](m_a) [lindex $d 0]] ; set f [lindex $d 1]
    set es [set [set data](m_e) [expr $f*(2-$f)]]
    set phi0 [expr [set [set data](lat0)]*0.01745329251994329576]
    set e4 [expr $es*$es] ; set e6 [expr $es*$e4]
    set m1 [set [set data](m_1) [expr 1-0.25*$es-0.046875*$e4-0.01953125*$e6]]
    set m2 [set [set data](m_2) [expr 0.375*$es+0.09375*$e4+0.0439453125*$e6]]
    set m3 [set [set data](m_3) [expr 0.05859375*$e4+0.0439453125*$e6]]
    set m4 [set [set data](m_4) [expr 0.01139322916666666667*$e6]]
    set [set data](m_0) [expr $a*($m1*$phi0-$m2*sin($phi0+$phi0)+ \
	                          $m3*sin(4*$phi0)-$m4*sin(6*$phi0))]
    set se [expr sqrt(1-$es)]
    set e1 [expr (1.0-$se)/(1+$se)] ; set e12 [expr $e1*$e1]
    set [set data](m_5) [expr $e1*(1.5-0.84375*$e12)]
    set [set data](m_6) [expr $e12*(1.3125-1.71875*$e12)]
    set [set data](m_7) [expr 1.57291666666666666667*$e12*$e1]
    set [set data](m_8) [expr 2.142578125*$e12*$e12]
    return
}

proc ProjCSPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set a [set [set data](m_a)] ; set es [set [set data](m_e)]
    set phi [expr $latd*0.01745329251994329576]
    set cphi [expr cos($phi)] ; set sphi [expr sin($phi)]
    set A [expr ($longd-[set [set data](long0)])*0.01745329251994329576*$cphi]
    set A2 [expr $A*$A] ; set A4 [expr $A2*$A2]
    set t [expr tan($phi)] ; set T [expr $t*$t]
    set C [expr $es*$cphi*$cphi/(1.0-$es)]
    set v [expr $a/sqrt(1-$es*$sphi*$sphi)]
    set M [expr $a*([set [set data](m_1)]*$phi- \
	            [set [set data](m_2)]*sin($phi+$phi)+ \
	            [set [set data](m_3)]*sin(4*$phi)- \
                    [set [set data](m_4)]*sin(6*$phi))]
    set x [expr $v*$A*(1-$T*$A2/6.0-(8-$T+8*$C)*$T*$A4/120.0)]
    set y [expr $M-[set [set data](m_0)]+$v*$t*(0.5*$A2+(5-$T+6*$C)*$A4/24.0)]
    return [list $x $y]
}

proc ProjCSInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data

    set a [set [set data](m_a)] ; set es [set [set data](m_e)]
    set miu1 [expr ([set [set data](m_0)]+$y)/($a*[set [set data](m_1)])]
    set phi1 [expr $miu1+[set [set data](m_5)]*sin($miu1+$miu1)+ \
	           [set [set data](m_6)]*sin(4*$miu1)+ \
	           [set [set data](m_7)]*sin(6*$miu1)+ \
	           [set [set data](m_8)]*sin(8*$miu1)]
    set sphi1 [expr sin($phi1)]
    set t [expr 1-$es*$sphi1*$sphi1]
    set v1 [expr $a/sqrt($t)] ; set rho1 [expr $v1*(1-$es)/$t]
    set t [expr tan($phi1)] ; set T1 [expr $t*$t]
    set D [expr $x/$v1] ; set D2 [expr $D*$D]
    set tt [expr (1+3*$T1)*$D2]
    set lat [expr ($phi1-$v1*$t/$rho1*$D2*(0.5-$tt/24.0))* \
	          57.29577951308232087684]
    set long [expr $D*(1-$T1*$D2/3.0+$tt*$D2/15.0)/cos($phi1)* \
	          57.29577951308232087684+[set [set data](long0)]]
    return [CreatePos $lat $long $pfmt [PosType $pfmt] [set [set data](datum)]]
}

proc ProjCSInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjCSInvert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

## American polyconic projection
# adapted from PROJ4.0

proc ProjAPOLYInit {data datum ps} {
    # set parameters for American Polyconic projection
    # take averages of latitudes as standard latitude
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set sla $latd ; set n 1
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set la [lindex $p 0]
	}
	set sla [expr $sla+$la]
	incr n
    }
    set [set data](lat0) [set lat0 [expr 1.0*$sla/$n]]
    set [set data](datum) $datum
    if { $ASKPROJPARAMS } {
	ProjParams change APOLY $data
    }
    # compute other parameters
    ProjAPOLYComputeAux $data $datum
    return [ProjAPOLYPoint $data $latd $longd $datum]
}

proc ProjAPOLYComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data

    set d [EllipsdData $datum]
    set [set data](a) [lindex $d 0]
    set f [lindex $d 1]
    set es [set [set data](m_5) [expr $f*(2-$f)]]
    MeridDistParams $data $es
    set phi0 [expr [set [set data](lat0)]*0.01745329251994329576]
    set [set data](m_6) \
	    [MeridionalDist $data $phi0 [expr sin($phi0)] [expr cos($phi0)]]
    return
}

proc ProjAPOLYPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    set a [set [set data](a)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set phi [expr $latd*0.01745329251994329576]
    set lam [expr $longd*0.01745329251994329576]
    if { abs($phi) <= 1e-10 } {
	set x [expr $lam*$a] ; set y [expr -$a*[set [set data](m_6)]]
    } else {
	set sp [expr sin($phi)]
	if { abs([set cp [expr cos($phi)]]) > 1e-10 } {
	    set ms [expr $cp/sqrt(1-[set [set data](m_5)]*$sp*$sp)/$sp]
	} else { set ms 0 }
	set t [expr $lam*$sp]
	set x [expr $a*$ms*sin($t)]
	set y [expr $a*(([MeridionalDist $data $phi $sp $cp]- \
		[set [set data](m_6)])+$ms*(1-cos($t)))]
    }
    return [list $x $y]
}

proc ProjAPOLYInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data MESS TXT

    set a [set [set data](a)]
    set x [expr 1.0*$x/$a] ; set y [expr 1.0*$y/$a]
    set y [expr $y+[set [set data](m_6)]]
    if { abs($y) <= 1e-10 } {
	set phi 0 ; set lam $x
    } else {
	set r [expr $x*$x+$y*$y] ; set phi $y
	set es [set [set data](m_5)]
	for { set i 0 } { $i < 20 } { incr i } {
	    set sp [expr sin($phi)] ; set cp [expr cos($phi)]
	    set s2ph [expr $sp*$cp]
	    if { abs($cp) < 1e-12 } {
		GMMessage [format $MESS(badinvproj) $TXT(PRJAPOLY)]
	    }
	    set mlp [expr sqrt(1-$es*$sp*$sp)]
	    set c [expr $sp*$mlp/$cp]
	    set ml [MeridionalDist $data $phi $sp $cp]
	    set mlb [expr $ml*$ml+$r]
	    set mlp [expr (1-$es)/($mlp*$mlp*$mlp)]
	    set dphi [expr ($ml+$ml+$c*$mlb-2.0*$y*($c*$ml+1))/ \
		    ($es*$s2ph*($mlb-2*$y*$ml)/$c+ \
		     2*($y-$ml)*($c*$mlp-1.0/$s2ph)-$mlp-$mlp)]
	    set phi [expr $phi+$dphi]
	    if { abs($dphi) <= 1e-12 } { break }
	}
	if { $i == 0 } {
	    GMMessage [format $MESS(badinvproj) $TXT(PRJAPOLY)]
	}
	set c [expr sin($phi)]
	set lam [expr asin($x*tan($phi)*sqrt(1-$es*$c*$c))/sin($phi)]
    }
    set longd [expr $lam*57.29577951308232087684]
    set latd [expr $phi*57.29577951308232087684]
    return [CreatePos $latd $longd $pfmt [PosType $pfmt] \
	    [set [set data](datum)]]
}

proc ProjAPOLYInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjAPOLYInvert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

## auxiliary procs for polyconic projection
# meridional distance for ellipsoid and inverse

proc MeridDistParams {data es} {
    # compute parameters for meridional distance and inverse functions
    #  saving them at indices m_0, ..., m_4 of array $data
    global $data

    set t [expr $es*(0.046875+$es*(0.01953125+$es*0.01068115234375))]
    set [set data](m_0) [expr 1-$es*(0.25+$t)]
    set [set data](m_1) [expr $es*(0.75-$t)]
    set t [expr $es*$es]
    set [set data](m_2) [expr $t*(0.46875-$es* \
	    (0.01302083333333333333+$es*0.00712076822916666666))]
    set t [expr $es*$t]
    set [set data](m_3) \
	    [expr $t*(0.36458333333333333333-$es*0.00569661458333333333)]
    set [set data](m_4) [expr $t*$es*0.3076171875]
    return
}

proc MeridionalDist {data phi sphi cphi} {
    # compute meridional distance for given latitude
    # assume parameters for transformation are in array $data at indices
    #  m_0, ..., m_4
    global $data

    set cphi [expr $cphi*$sphi]
    set sphi [expr $sphi*$sphi]
    return [expr [set [set data](m_0)]*$phi-$cphi* \
	    ([set [set data](m_1)]+$sphi* \
	     ([set [set data](m_2)]+$sphi* \
	      ([set [set data](m_3)]+$sphi*[set [set data](m_4)])))]
}

proc LatFromMeridDist {data d} {
    # compute latitude from given meridional distance
    # assume parameters for transformation and e^2 are in array $data at
    #  indices m_0, ..., m_4 and m_5
    global $data MESS

    set es [set [set data](m_5)]
    set k [expr 1.0/(1-$es)]    
    set phi $d
    for { set i 0 } { $i < 10 } { incr i } {
	set s [expr sin($phi)]
	set t [expr 1.0-$es*$s*$s]
	set dphi [expr [MeridionalDist $data $phi $s [expr cos($phi)]]* \
		($t*sqrt($t))*$k]
	set phi [expr $phi-$dphi]
	if { abs($dphi) < 1e-11 } { return $phi }
    }
    GMMessage $MESS(badinvmdist)
    return $phi
}

## Stereographic projection
#

proc ProjStereogrInit {data datum ps} {
    # set parameters for Stereographic projection
    # take averages of latitudes and of longitudes as central coordinates
    #  and k0 as 1
    # central latitude determines the case: polar, oblique, equatorial
    # return projection of first position
    global $data ASKPROJPARAMS

    set p [lindex $ps 0]
    set latd [lindex $p 0] ; set longd [lindex $p 1] ; set pdatum [lindex $p 2]
    if { "$pdatum" != "$datum" } {
	set p [ConvertDatum $latd $longd $pdatum $datum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set sla $latd ; set slo $longd ; set n 1
    foreach p [lrange $ps 1 end] {
	set la [lindex $p 0] ; set lo [lindex $p 1] ; set pdatum [lindex $p 2]
	if { "$pdatum" != "$datum" } {
	    set p [ConvertDatum $la $lo $pdatum $datum DDD]
	    set la [lindex $p 0] ; set lo [lindex $p 1]
	}
	set sla [expr $sla+$la] ; set slo [expr $slo+$lo]
	incr n
    }
    set [set data](lat0) [expr abs(1.0*$sla/$n)]
    set [set data](long0) [expr 1.0*$slo/$n]
    set [set data](datum) $datum ; set [set data](k0) 1
    if { $ASKPROJPARAMS } {
	ProjParams change Stereogr $data
    }
    # compute other parameters
    ProjStereogrComputeAux $data $datum
    return [ProjStereogrPoint $data $latd $longd $datum]
}

proc ProjStereogrComputeAux {data datum} {
    # compute auxiliary parameters from main parameters
    #  $data is name of global array for the parameters
    global $data

    set d [EllipsdData $datum]
    set [set data](m_a) [lindex $d 0] ; set f [lindex $d 1]
    set e [set [set data](m_e) [expr sqrt($f*(2-$f))]]
    set phi0 [expr [set [set data](lat0)]*0.01745329251994329576]
    set k0 [set [set data](k0)]
    set t [expr abs($phi0)]
    if { abs($t-1.5707963267948966) < 1e-10 } {
	if { $phi0 < 0 } {
	    set mode s_pole
	} else { set mode n_pole }
	set [set data](m_0) [expr 2*$k0/sqrt(pow(1+$e,1+$e)*pow(1-$e,1-$e))]
    } elseif { $t > 1e-10 } {
	set mode obliq
	set t [expr sin($phi0)]
	set X [expr 2*atan([SSFunc_ $phi0 $t $e])-1.5707963267948966]
	set t [expr $t*$e]
	set [set data](m_0) [expr 2*$k0*cos($phi0)/sqrt(1-$t*$t)]
	set [set data](m_1) [expr sin($X)]
	set [set data](m_2) [expr cos($X)]
    } else {
	set mode equat
	set [set data](m_0) [expr 2*$k0]
    }
    set [set data](m_3) $mode
    return
}

proc ProjStereogrPoint {data latd longd datum} {
    # compute planar Cartesian coordinates for given position
    global $data

    set pdatum [set [set data](datum)]
    if { "$datum" != "$pdatum" } {
	set p [ConvertDatum $latd $longd $datum $pdatum DDD]
	set latd [lindex $p 0] ; set longd [lindex $p 1]
    }
    set e [set [set data](m_e)]
    set akm1 [set [set data](m_0)]
    set phi [expr $latd*0.01745329251994329576]
    set lam [expr ($longd-[set [set data](long0)])*0.01745329251994329576]
    set coslam [expr cos($lam)] ; set sinlam [expr sin($lam)]
    set sinphi [expr sin($phi)]
    switch [set [set data](m_3)] {
	obliq -
	equat {
	    set X [expr 2*atan([SSFunc_ $phi $sinphi $e])-1.5707963267948966]
	    set sinX [expr sin($X)] ; set cosX [expr cos($X)]
	    set sinX1 [set [set data](m_1)]
	    set cosX1 [set [set data](m_2)]
	    set A [expr $akm1/($cosX1*(1+$sinX1*$sinX+$cosX1*$cosX*$coslam))]
	    set x [expr $A*$cosX]
	    set y [expr $A*($cosX1*$sinX-$sinX1*$cosX*$coslam)]
	}
	n_pole {
	    set x [expr $akm1*[ExpRedLat $phi $sinphi $e]]
	    set y [expr -$x*$coslam]
	}
	s_pole {
	    set x [expr $akm1*[ExpRedLat [expr -$phi] [expr -$sinphi] $e]]
	    set y [expr $x*$coslam]
	}
    }
    set a [set [set data](m_a)]
    set x [expr $x*$sinlam*$a] ; set y [expr $y*$a]
    return [list $x $y]
}

proc ProjStereogrInvert {data x y pfmt} {
    # return position in $pfmt format for point at $x,$y in the terrain
    global $data MESS TXT

    set e [set [set data](m_e)] ; set a [set [set data](m_a)]
    set akm1 [set [set data](m_0)]
    set long0 [set [set data](long0)] ; set datum [set [set data](datum)]
    set x [expr $x/$a] ; set y [expr $y/$a]
    if { abs($x)<1e-6 && abs($y)<1e-6 } {
	return [CreatePos [set [set data](lat0)] $long0 $pfmt [PosType $pfmt] \
		    $datum]
    }
    set rho [Hypot $x $y]
    set spole 0
    switch [set [set data](m_3)] {
	obliq -
	equat {
	    set sinX1 [set [set data](m_1)]
	    set cosX1 [set [set data](m_2)]
	    set tp [expr 2*atan2($rho*$cosX1,$akm1)]
	    set cosphi [expr cos($tp)] ; set sinphi [expr sin($tp)]
	    set phi_l [expr asin($cosphi*$sinX1+($y*$sinphi*$cosX1/$rho))]
	    set tp [expr tan(0.5*(1.5707963267948966+$phi_l))]
	    set x [expr $x*$sinphi]
	    set y [expr $rho*$cosX1*$cosphi-$y*$sinX1*$sinphi]
	    set halfpi 1.5707963267948966
	    set halfe [expr 0.5*$e]
	}
	n_pole {
	    set y [expr -$y]
	    set tp [expr -1.0*$rho/$akm1]
	    set phi_l [expr -2*atan($tp)]
	    set halfpi -1.5707963267948966
	    set halfe [expr -0.5*$e]
	}
	s_pole {
	    set spole 1
	    set tp [expr -1.0*$rho/$akm1]
	    set phi_l [expr  -2*atan($tp)]
	    set halfpi -1.5707963267948966
	    set halfe [expr -0.5*$e]
	}
    }
    for { set i 8 } { [incr i -1] } { set phi_l $phi } {
	set sinphi [expr $e*sin($phi_l)]
	set phi [expr 2*atan($tp*pow((1+$sinphi)/(1-$sinphi),$halfe))-$halfpi]
	if { abs($phi_l-$phi) < 1e-10 } {
	    if { $spole } { set phi [expr -$phi] }
	    if { $x == 0 && $y == 0 } {
		set longd 0
	    } else { set longd [expr atan2($x,$y)*57.29577951308232087684] }
	    set latd [expr $phi*57.29577951308232087684]
	    set longd [expr $longd+$long0]
	    return [CreatePos $latd $longd $pfmt [PosType $pfmt] $datum]
	}
    }
    ## return 0 180 on error...
    GMMessage [format $MESS(badinvproj) $TXT(PRJStereogr)]
    return [CreatePos 0 180 $pfmt [PosType $pfmt] $datum]
}

proc ProjStereogrInvUTM {data x y} {
    # return UTM position for point at $x,$y in the terrain
    global $data

    set p [ProjStereogrInvert $data $x $y DDD]
    return [DegreesToUTM [lindex $p 0] [lindex $p 1] [set [set data](datum)]]
}

# auxiliary procs for Stereographic

proc SSFunc_ {phit sinphi eccen} {

    set sinphi [expr $sinphi*$eccen]
    return [expr tan(0.5*(1.5707963267948966+$phit))* \
	    pow((1-$sinphi)/(1+$sinphi),0.5*$eccen)]
}

proc Hypot {x y} {
    # computation of sqrt($x*$x+$y*$y) avoiding overflows

    if { $x < 0 } {
	set x [expr -$x]
    } elseif { $x == 0 } {
	if { $y < 0 } { return [expr -$y] }
	return $y
    }
    if { $y < 0 } {
	set y [expr -$y]
    } elseif { $y == 0 } { return $x }
    if { $x < $y } {
	set x [expr 1.0*$x/$y]
	return [expr $y*sqrt(1+$x*$x)]
    }
    set y [expr 1.0*$y/$x]
    return [expr $x*sqrt(1+$y*$y)]
}
