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

## Some formulae kindly supplied by
#     Luisa Bastos, Universidade do Porto
#     Gil Goncalves, Universidade de Coimbra
#  Computation of area of spherical polygon adapted from sph_poly.c in
#   "Graphics Gems IV", edited by Paul Heckbert, Academic Press, 1994.
#  Formula for ellipsoid radius from
#   "Ellipsoidal Area Computations of Large Terrestrial Objects"
#   by Hrvoje Lukatela
#   http://www.geodyssey.com/papers/ggelare.html
##

### positions and coordinates

proc PosType {pformt} {

    switch $pformt {
	DMS -
	DMM -
	DDD     { return latlong }
	UTM/UPS { return utm }
	MH      { return mh }
	default { return grid }
    }
}

proc Coord {pformt coord negh} {
    # convert coordinate $coord in format $pformt, with negative heading $negh,
    #  to signed degrees
    # $pformt in {DMS, DMM, DDD}

    set coord [string trim $coord]
    set sign 1
    set h [string index "$coord" 0]
    if { ! [regexp {[0-9]} $h] } {
	if { "$h" == "$negh" || "$h" == "-" } { set sign -1 }
	set coord [string range "$coord" 1 end]
    }
    switch $pformt {
	DMS {
	    scan "$coord" "%d %d %f" d m s
	    return [expr $sign*($d+$m/60.0+$s/3600.0)]
	}
	DMM {
	    scan "$coord" "%d %f" d m
	    return [expr $sign*($d+$m/60.0)]
	}
	DDD {
	    return [expr $sign*$coord]
	}
    }
}

proc CreatePos {latd longd pformt type datum} {
    # create position representation under format $pformt, $type,
    #  from lat/long in degrees, and $datum
    # a position representation is a list whose first two elements
    #  are lat and long in degrees, and whose rest is dependent on format:
    #  $type==latlong: lat and long in external format
    #  $type==utm: zones east and north and x y coordinates
    #  $type==grid: zone name and x y coordinates
    #  $type==mh: Maidenhead-locator (6 characters)
    global ZGRID

    switch $type {
	latlong {
	    if { $latd < 0 } {
		set la [expr -$latd] ; set hlat S
	    } else {
		set la $latd ; set hlat N
	    }
	    if { $longd < 0 } {
		set lo [expr -$longd] ; set hlng W
	    } else {
		set lo $longd ; set hlng E
	    }
	    return [list $latd $longd "$hlat[ExtDegrees $pformt $la]" \
		         "$hlng[ExtDegrees $pformt $lo]"]
	}
	utm {
	    set p [DegreesToUTM $latd $longd $datum]
	    return [linsert $p 0 $latd $longd]
	}
	grid {
	    if { $ZGRID($pformt) } {
		set p [DegreesTo$pformt $latd $longd $datum]
	    } else {
		set p [DegreesToNZGrid $pformt $latd $longd $datum]
	    }
	    return [linsert $p 0 $latd $longd]
	}
	mh {
	    return [list $latd $longd [DegreesToMHLoc $latd $longd]]
	}
    }
}

proc ExtDegrees {pformt degs} {
    # from signed degrees $degs to external representation of format $pformt
    # $pformt in {DMS, DMM, DDD, DMSsimpl}
    #  DMSsimpl is similar to DMS, but for values less than 1 degree the
    #  representation is either MM'SS.S" or SS.S"

    switch -glob $pformt {
	DMS* {
	      if { $degs < 0 } {
		  set degs [expr -$degs] ; set sign -1
	      } else { set sign 1 }
	      set d [expr int($degs)]
	      set degs [expr ($degs-$d)*60]
	      set d [expr $sign*$d]
	      set m [expr int($degs)]
	      set s [expr ($degs-$m)*60]
	      if { $s > 59.95 } { set s 0 ; incr m }
	      if { $m > 59 } { set m 0 ; incr d }
	      if { $d > 0 || "$pformt" == "DMS" } {
		  return [format "%d %02d %04.1f" $d $m $s]
	      }
	      if { $m > 0 } {
		  return [format "%02d'%04.1f" $m $s]
	      }
	      return [format "%04.1f\"" $s]
	}
	DMM {
	      if { $degs < 0 } {
		  set degs [expr -$degs] ; set sign -1
	      } else { set sign 1 }
	      set d [expr int($degs)]
	      set degs [expr ($degs-$d)*60]
	      set d [expr $sign*$d]
	      if { $degs > 59.995 } { set degs 0 ; incr d }
	      return [format "%d %06.3f" $d $degs]
	}
	DDD {
	      return [format "%.5f" $degs]
	}
    }
}

