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

#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de
#
#    This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 3 of the License, or
#      (at your option) any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program.
#
#  File: trtort.tcl
#  Last change:  6 October 2013
#
# Includes contributions by Brian Baulch (baulchb _AT_ onthenet.com.au)
#  marked "BSB contribution"
#

## map tags used, with $w a window path, $n a natural number:
#    lines in converted RT/TR: exp=$w expconv=$w line
#    turnpoints in converted RT/TR: exp=$w expconv=$w sq2 lab=$n.$n
#    TR elements: exp=$w expTR=$w (in addition to normal tags)
###
## the array TRCv is used for keeping conversion information
#    indices have the form $id,$el with $id an identifier for the operation
#    (normally a window path) and $el one of: npoints, npsold, linedispl,
#    TRdispl, line, TPs, sgsts, datum, notps, mouseonscale
###
## the term "line segment" used below has nothing to do with TR segments
#    which are only used here when displaying the TR; their start indices
#    are kept in $TRCv($w,sgsts)
###

proc GMTRtoLine {wh window} {
    # create dialog to control conversion from track to RT, TR or LN
    #  $wh in {RT, TR, LN}
    #  $window is the track edit/show window
    global DPOSX DPOSY COLOUR GMEd TRTPoints TRSegStarts TRDatum TRDispl TXT \
	    MESS Map EdWindow MAPSCLENGTH TRCv

    set w ${window}.trtort
    if { [winfo exists $w] } { Raise $w ; bell ; return }

    if { $window == $EdWindow(TR) } {
	if { [set TRCv($w,TPs) $GMEd(TR,TPs)] == "" } {
	    GMMessage $MESS(voidTR)
	    return
	}
	set TRCv($w,sgsts) $GMEd(TR,SgSts)
	set mapped [lindex $GMEd(TR,Data) end]
	set TRCv($w,datum) $GMEd(TR,Datum)
    } else {
	set ixt [IndexNamed TR [$window.fr.fr1.id get]]
	set TRCv($w,TPs) $TRTPoints($ixt) ; set TRCv($w,datum) $TRDatum($ixt)
	set TRCv($w,sgsts) $TRSegStarts($ixt)
	set mapped $TRDispl($ixt)
    }
    set trname [string trim [$window.fr.fr1.id get]]
    if { $trname == "" } {
	set trname $TXT(unnamed)
    }
    set ntps [set TRCv($w,notps) [llength $TRCv($w,TPs)]]
    set TRCv($w,npoints) 2 ; set TRCv($w,npsold) 1
    set TRCv($w,line) [TRCvSimpl $w $TRCv($w,npoints)]
    set TRCv($w,linedispl) 0 ; set TRCv($w,TRdispl) $mapped
    set TRCv($w,mouseonscale) 0

    GMToplevel $w TRto$wh +[expr $DPOSX+100]+[expr $DPOSY+100] {} \
        [list WM_DELETE_WINDOW "TRCvCancel $w"] {}

    frame $w.fr -borderwidth 5 -bg $COLOUR(dialbg)
    label $w.fr.from -text [format $TXT(fromTR) $trname]
    frame $w.fr.sep -height 6 -bg $COLOUR(dialbg)
    label $w.fr.npts -text $TXT(TRRTnpoints)
    scale $w.fr.npscl -orient horizontal -from 2 -to $ntps -width 5 \
	    -length $MAPSCLENGTH -resolution 1 -showvalue 1 \
	    -variable TRCv($w,npoints)
    $w.fr.npscl set 2
    bind $w.fr.npscl <Leave> "TRCvNumberChange $w"
    bind $w.fr.npscl <Button-1> "set TRCv($w,mouseonscale) 1"
    bind $w.fr.npscl <ButtonRelease-1> "set TRCv($w,mouseonscale) 0"

    frame $w.fr.act
    checkbutton $w.fr.act.drt -text $TXT(TRlinedispl) -onvalue 1 -offvalue 0 \
	    -variable TRCv($w,linedispl) -command "TRCvDisplLine $w" \
	    -selectcolor $COLOUR(check)
    checkbutton $w.fr.act.dtr -text $TXT(TRTRdispl) -onvalue 1 -offvalue 0 \
	    -variable TRCv($w,TRdispl) -command "TRCvDisplTR $w" \
	    -selectcolor $COLOUR(check)
    # if TR is mapped do not allow it to be unmapped
    if { $mapped } { $w.fr.act.dtr configure -state disabled }

    frame $w.fr.bts
    button $w.fr.bts.ok -text $TXT(ok) -command "TRCvCommit$wh $w"
    button $w.fr.bts.cnc -text $TXT(cancel) -command "TRCvCancel $w"

    pack $w.fr.from $w.fr.sep $w.fr.npts $w.fr.npscl -side top
    pack $w.fr.act.drt $w.fr.act.dtr -side left -padx 3
    pack $w.fr.bts.ok $w.fr.bts.cnc -side left -padx 3
    pack $w.fr.act $w.fr.bts -side top -pady 5
    pack $w.fr
    return
}

