gpsman 6.4.3-1 / usr / lib / gpsman / mapanim.tcl

#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2011 Miguel Filgueiras migf@portugalmail.pt
#
#    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: mapanim.tcl
#  Last change:  19 July 2011
#

proc InitAnimation {type title args} {
    # create dialog window to control animation
    #  $type is in {TR, RealTimeLog}
    #  $title to display in dialog window
    #  $args will be passed to proc AnimStart
    # the Anim global array is used with the following indices:
    #  number   a unique number for each animation
    #    the value -1 is used for RealTimeLog
    #  for animation number $no
    #   jobs,$no    a list of background jobs
    #   state,$no   in {init, on, pause, abort}
    #   state,$no,ext   the corresponding external representation
    #   speed,$no   the speed factor -50..50
    #     for real time log, this sets RealTimeLogIntv in 1..101 seconds
    #   look,$no    1 if last point should be kept centred on the map
    #   elapsed,$no     number of seconds elapsed, or -1
    #   elapsed,$no,ext  corresponding external representation
    #   data,$no    a pair with list of TPs remaining to be shown
    #     and the datum ($type==TR)
    #   time,$no    external representation of time stamp (no date) of
    #     TP ($type==TR)
    #   dist,$no    total distance up to next TP in user units ($type==TR)
    #   dist,$no,ext  corresponding external representation but up to
    #     current TP
    global Anim RealTimeLogIntv COLOUR EPOSX EPOSY TXT DTUNIT

    switch -- $type {
	TR {
	    set no $Anim(number) ; incr Anim(number)
	    set rtl 0
	    set Anim(speed,$no) 0
	    set Anim(time,$no) "" ; set Anim(dist,$no) 0
	    set Anim(dist,$no,ext) "[format "%8.2f" 0] $DTUNIT"
	}
	RealTimeLog {
	    set no -1 ; set rtl 1
	    # this is to avoid the trace resetting RealTimeLogIntv to some
	    #  unkown value when the scale is declared
	    set Anim(speed,$no) [expr $RealTimeLogIntv-51]
	}
	default {
	    BUG calling proc InitAnimation with bad type
	}
    }

    # this name is used explicitly elsewhere
    set w .anim$no
    GMToplevel $w animation +$EPOSX+$EPOSY {} \
        [list WM_DELETE_WINDOW \
	     "set Anim(state,$no) abort ; destroy $w ; AnimAbort $no"] {}

    trace variable Anim(state,$no) w AnimStateChange
    trace variable Anim(speed,$no) w AnimSpeedChange

    set Anim(jobs,$no) "" ; set Anim(data,$no) ""
    set Anim(state,$no) init ; set Anim(state,$no,ext) $TXT(animinit)
    set Anim(look,$no) 1
    set Anim(elapsed,$no) 0 ; set Anim(elapsed,$no,ext) ""

    frame $w.fr -borderwidth 5 -bg $COLOUR(selbg)
    label $w.fr.tit -text $title

    frame $w.fr.frs
    label $w.fr.frs.sl -text $TXT(slow) -width 6
    scale $w.fr.frs.sp -orient horizontal -from -50 -to 50  -showvalue 0 \
	    -width 8 -length 200 -variable Anim(speed,$no) -label xxx
    label $w.fr.frs.fst -text $TXT(fast) -width 6
    # must be here!
    if { $rtl } {
	set Anim(speed,$no) [expr $RealTimeLogIntv-51]
	set cs 2 ; set cf 0
    } else {
	set Anim(speed,$no) 0
	set cs 0 ; set cf 2
    }
    grid configure $w.fr.frs.sl -column $cs -row 0 -sticky news
    grid configure $w.fr.frs.sp -column 1 -row 0 -sticky news
    grid configure $w.fr.frs.fst -column $cf -row 0 -sticky news

    checkbutton $w.fr.look -text $TXT(centred) -variable Anim(look,$no) \
	    -onvalue 1 -offvalue 0 -selectcolor $COLOUR(check)
    
    frame $w.fr.frst
    label $w.fr.frst.tit -text $TXT(state):
    label $w.fr.frst.st -width 10 -textvariable Anim(state,$no,ext)
    label $w.fr.frst.tm -width 15 -textvariable Anim(elapsed,$no,ext)

    frame $w.fr.frb
    button $w.fr.frb.go -text $TXT(start) \
	    -command "AnimStart $no $type $args ; \
	              $w.fr.frb.go configure -state normal"
    if { ! $rtl } {
	button $w.fr.frb.skp -text $TXT(nextTP) \
	    -command "AnimSkipTR $no $args ; \
                      $w.fr.frb.skp configure -state normal"

	label $w.fr.frst.tstit -text $TXT(TRVhour)
	label $w.fr.frst.tsp -width 10 -textvariable Anim(time,$no)
	label $w.fr.frst.dstit -text $TXT(distance)
	label $w.fr.frst.dst -width 10 -textvariable Anim(dist,$no,ext)	
    }
    button $w.fr.frb.hld -text $TXT(pause) \
	    -command "AnimPause $no ; $w.fr.frb.hld configure -state normal"
    button $w.fr.frb.abort -text $TXT(abort) \
	    -command "set Anim(state,$no) abort ; destroy $w ; AnimAbort $no"

    if { $rtl } {
	pack $w.fr.frst.tit $w.fr.frst.st $w.fr.frst.tm -side left
	pack $w.fr.frb.go $w.fr.frb.hld $w.fr.frb.abort -side left
    } else {
	grid $w.fr.frst.tit -row 0 -column 0 -sticky w
	grid $w.fr.frst.st -row 0 -column 1 -sticky ew
	grid $w.fr.frst.tm -row 0 -column 2 -sticky ew
	grid $w.fr.frst.tstit -row 1 -column 0 -sticky w -pady 3
	grid $w.fr.frst.tsp -row 1 -column 1 -columnspan 2 -sticky ew -pady 3
	grid $w.fr.frst.dstit -row 2 -column 0 -sticky w
	grid $w.fr.frst.dst -row 2 -column 1 -columnspan 2 -sticky ew

	pack $w.fr.frb.go $w.fr.frb.skp $w.fr.frb.hld $w.fr.frb.abort \
		-side left
    }
    pack $w.fr.tit $w.fr.frs $w.fr.look $w.fr.frst $w.fr.frb -side top -pady 5
    pack $w.fr
    update
    RaiseWindow $w
    return
}