proc ChangeCoordSign {pos} {

    if { "$pos" != "N" } { return W }
    return S
}

### distances and geographic bearings

proc ComputeDist {p1 p2 datum} {
    # distance between positions $p1 and $p2 with same datum
            # formulae kindly supplied by Luisa Bastos, Universidade do Porto
            #   and Gil Goncalves, Universidade de Coimbra

    set lad1 [lindex $p1 0] ; set lod1 [lindex $p1 1]
    set lad2 [lindex $p2 0] ; set lod2 [lindex $p2 1]
    if { $lad1==$lad2 && $lod1==$lod2 } { return 0 }
    set la1 [expr $lad1*0.01745329251994329576]
    set lo1 [expr $lod1*0.01745329251994329576]
    set la2 [expr $lad2*0.01745329251994329576]
    set lo2 [expr $lod2*0.01745329251994329576]
    return [expr 1e-3*[lindex [EllipsdData $datum] 0]* \
	         acos(cos($lo1-$lo2)*cos($la1)*cos($la2)+sin($la1)*sin($la2))]
}

proc ComputeDistBear {p1 p2 datum} {
    # distance between and bearing from positions $p1 and $p2 with same datum
            # formulae kindly supplied by Luisa Bastos, Universidade do Porto
            #   and Gil Goncalves, Universidade de Coimbra

    set lad1 [lindex $p1 0] ; set lod1 [lindex $p1 1]
    set lad2 [lindex $p2 0] ; set lod2 [lindex $p2 1]
    if { $lad1==$lad2 && $lod1==$lod2 } { return "0 0" }
    set la1 [expr $lad1*0.01745329251994329576]
    set lo1 [expr $lod1*0.01745329251994329576]
    set la2 [expr $lad2*0.01745329251994329576]
    set lo2 [expr $lod2*0.01745329251994329576]
    set dt [EllipsdData $datum]
    set a [lindex $dt 0] ; set f [lindex $dt 1]
           # distance
    set d [expr 1e-3*$a*acos(cos($lo1-$lo2)*cos($la1)*cos($la2)+ \
	                 sin($la1)*sin($la2))]
           # bearing
    set da [expr $la2-$la1] ; set do [expr $lo2-$lo1]
    if { [expr abs($da)] < 1e-20 } {
 	if { [expr abs($do)] < 1e-20 } {
 	    set b 0
 	} elseif { $do < 0 } {
 	    set b 270
 	} else { set b 90 }
    } elseif { [expr abs($do)] < 1e-20 } {
 	if { $da < 0 } {
 	    set b 180
 	} else { set b 0 }
    } else {
 	set b [expr round(atan(sin($do)/ \
 		               (tan($la2)*cos($la1)-sin($la1)*cos($do))) \
 			  *57.29577951308232087684)]
	if { $b < 0 } {
	    if { $do < 0 } { incr b 360 } else { incr b 180 }
	} elseif { $do < 0 } { incr b 180 }
    }
    return [list $d $b]
}

proc SetDatumData {datum} {
    # this proc sets datum parameters as global variables for repeated use
    #  in conversions; see procs ComputeDistFD, ComputeDistBearFD
    global DatumA DatumF FDDatum

    if { "$FDDatum" != "$datum" } {
	set dt [EllipsdData $datum]
	set DatumA [lindex $dt 0] ; set DatumF [lindex $dt 1]
	set FDDatum $datum
    }
    return
}