proc TRCvNumberChange {w} {
    global TRCv TXT

    if { $TRCv($w,mouseonscale) \
	    || $TRCv($w,npoints) == $TRCv($w,npsold) } { return }
    set sid [SlowOpWindow $TXT(comp)]
    set TRCv($w,npsold) $TRCv($w,npoints)
    if { [set l [TRCvSimpl $w $TRCv($w,npoints)]] != 0 } {
	set TRCv($w,line) $l
	TRCvDisplLine $w
    } else {
	set TRCv($w,npoints) $TRCv($w,npsold)
    }
    SlowOpFinish $sid ""
    return
}

proc TRCvCommitRT {w} {
    # define WPs from points in conversion result and create RT
    # open RT edit window or create RT if RT edit window already exists
    global TRCv EdWindow PositionFormat CREATIONDATE GRName DEFAULTSYMBOL \
	    DEFAULTDISPOPT TXT MESS MYGPS

    set sid [SlowOpWindow $TXT(create)]
    set datum $TRCv($w,datum)
    # BSB contribution: empty date if Lowrance receiver
    if { $CREATIONDATE && $MYGPS != "Lowrance" } {
	set date [Now]
    } else { set date "" }
    set wps "" ; set n 0
    foreach p $TRCv($w,line) {
	if { [SlowOpAborted] } {
	    SlowOpFinish $sid ""
	    return
	}
	set id [format "ZT%04d" $n]
	while { [IndexNamed WP $id] != -1 } {
	    incr n ; set id [format "ZT%04d" $n]
	}
	incr n
	foreach "posn pfmt pfdatum" \
	    [FormatPosition [lindex $p 0] [lindex $p 1] $datum \
		 $PositionFormat "" DDD] {
		break
	}
	set data [FormData WP "Name PFrmt Posn Datum Date Alt" \
		     [list $id $pfmt $posn $pfdatum $date [lindex $p 6]]]
	set ix [CreateItem WP $data]
	lappend wps $id
    }
    SlowOpFinish $sid ""
    CreateGRFor =TR-RT $TXT(obsTRToRT) [list [list WP $wps]]
    TRCvCancel $w
    if { [winfo exists $EdWindow(RT)] } {
	set name [NewName RT]
	set data [FormData RT "IdNumber WPoints Displ" [list $name $wps 0]]
	CreateItem RT $data
	GMMessage [format $MESS(convres) $TXT(RT) $name]
    } else {
	GMRoute -1 {create revert cancel} \
	    [FormData RT "WPoints Displ" [list $wps 0]]
    }
    return
}

proc TRCvCommitTR {w} {
    # create TR from simplification result
    # if TR edit window does not exist open it, otherwise add TR to
    #  data-base
    # "positions" are assumed here to have lat/long in degrees followed
    #   by lat/long in DMS as in TPs
    global TRCv EdWindow TXT MESS

    set obs $TXT(obsTRsimpl)
    if { [winfo exists $EdWindow(TR)] } {
	set name [NewName TR]
	set data [FormData TR "Name Obs Datum TPoints" \
		[list $name $obs $TRCv($w,datum) $TRCv($w,line)]]
	CreateItem TR $data
	GMMessage [format $MESS(convres) $TXT(TR) $name]
    } else {
	GMTrack -1 {create revert cancel} [FormData TR "Obs Datum TPoints" \
		[list $obs $TRCv($w,datum) $TRCv($w,line)]]
    }
    TRCvCancel $w
    return
}