proc AnimPause {no} {
    # pause animation number $no
    global Anim TXT RealTimeLogAnim

    switch $Anim(state,$no) {
	on { set Anim(state,$no) pause }
	pause {
	    if { $no == -1 && ! $RealTimeLogAnim } {
		bell
	    } else {
		set Anim(state,$no) on
	    }
	}
	default { bell }
    }
    return
}

proc AnimAbort {no} {
    # abort animation $no
    global Anim RealTimeLogAnim Map

    if { $no == -1 } { set RealTimeLogAnim 0 }
    foreach j $Anim(jobs,$no) { after cancel $j }
    trace vdelete Anim(state,$no) w AnimStateChange
    trace vdelete Anim(speed,$no) w AnimSpeedChange
    foreach ix "jobs speed look state elapsed data time dist" {
	catch {unset Anim($ix,$no)}
    }
    foreach ix "state elapsed dist" {
	catch {unset Anim($ix,$no,ext)}
    }
    $Map delete an=$no
    SetMapBounds
    return
}

proc AnimStart {no type args} {
    # start animation number $no
    #  $args is
    #   $type==TR: list of TPs (under TRTPoints format), and datum
    #   $type==RealTimeLog: date of first point in seconds
    global Anim Map RealTimeLogAnim DTUNIT

    switch $Anim(state,$no) {
	abort { return }
	pause {
	    if { $type == "RealTimeLog" && ! $RealTimeLogAnim } {
		bell
	    } else {
		set Anim(state,$no) on
	    }
	    return
	}
	on { bell ; return }
    }
    set Anim(elapsed,$no,ext) ""
    $Map delete an=$no
    SetMapBounds
    switch $type {
	TR {
	    set Anim(elapsed,$no) 0
	    set Anim(data,$no) $args
	    set Anim(jobs,$no) [after 0 [list AnimNextTR $no]]
	    set Anim(time,$no) "" ; set Anim(dist,$no) 0
	    set Anim(dist,$no,ext) "[format "%8.2f" 0] $DTUNIT"
	}
	RealTimeLog {
	    set Anim(elapsed,$no) $args
	}
    }
    set Anim(state,$no) on
    return
}

proc AnimNextRealTime {pos datum secs} {
    # show next point of real time track log
    #  $pos is list with latd, longd for $datum, at time $secs
    # must start animation if none is going on
    global Anim RealTimeLogAnim TXT

    if { ([catch {set Anim(state,-1)}] || $Anim(state,-1) == "abort") && \
	    ! [winfo exists .anim-1] } {
	InitAnimation RealTimeLog $TXT(realtimelog)
	AnimStart -1 RealTimeLog $secs
	return
    }
    switch $Anim(state,-1) {
	abort {
	    set RealTimeLogAnim 0
	    return
	}
	pause {
	    return
	}
    }
    set p [MapFromPosn [lindex $pos 0] [lindex $pos 1] $datum]
    PutMapAnimPoint $p -1 $Anim(look,-1)
    if { $Anim(elapsed,-1) == -1 } {
	set Anim(elapsed,-1,ext) ""
    } else {
	set t [expr $secs-$Anim(elapsed,-1)]
	set Anim(elapsed,-1,ext) "    [FormatTime $t]"
    }
    return
}