proc ComputeDistFD {p1 p2} {
    # compute distance between positions $p1 and $p2 assuming datum
    #  parameters where set by calling SetDatumData
    global DatumA
            # formulae kindly supplied by Luisa Bastos, Universidade do Porto
            #   and Gil Goncalves, Universidade de Coimbra

    set lad1 [lindex $p1 0] ; set lod1 [lindex $p1 1]
    set lad2 [lindex $p2 0] ; set lod2 [lindex $p2 1]
    if { $lad1==$lad2 && $lod1==$lod2 } { return 0 }
    set la1 [expr $lad1*0.01745329251994329576]
    set lo1 [expr $lod1*0.01745329251994329576]
    set la2 [expr $lad2*0.01745329251994329576]
    set lo2 [expr $lod2*0.01745329251994329576]
    return [expr 1e-3*$DatumA*acos(cos($lo1-$lo2)*cos($la1)*cos($la2)+ \
	                      sin($la1)*sin($la2))]
}

proc ComputeDistBearFD {p1 p2} {
    # compute distance between and bearing from positions $p1 and $p2
    #  assuming datum parameters where set by calling SetDatumData
    global DatumA DatumF
            # formulae kindly supplied by Luisa Bastos, Universidade do Porto
            #   and Gil Goncalves, Universidade de Coimbra

    set lad1 [lindex $p1 0] ; set lod1 [lindex $p1 1]
    set lad2 [lindex $p2 0] ; set lod2 [lindex $p2 1]
    if { $lad1==$lad2 && $lod1==$lod2 } { return "0 0" }
    set la1 [expr $lad1*0.01745329251994329576]
    set lo1 [expr $lod1*0.01745329251994329576]
    set la2 [expr $lad2*0.01745329251994329576]
    set lo2 [expr $lod2*0.01745329251994329576]
           # distance
    set d [expr 1e-3*$DatumA*acos(cos($lo1-$lo2)*cos($la1)*cos($la2)+ \
	                 sin($la1)*sin($la2))]
           # bearing
    set da [expr $la2-$la1] ; set do [expr $lo2-$lo1]
    if { [expr abs($da)] < 1e-20 } {
 	if { [expr abs($do)] < 1e-20 } {
 	    set b 0
 	} elseif { $do < 0 } {
 	    set b 270
 	} else { set b 90 }
    } elseif { [expr abs($do)] < 1e-20 } {
 	if { $da < 0 } {
 	    set b 180
 	} else { set b 0 }
    } else {
 	set b [expr round(atan(sin($do)/ \
 		               (tan($la2)*cos($la1)-sin($la1)*cos($do))) \
 			  *57.29577951308232087684)]
	if { $b < 0 } {
	    if { $do < 0 } { incr b 360 } else { incr b 180 }
	} elseif { $do < 0 } { incr b 180 }
    }
    return [list $d $b]
}

proc CompWPDistBear {wp1 wp2} {
    # distance between and bearing from WPs with names $wp1, $wp2
    global WPPFrmt WPPosn WPDatum

    set i1 [IndexNamed WP "$wp1"]
    set i2 [IndexNamed WP "$wp2"]
    if { $i1<0 || $i2<0 } { return "--- ---" }
    if { $i1 == $i2 } { return "0 0" }
    return [CompDistBearDatums $WPPosn($i1) $WPDatum($i1) \
	                          $WPPosn($i2) $WPDatum($i2)]
}

proc CompDistBearDatums {p1 d1 p2 d2} {
    # distance between and bearing from positions $p1 and $p2
    #  with datums $d1 and $d2
    if { "$d1" != "$d2" } {
	set p2 [ConvertDatum [lindex $p2 0] [lindex $p2 1] $d2 $d1 DDD]
    }
    return [ComputeDistBear $p1 $p2 $d1]
}

### area