proc TRCvCommitLN {w} {
    # create LN from simplification result
    # if LN edit window does not exist open it, otherwise add LN to
    #  data-base
    # "positions" are assumed here to be representations of TPs with
    #  lat/long in degrees, lat/long in DMS and altitude at index 6
    # segments are kept only if the number of points was not changed
    global TRCv EdWindow TXT MESS

    set lps ""
    foreach tp $TRCv($w,line) {
	lappend lps [list [lrange $tp 0 3] [lindex $tp 6]]
    }
    if { $TRCv($w,notps) == $TRCv($w,npoints) } {
	set sgsts $TRCv($w,sgsts)
    } else { set sgsts "" }
    if { [winfo exists $EdWindow(LN)] } {
	set name [NewName LN]
	set data [FormData LN "Name Datum PFrmt LPoints SegStarts" \
		[list $name $TRCv($w,datum) DMS $lps $sgsts]]
	CreateItem LN $data
	GMMessage [format $MESS(convres) $TXT(LN) $name]
    } else {
	GMLine -1 {create revert cancel} \
	    [FormData LN "Datum PFrmt LPoints SegStarts" \
		 [list $TRCv($w,datum) DMS $lps $sgsts]]
    }
    TRCvCancel $w
    return
}

proc TRCvCancel {w} {
    # finish off conversion from TR on window $w
    global TRCv Map

    if { $TRCv($w,linedispl) || $TRCv($w,TRdispl) } {
	$Map delete exp=$w
	SetMapBounds
    }
    destroy $w
    TRCvCleanMemory $w
    return
}

proc TRCvCleanMemory {w} {
    # free memory used by conversion $w
    global TRCv

    foreach e "npoints npsold linedispl TRdispl line TPs sgsts datum notps \
	    mouseonscale" {
	catch {unset TRCv($w,$e)}
    }
    return
}

proc TRCvDisplLine {w} {
    global Map TRCv TXT

    $Map delete expconv=$w
    if { $TRCv($w,linedispl) } {
	set sid [SlowOpWindow $TXT(displ)]
	set tgspt [list exp=$w expconv=$w sq2]
	set tgsln [list exp=$w expconv=$w line]
	set ps $TRCv($w,line) ; set datum $TRCv($w,datum)
	set p1 [lindex $ps 0]
	set pp1 [MapFromPosn [lindex $p1 0] [lindex $p1 1] $datum]
	set x [lindex $pp1 0] ; set y [lindex $pp1 1]
	$Map create oval [expr $x-1] [expr $y-1] \
		[expr $x+1] [expr $y+1] -fill black -outline black \
		-tags [concat lab=$w.0 $tgspt]
	set i 1
	foreach p2 [lrange $ps 1 end] {
	    if { [SlowOpAborted] } {
		$Map delete expconv=$w
		set TRCv($w,linedispl) 0
		break
	    }
	    set pp2 [MapFromPosn [lindex $p2 0] [lindex $p2 1] $datum]
	    set x2 [lindex $pp2 0] ; set y2 [lindex $pp2 1]
	    $Map create oval [expr $x2-1] [expr $y2-1] \
		[expr $x2+1] [expr $y2+1] -fill black -outline black \
		-tags [concat lab=$w.$i $tgspt]
	    $Map create line $x $y $x2 $y2 -arrow last -smooth 0 \
		    -fill black -width 2 -tags $tgsln
	    set x $x2 ; set y $y2
	    incr i
	}
	SlowOpFinish $sid ""
    }
    SetMapBounds
    return
}

proc TRCvDisplTR {w} {
    # map/unmap TR during this conversion
    # TR was not mapped when the conversion started
    global Map TRCv GMEd

    if { $TRCv($w,TRdispl) } {
	SetCursor $w watch
	PutMapTREls $GMEd(TR,Index) $TRCv($w,TPs) $TRCv($w,sgsts) \
		$TRCv($w,datum) [list exp=$w expTR=$w]
	ResetCursor $w
    } else {
	$Map delete expTR=$w
    }
    SetMapBounds
    return
}