proc AnimStopRealTime {} {
    # real-time log has been stopped
    global Anim

    set Anim(state,-1) pause
    return
}

proc AnimNextTR {no} {
    # show next leg of track
    global Anim UNDEFDATESECS DTUNIT DSCALE

    switch $Anim(state,$no) {
	abort {
	    return
	}
	pause {
	    set Anim(jobs,$no) [after 500 [list AnimNextTR $no]]
	    return
	}
    }
    set Anim(jobs,$no) ""
    set tps [lindex $Anim(data,$no) 0] ; set datum [lindex $Anim(data,$no) 1]
    set tp0 [lindex $tps 0]
    set p [MapFromPosn [lindex $tp0 0] [lindex $tp0 1] $datum]
    PutMapAnimPoint $p $no $Anim(look,$no)

    if { $Anim(elapsed,$no) == -1 } {
	set Anim(elapsed,$no,ext) ""
    } else { set Anim(elapsed,$no,ext) "    [FormatTime $Anim(elapsed,$no)]" }

    set Anim(dist,$no,ext) "[format "%8.2f" $Anim(dist,$no)] $DTUNIT"
    if { [set tp1 [lindex $tps 1]] != "" } {
	set Anim(dist,$no) \
	    [expr $Anim(dist,$no)+[ComputeDist $tp0 $tp1 $datum]*$DSCALE]
	if { abs([set tm0 [lindex $tp0 5]] - $UNDEFDATESECS) > 1 } {
	    set Anim(time,$no) [lindex [DateFromSecsFmt $tm0 YYYYMMDD] 1]
	} else { set Anim(time,$no) "" }
	if { $Anim(time,$no) == "" || \
		 abs([set tm1 [lindex $tp1 5]] - $UNDEFDATESECS) < 2 || \
		 $tm1 < $tm0 } {
	    set tint 2 ; set Anim(elapsed,$no) -1
	} else {
	    set tint [expr $tm1-$tm0]
	    if { $Anim(elapsed,$no) != -1 } {
		incr Anim(elapsed,$no) $tint
	    }
	}
	set d [AnimDelay $no $tint]
	set Anim(data,$no) [list [lreplace $tps 0 0] $datum]
	set Anim(jobs,$no) [after $d [list AnimNextTR $no]]
    } elseif { $Anim(state,$no) != "abort" } {
	set Anim(state,$no) init
    }
    return
}

proc AnimSkipTR {no args} {
    # skip to next TP
    global Anim

    if { $Anim(state,$no) == "init" } {
	eval AnimStart $no TR $args
    } elseif { $Anim(state,$no) != "abort" } {
	foreach j $Anim(jobs,$no) {
	    after cancel $j
	}
	set Anim(state,$no) on
	set Anim(jobs,$no) [after 0 [list AnimNextTR $no]]
    }
    return
}    

proc AnimDelay {no secs} {
    # compute delay in msecs corresponding to $secs in real time
    global Anim

    set a 1.09211043408 ; set k 1.83131663025
    if { $Anim(speed,$no) > 0 } {
	set d [expr int($secs*1000.0/(pow($a,$Anim(speed,$no))*$k))]
    } elseif { $Anim(speed,$no) == 0 } {
	set d [expr int($secs*1000)]
    } else {
	set d [expr int($secs*1000*pow($a,$Anim(speed,$no))*$k)]
    }
    return $d
}

proc AnimStateChange {n ix op} {
    # called by trace when $Anim(state,$no) has been changed
    global Anim TXT

    set Anim($ix,ext) $TXT(anim$Anim($ix))
    return
}

proc AnimSpeedChange {n ix op} {
    # called by trace when $Anim(speed,$no) has been changed
    # must call another proc with after to avoid segmentation fault

    after 0 "AnimSpeedChanged $ix"
    return
}

proc AnimSpeedChanged {ix} {
    #  $ix  has the form  speed,$no
    global Anim RealTimeLogIntv TXT

    regsub {speed,} $ix "" no
    if { $Anim(state,$no) == "abort" || ! [winfo exists .anim$no] } { return }
    set w .anim$no
    set nv $Anim(speed,$no)
    if { $no == -1 } {
	# real time log interval
	set t "$TXT(rtimelogintv): [set RealTimeLogIntv [expr $nv+51]] s"
    } else {
	# animation speed
	set a 1.09211043408 ; set k 1.83131663025
	if { $nv > 0 } {
	    set v "x [format %.1f [expr pow($a,$nv)*$k]]"
	} elseif { $nv == 0 } {
	    set v $TXT(actual)
	} else {
	    set v "/ [format %.1f [expr pow($a,-$nv)*$k]]"
	}
	set t "$TXT(speed): $v"
    }
    $w.fr.frs.sp configure -label $t
    return
}