proc ProjectedArea {wpixs} {
    # compute area of polygon whose boundary is the polyline formed by the
    #  WPs in given list
    # polygon cannot be self-intersecting (no test on this!)
    # return value in square km
    global WPPosn WPDatum ASKPROJPARAMS

    set ix [lindex $wpixs 0]
    set datum $WPDatum($ix) ; set p $WPPosn($ix)
    set ps [list [list [set lat [lindex $p 0]] [lindex $p 1] $datum]]
    foreach ix [lreplace $wpixs 0 0] {
	set dt $WPDatum($ix) ; set p $WPPosn($ix)
	if { "$dt" != "$datum" } {
	    set p [ConvertDatum [lindex $p 0] [lindex $p 1] $dt $datum DDD]
	}
	lappend ps [list [lindex $p 0] [lindex $p 1] $datum]
    }
    if { $lat>=-80 && $lat<=84 } {
	set proj TM
    } else {
	# in fact this will use UPS
	set proj UTM
    }
    set ask $ASKPROJPARAMS
    set ASKPROJPARAMS 0
    set xy [Proj${proj}Init AProj $datum $ps]
    set ASKPROJPARAMS $ask
    set xmin [set x0 [lindex $xy 0]] ; set ymin [set y0 [lindex $xy 1]]
    set xs "" ; set ys ""
    foreach p [lreplace $ps 0 0] {
	set xy [eval Proj${proj}Point AProj $p]
	set x [lindex $xy 0] ; set y [lindex $xy 1]
	lappend xs $x ; lappend ys $y
	if { $x < $xmin } { set xmin $x }
	if { $y < $ymin } { set ymin $y }
    }
    set sum 0
    set x0 [set x [expr $x0-$xmin]] ; set y0 [set y [expr $y0-$ymin]]
    foreach x1 $xs y1 $ys {
	set x1 [expr $x1-$xmin] ; set y1 [expr $y1-$ymin]
	set sum [expr $sum+$x*$y1-$x1*$y]
	set x $x1 ; set y $y1
    }
    set sum [expr $sum+$x*$y0-$x0*$y]
    return [expr abs(0.5e-6*$sum)]
}

proc SphericalArea {wpixs} {
    # compute area of polygon whose boundary is the polyline formed by the
    #  WPs in given list
    # computation is based on a spherical approximation
    # return negative value if there are precision errors
    #  otherwise value in square km
    global WPPosn WPDatum

    set ix [lindex $wpixs 0]
    set datum $WPDatum($ix) ; set p [set p0 $WPPosn($ix)]
    set phi0 [set phi [expr [lindex $p 0]*0.01745329251994329576]]
    set lam0 [set lam [expr [lindex $p 1]*0.01745329251994329576]]
    set c0 [expr cos($phi0)]
    # computation of mean radius of the ellipsoid at a point
    #  as described in Hrvoje Lukatela, "Ellipsoidal Area Computations of
    #  Large Terrestrial Objects", http://www.geodyssey.com/papers/ggelare.html
    set dt [EllipsdData $datum]
    set a [lindex $dt 0] ; set b [expr $a*(1-[lindex $dt 1])]
    set s [expr sin($phi)]
    set a2 [expr $a*$a]
    # radius in km
    set r [expr 1e-3*$a2*$b/($a2*$c0*$c0+$b*$b*$s*$s)]
    # computation of area adapted from sph_poly.c in
    #  "Graphics Gems IV", edited by Paul Heckbert, Academic Press, 1994.
    set srad 0
    SetDatumData $datum
    foreach ixn [lreplace $wpixs 0 0] {
	set pos $WPPosn($ixn)
	if { "$WPDatum($ixn)" != "$datum" } {
	    set pos [ConvertDatum [lindex $pos 0] [lindex $pos 1] \
		    $WPDatum($ixn) $datum DDD]
	}
	set phi1 [expr [lindex $pos 0]*0.01745329251994329576]
	set lam1 [expr [lindex $pos 1]*0.01745329251994329576]
	set c1 [expr cos($phi1)]
	if { $lam0 != $lam1 } {
	    set HavA [expr ((1-cos($phi1-$phi0))/2.0)+ \
		           ((1-cos($lam1-$lam0))/2.0)*$c0*$c1]
	    set A [expr 2*asin(sqrt($HavA))]
	    set B [expr 1.5707963267948966192313-$phi1]
	    set C [expr 1.5707963267948966192313-$phi0]
	    set S [expr 0.5*($A+$B+$C)]
            set T [expr tan($S/2.0)*tan(($S-$A)/2.0)* \
		    tan(($S-$B)/2.0)*tan(($S-$C)/2.0)]
	    if { abs($T) < 1e-8 } { return -1 }
	    set E [expr abs(4*atan(sqrt(abs($T))))]
	    if { $lam1 < $lam0 } { set E [expr -$E] }
	    set srad [expr $srad+$E]
	}
	set phi0 $phi1 ; set lam0 $lam1 ; set c0 $c1
    }
    set lam1 $lam
    if { $lam0 != $lam1 } {
	set phi1 $phi ; set c1 [expr cos($lam1)]
	set HavA [expr ((1-cos($phi1-$phi0))/2.0)+ \
		           ((1-cos($lam1-$lam0))/2.0)*$c0*$c1]
	set A [expr 2*asin(sqrt($HavA))]
	set B [expr 1.5707963267948966192313-$phi1]
	set C [expr 1.5707963267948966192313-$phi0]
	set S [expr 0.5*($A+$B+$C)]
	set T [expr tan($S/2.0)*tan(($S-$A)/2.0)* \
		    tan(($S-$B)/2.0)*tan(($S-$C)/2.0)]
	if { abs($T) < 1e-8 } { return -1 }
        set E [expr abs(4*atan(sqrt(abs($T))))]
	if { $lam1 < $lam0 } { set E [expr -$E] }
	set srad [expr $srad+$E]
    }
    return [expr abs($r*$r*$srad)]
}