### TR conversion for internal use

proc TRCvTR {tps n datum id} {
    # convert list of TPs or LPs to list of at most $n>=2 positions under
    #  given datum
    # "position" means list starting with lat long in degrees
    #   but see also procs TRCvCommitTR and TRCvCommitLN
    #  $id is identifier of operation
    global TRCv

    if { [set notps [llength $tps]] <= $n } { return $tps }
    SetCursor . watch
    set TRCv($id,TPs) $tps ; set TRCv($id,notps) $notps
    set TRCv($id,datum) $datum
    set ps [TRCvSimpl $id $n]
    TRCvCleanMemory $id
    ResetCursor .
    return $ps
}

### line simplification algorithm

proc TRCvSimpl {w n} {
    # using information indexed by $w, convert list of "positions" in
    #  given datum to list of $n>=2 "positions"
    # "position" means list starting with lat long in degrees
    # the following data is used:
    #  $TRCv($w,TPs) is list of positions
    #  $TRCv($w,notps) is number of positions
    #  $TRCv($w,datum) is datum
    # procs SetDatumData and ComputeDistBearFD are called (indirectly)
    # return 0 if operation was aborted
    global TRCv

    set ps $TRCv($w,TPs)
    if { $n == $TRCv($w,notps) } { return $ps }
    if { $n<3 || [llength $ps]<3 } {
	return [list [lindex $ps 0] [lindex $ps end]]
    }
    SetDatumData $TRCv($w,datum)
    if { [set ss [TRCvSimplSegms [SplitPositions $ps] [expr $n-1]]] == 0 } {
	return 0
    }
    set r [list [lindex [lindex [lindex $ss 0] 2] 0]]
    foreach s $ss {
	lappend r [lindex [lindex $s 2] end]
    }
    return $r
}

proc TRCvSimplSegms {ss n} {
    # breaks a line segment into $n>=2 segments
    # a segment is a list of:
    #     maximum distance from a point to line between 1st and last points
    #     index of a point at that distance
    #     "positions" of points
    # return 0 if operation was aborted

    while { $n > 2 } {
	if { [SlowOpAborted] } { return 0 }
	set mx 0 ; set im 0 ; set i 0
	foreach s $ss {
	    if { [set d [lindex $s 0]] > $mx } {
		set mx $d ; set im $i
	    }
	    incr i
	}
	if { $mx == 0 } { return $ss }
	set s [lindex $ss $im]
	set is [lindex $s 1] ; set ps [lindex $s 2]
	set ss [concat [lrange $ss 0 [expr $im-1]] \
		       [SplitPositionsAt $is $ps] \
		       [lrange $ss [expr $im+1] end]]
	incr n -1
    }
    return $ss
}

proc SplitPositions {ps} {
    # split "positions" into two segments at maximum distance to line between
    #  end points

    set dfp [FurthestPoint $ps]
    set im [lindex $dfp 1]
    return [SplitPositionsAt $im $ps]
}

proc SplitPositionsAt {im ps} {
    # split "positions" into two segments at given index $im

    set ps1 [lrange $ps 0 $im] ; set ps2 [lrange $ps $im end]
    return [list [linsert [FurthestPoint $ps1] end $ps1] \
	         [linsert [FurthestPoint $ps2] end $ps2]]
}

proc FurthestPoint {ps} {
    # find a point that is furthest from the line between 1st and last points
    # return list with maximum distance and index of point

    if { [set l [llength $ps]] < 3 } { return [list 0 0] }
    set mx 0 ; set i 1
    set pt0 [lindex $ps 0] ; set ptn [lindex $ps end]
    foreach pt [lrange $ps 1 [expr $l-2]] {
	set d [DistToLineFD $pt $pt0 $ptn]
	if { $d >= $mx } {
	    set im $i ; set mx $d
	}
	incr i
    }
    if { $mx == 0 } { set im [expr $l/2] }
    return [list $mx $im]
}

proc DistToLineFD {p p1 p2} {
    # find distance from point $p to line between $p1 and $p2
    #  $p, $p1 and $p2 are "positions"

    set db [ComputeDistBearFD $p1 $p]
    set a [expr [lindex [ComputeDistBearFD $p1 $p2] 1]-[lindex $db 1]]
    return [expr abs(sin($a*0.01745329251994329576)*[lindex $db 0])]
}

###### average WP from TR

proc GMTRtoWP {window} {
    # make average WP of all TPs in $window
    global GMEd TRTPoints TRDatum EdWindow MESS CREATIONDATE PositionFormat

    if { [winfo exists $EdWindow(WP)] } { Raise $EdWindow(WP) ; bell ; return }

    if { $window == $EdWindow(TR) } {
	if { [set tps $GMEd(TR,TPs)] == "" } {
	    GMMessage $MESS(voidTR)
	    return
	}
	set datum $GMEd(TR,Datum)
    } else {
	set ixt [IndexNamed TR [$window.fr.fr1.id get]]
	set tps $TRTPoints($ixt) ; set datum $TRDatum($ixt)
    }
    set sla 0 ; set slo 0 ; set sal 0 ; set noalt 1 ; set n 0
    foreach tp $tps {
	set sla [expr $sla+[lindex $tp 0]] ; set slo [expr $slo+[lindex $tp 1]]
	if { [regexp {[0-9\.]+} [set a [lindex $tp 6]]] } {
	    set sal [expr $sal+$a]
	    set noalt 0
	}
	incr n
    }
    if { $noalt } {
	set sal ""
    } else { set sal [format %.1f [expr 1.0*$sal/$n]] }
    foreach "p pfmt pfdatum" \
	[FormatPosition [expr 1.0*$sla/$n] [expr 1.0*$slo/$n] $datum \
	     $PositionFormat "" DDD] {
	break
    }
    set opts {create revert cancel}
    if { $CREATIONDATE } {
	GMWPoint -1 $opts [FormData WP "PFrmt Posn Datum Alt Date" \
		[list $pfmt $p $pfdatum $sal [Now]]]
    } else {
	GMWPoint -1 $opts [FormData WP "PFrmt Posn Datum Alt Commt" \
		[list $pfmt $p $pfdatum $sal [DateCommt [Now]]]]
    }
    return
}

proc GMGRtoWP {window} {
    # make average WP of all WPs in GR shown in $window
    global MESS EdWindow WPPosn WPDatum WPAlt CREATIONDATE PositionFormat

    if { [winfo exists $EdWindow(WP)] } { Raise $EdWindow(WP) ; bell ; return }

    switch [set ixs [GMGRCollectWPs $window]] {
	void {
	    GMMessage $MESS(voidGR) ; return
	}
	error {
	    return
	}
    }
    if { $ixs == "" } { bell ; return }
    set sla 0 ; set slo 0 ; set sal 0 ; set noalt 1 ; set n 0
    set datum ""
    foreach ix $ixs {
	set p $WPPosn($ix)
	if { $datum == "" } {
	    set datum $WPDatum($ix)
	} elseif { $WPDatum($ix) != $datum } {
	    set p [ToDatum [lindex $p 0] [lindex $p 1] $WPDatum($ix) $datum]
	}
	set sla [expr $sla+[lindex $p 0]] ; set slo [expr $slo+[lindex $p 1]]
	if { [regexp {[0-9\.]+} [set a $WPAlt($ix)]] } {
	    set sal [expr $sal+$a]
	    set noalt 0
	}
	incr n
    }
    if { $noalt } {
	set sal ""
    } else { set sal [format %.1f [expr 1.0*$sal/$n]] }
    foreach "p pfmt pfdatum" \
	[FormatPosition [expr 1.0*$sla/$n] [expr 1.0*$slo/$n] $datum \
	     $PositionFormat "" DDD] {
	break
    }
    set opts {create revert cancel}
    if { $CREATIONDATE } {
	GMWPoint -1 $opts [FormData WP "PFrmt Posn Datum Alt Date" \
		[list $pfmt $p $pfdatum $sal [Now]]]
    } else {
	GMWPoint -1 $opts [FormData WP "PFrmt Posn Datum Alt Commt" \
		[list $pfmt $p $pfdatum $sal [DateCommt [Now]]]]
    }
    return
}