### datums

proc ChangeTPsDatum {tps datum1 datum2} {
    # convert position of TR points on list $tps from $datum1 to $datum2
    # changes only on the first 4 elements (position) of each TP representation

    if { "$datum1" == "$datum2" } { return $tps }
    set l ""
    foreach tp $tps {
	set np [ConvertDatum [lindex $tp 0] [lindex $tp 1] \
		             $datum1 $datum2 DMS]
	set ntp [concat $np [lrange $tp 4 end]]
	lappend l $ntp
    }
    return $l
}

### dates

proc Today {dformt} {
    # build representation of current date under format $dformt

    set dt [clock format [clock seconds] -format "%Y %m %d %H %M %S"]
    scan $dt %d%0d%0d%0d%0d%0d y m d h mn s
    return [FormatDate $dformt $y $m $d $h $mn $s]
}

proc FormatDate {dformt y m d h mn s} {
    # build representation of date under format $dformt
    #  $dformt in {YYYYMMDD, MMDDYYYY, DDMMMYYYY}
    # result assumed elsewhere to be a list whose head is the information on
    #  year, month and day
    global MONTHNAMES

    set h [format "%02d:%02d:%02d" $h $mn $s]
    switch $dformt {
	YYYYMMDD { return [format "%4d.%02d.%02d %s" $y $m $d $h] }
	MMDDYYYY { return [format "%02d/%02d/%4d %s" $m $d $y $h] }
	DDMMMYYYY {
	    incr m -1 ; set m [lindex $MONTHNAMES $m]
	    return [format "%02d-%s-%4d %s" $d $m $y $h]
	}
    }
}

proc FormatTime {secs} {
    # build represention of seconds in hours:minutes:seconds format

    set s [expr $secs%60] ; set x [expr ($secs-$s)/60]
    set mn [expr $x%60] ; set h [expr ($x-$mn)/60]
    if { $h > 0 } { return [format "%2d:%02d:%02d" $h $mn $s] }
    if { $mn > 0 } { return [format "%5d:%02d" $mn $s] }
    return [format "%8d" $s]
}

proc NowTZ {} {
    # current date under default format with time zone appended
    global DateFormat
    
    return "[Today $DateFormat] ([clock format 0 -format %Z])"
}

proc Now {} {
    # current date under default format
    global DateFormat
    
    return [Today $DateFormat]
}

set DAYSOF(1) 31 ; set DAYSOF(2) 28 ; set DAYSOF(3) 31 ; set DAYSOF(4) 30
set DAYSOF(5) 31 ; set DAYSOF(6) 30 ; set DAYSOF(7) 31 ; set DAYSOF(8) 31
set DAYSOF(9) 30 ; set DAYSOF(10) 31 ; set DAYSOF(11) 30 ; set DAYSOF(12) 31

proc DateToSecs {y m d h mn s} {
    # convert date to seconds ellapsed since beginning of $YEAR0 (a leap year)
    global DAYSOF YEAR0

    set days [expr 365*($y-$YEAR0)+$d-1]
    set yy $YEAR0
    while { $yy < $y } {
	if { $yy%100!=0 || $yy%400==0 } { incr days }
	incr yy 4
    }
    if { $m>2 && $y%4==0 && ($yy%100!=0 || $yy%400==0) } { incr days }
    incr m -1
    while { $m > 0 } { incr days $DAYSOF($m) ; incr m -1 }
    return [expr $days*86400+$h*3600+$mn*60+$s]
}

proc DateFromSecs {secs} {
    # build date from seconds ellapsed since beginning of $YEAR0 (a leap year)
    #  using default format
    global DateFormat

    return [DateFromSecsFmt $secs $DateFormat]
}

proc DateFromSecsFmt {secs fmt} {
    # build date from seconds ellapsed since beginning of $YEAR0 (a leap year)
    #  using given format
    global DAYSOF YEAR0

    set s [expr $secs%60] ; set x [expr ($secs-$s)/60]
    set mn [expr $x%60] ; set x [expr ($x-$mn)/60]
    set h [expr $x%24] ; set x [expr ($x-$h)/24]
    set y [expr int($x/365)] ; set yd [expr $y*365]
    set yy $YEAR0 ; incr y $yy
    while { $yy < $y } {
	if { $yy%100!=0 || $yy%400==0 } { incr yd }
	incr yy 4
    }
    if { $yd > $x } {
	incr y -1
	if { $y%4==0 && ($y%100!=0 || $y%400==0) } { incr yd -1 }
	incr yd -365
    }
    incr x [expr 1-$yd] ; set m 1
    while { $x > $DAYSOF($m) } {
	if { $m==2 && $y%4==0 && ($y%100!=0 || $y%400==0) } {
	    if { $x == 29 } { break }
	    incr x -1
	}
	incr x -$DAYSOF($m) ; incr m
    }
    return [FormatDate $fmt $y $m $x $h $mn $s]
}

proc Month {name} {
    # from month name to 0 (error) or 1..12
    global ALLMONTH

    for {set m 1} { $m<13 } { incr m } {
	if { [lsearch -exact $ALLMONTH($m) $name] != -1 } { return $m }
    }
    return 0
}

proc UTCToLocalTime {y m d h mn s} {
    # convert from UTC to local time
    # return list with same elements as in the args
    global TimeOffset DAYSOF

    incr h $TimeOffset
    if { $h < 0 } {
	incr h 24
	if { [incr d -1] == 0 } {
	    if { [incr m -1] == 0 } {
		set m 12 ; set d 31 ; incr y -1
	    } else {
		if { $m == 2 && $y%4 == 0 && \
			($y%100 != 0 || $y%400 == 0) } {
		    set d 29
		} else {
		    set d $DAYSOF($m)
		}
	    }
	}
    } elseif { $h > 24 } {
	incr h -24
	if { [incr d] > $DAYSOF($m) } {
	    if { $m == 2 } {
		if { $y%4 != 0 || ($y%100 == 0 && $y%400 != 0) } {
		    set m 3 ; set d 1
		}
	    } elseif { $m == 12 } {
		set m 1 ; set d 1 ; incr y
	    } else {
		incr m ; set d 1
	    }
	}
    }
    return [list $y $m $d $h $mn $s]
}

proc CompatibleDates {y0 m0 d0 secs1} {
    # check whether two dates are compatible
    #  $y0, $m0, $d0 give one date (year, month name and day) and may
    #  be * (to match anything)
    #  $secs1 is the other date in seconds since $YEAR0
    # return 1 if compatible

    set dt1 [lindex [DateFromSecsFmt $secs1 DDMMMYYYY] 0]
    if { "$d0" != "*" && $d0<10 } { set d0 0$d0 }
    if { [string match $d0-$m0-$y0 $dt1] } { return 1 }
    return 0
}
