1# 2# This file is part of: 3# 4# gpsman --- GPS Manager: a manager for GPS receiver data 5# 6# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de 7# 8# This program is free software; you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation; either version 3 of the License, or 11# (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program. 20# 21# File: navigate.tcl 22# Last change: 6 October 2013 23# 24 25##### travel/navigation display 26 27proc ToTravel {} { 28 # change the map window for travelling and set up the travel frame if 29 # needed 30 # the frame $WConf(travel,fr) will replace frame $WConf(travel,alt) 31 # assumed to be the only widget in their parent and managed by grid 32 global WConf Travelling Travel MESS 33 34 if { $Travelling } { return } 35 grid remove $WConf(travel,alt) 36 set fr $WConf(travel,fr) 37 if { ! [winfo exists $fr.fctrl] } { TravelInit $fr } 38 grid $fr 39 if { $Travel(posns) != "" && [GMConfirm $MESS(clrtrvlog)] } { 40 set Travel(posns) "" 41 } 42 set Travelling 1 43 return 44} 45 46proc TravelInit {fr} { 47 # set up the travel frame $fr 48 global Travel RcMenu TXT COLOUR MAPCOLOUR MAPDISTS MAPDISTVALS 49 50 foreach e $Travel(els) { set Travel(info,$e) "" } 51 set Travel(info,vel_z) "" 52 set Travel(nav,datum,a) [lindex [EllipsdData $Travel(nav,datum)] 0] 53 54 TravelInitFonts create 55 56 # widget names are used in other procedures 57 frame $fr.fctrl 58 set mn $fr.fctrl.ctrl.mn 59 menubutton $fr.fctrl.ctrl -text $TXT(change) -menu $mn 60 menu $mn 61 $mn add command -label $TXT(GPSrec) \ 62 -command { 63 $RcMenu post [expr [winfo rootx $MpW]+30] [expr [winfo rooty $MpW]+30] 64 } 65 $mn add separator 66 $mn add command -label $TXT(navMOB) -foreground $COLOUR(check) \ 67 -command { TravelNav MOB } 68 $mn add command -label "$TXT(create) $TXT(WP)" \ 69 -command { TravelMarkPoint } 70 $mn add cascade -label $TXT(startnav) -menu $mn.ms 71 menu $mn.ms 72 $mn.ms add command -label $TXT(navWP) -command { TravelNav WP } 73 foreach wh "RT TR LN" { 74 $mn.ms add command -label [format $TXT(follow) $TXT($wh)] \ 75 -command "TravelNav $wh" 76 } 77 $mn.ms add command -label $TXT(goback) -command { TravelNav GoBack } 78 79 $mn add command -label $TXT(chggoal) \ 80 -command { TravelNavCmd chggoal } -state disabled 81 set Travel(travel,mnchggoal) [$mn index last] 82 $mn add command -label $TXT(suspend) \ 83 -command { TravelNavCmd suspend } -state disabled 84 set Travel(travel,mnsuspend) [$mn index last] 85 $mn add command -label $TXT(resume) \ 86 -command { TravelNavCmd resume } -state disabled 87 set Travel(travel,mnresume) [$mn index last] 88 $mn add command -label $TXT(forgetgoal) \ 89 -command { TravelNavCmd abort } -state disabled 90 set Travel(travel,mnabort) [$mn index last] 91 92 $mn add separator 93 $mn add cascade -label $TXT(mindist) -menu $mn.mdist 94 set ix [$mn index last] 95 menu $mn.mdist 96 set pmd $Travel(mindist) ; set nf 1 97 foreach e $MAPDISTS d $MAPDISTVALS { 98 $mn.mdist add command -label $e \ 99 -command "set Travel(mindist) $d ; \ 100 $mn entryconfigure $ix -label {$TXT(mindist) = $e}" 101 if { $d == $pmd } { 102 set nf 0 103 $mn.mdist invoke last 104 } 105 } 106 if { $nf } { 107 # bad value of minimum distance; set to last in menu 108 set Travel(mindist) $d 109 $mn entryconfigure $ix -label "$TXT(mindist) $e" 110 } 111 112 # prevent bad value for boolean off-road 113 if { $Travel(offroad) != 0 } { set Travel(offroad) 1 } 114 # NOT YET IN USE! 115 # $mn add checkbutton -label $TXT(offroad) -variable Travel(offroad) \ 116 -selectcolor $COLOUR(check) 117 118 $mn add command -label $TXT(chginggoal) -command TravelChgGoal 119 $mn add cascade -label $TXT(warnings) -menu $mn.mwn 120 menu $mn.mwn 121 set warn $Travel(warn) 122 $mn.mwn add checkbutton -label $TXT(dowarn) -onvalue 1 -offvalue 0 \ 123 -variable Travel(warn) -selectcolor $COLOUR(check) 124 $mn.mwn add command -label $TXT(warnconf) -command TravelWarnConfigure 125 126 $mn add cascade -label $TXT(travdisplay) -menu $mn.dsp 127 menu $mn.dsp 128 foreach dsp $Travel(displays) { 129 $mn.dsp add command -label $dsp -command "TravelSetUp $dsp" 130 } 131 132 $mn add separator 133 $mn add command -label $TXT(notravel) -command NoTravel 134 135 foreach dsp $Travel(displays) { 136 radiobutton $fr.fctrl.b$dsp -value $dsp -anchor w \ 137 -selectcolor $COLOUR(check) -variable Travel(travel,cdsp,b) \ 138 -command "TravelChangeDisplay $dsp $fr.fri" 139 BalloonBindings $fr.fctrl.b$dsp \ 140 [list "=[format $TXT(travchgdisplay) $dsp]"] 141 grid $fr.fctrl.b$dsp -row 1 -column [expr $dsp-1] 142 } 143 set Travel(travel,cdsp,b) $Travel(travel,cdsp) 144 frame $fr.fri 145 set Travel(travel,dsppfr) $fr.fri 146 foreach dsp $Travel(displays) { 147 frame $fr.fri.f$dsp 148 foreach i $Travel(els) s $Travel(elsizes) { 149 label $fr.fri.f$dsp.$i -width $s -font $Travel(font) \ 150 -textvariable Travel(info,$i) -relief sunken 151 label $fr.fri.f$dsp.t_$i -font $Travel(font) -text $TXT(TRV$i) 152 } 153 # TRN arrows 154 # set cbgw 121 ; set cbgh 55 155 set cbgw 121 ; set cbgh 37 156 set cbg $fr.fri.f$dsp.c_trn 157 canvas $cbg -width $cbgw -height $cbgh -relief flat -bg $COLOUR(dialbg) 158 set cw2 [expr $cbgw/2] ; set ch2 [expr $cbgh/2] 159 set aw [expr int($cw2*0.7)] ; set aw2 [expr $aw/2] 160 set ah4 [expr ($cbgh-2)/4] 161 set ps "1 $ch2 $aw2 1 $aw2 [expr 1+$ah4] $aw [expr 1+$ah4] \ 162 $aw [expr $cbgh-1-$ah4] $aw2 [expr $cbgh-1-$ah4] \ 163 $aw2 [expr $cbgh-1] 1 $ch2" 164 eval $cbg create polygon $ps -fill $COLOUR(dialbg) -width 1 \ 165 -outline black -tags left 166 set psr "" 167 foreach "x y" $ps { lappend psr [expr $cbgw-$x] $y } 168 eval $cbg create polygon $psr -fill $COLOUR(dialbg) -width 1 \ 169 -outline black -tags right 170 label $cbg.lab -textvariable Travel(info,trn) -font $Travel(fontb) 171 $cbg create window $cw2 $ch2 -anchor c -window $cbg.lab 172 173 # up-down arrow 174 set cvz $fr.fri.f$dsp.c_vel_z 175 canvas $cvz -width $cbgw -height $cbgh -relief flat -bg $COLOUR(dialbg) 176 set b [expr $cbgh-2] 177 set psn "[expr $ch2+2] 2 \ 178 [expr $cbgh+2] [expr 2+$aw2] \ 179 [expr $cbgh+2-$ah4] [expr 2+$aw2] \ 180 [expr $cbgh+2-$ah4] $b [expr 2+$ah4] $b \ 181 [expr 2+$ah4] [expr 2+$aw2] 2 [expr 2+$aw2] \ 182 [expr $ch2+2] 2" 183 eval $cvz create polygon $psn -fill $COLOUR(dialbg) -width 1 \ 184 -outline black -tags vel_z 185 label $cvz.lab -textvariable Travel(info,vel_z) -font $Travel(fontb2) 186 $cvz create window [expr 0.75*$cbgw] $ch2 -anchor c -window $cvz.lab 187 set Travel(wdgts,vel_z) [expr 2+$b] 188 set Travel(wdgts,vel_z,up) 1 189 190 # TRK, CTS and secondary CTS arrows 191 set ccp $fr.fri.f$dsp.c_trkcts 192 set ccpw [set ccph [expr 2*$cbgh]] 193 canvas $ccp -width $ccpw -height $ccph -relief flat -bg $COLOUR(dialbg) 194 if { $ccpw >= $ccph } { set sl $ccph } else { set sl $ccpw } 195 set sl [expr int($sl*0.8)] 196 set x0 [expr ($ccpw-$sl)/2] ; set xe [expr $x0+$sl] 197 set y0 [expr ($ccph-$sl)/2] ; set ye [expr $y0+$sl] 198 $ccp create oval $x0 $y0 $xe $ye -fill $COLOUR(dialbg) -width 1 \ 199 -outline $MAPCOLOUR(trvtrk) 200 set xm [expr $ccpw/2] 201 set ah [expr int(($sl-4)*0.4)] ; set ah2 [expr $ah/2] 202 set ah4 [expr $ah2/2] 203 set yh [expr $y0+3+$ah] 204 set cps [list $xm [expr $y0+3] [expr $xm+$ah2] $yh \ 205 [expr $xm+$ah4] $yh [expr $xm+$ah4] [expr $ye-3] \ 206 [expr $xm-$ah4] [expr $ye-3] \ 207 [expr $xm-$ah4] $yh [expr $xm-$ah2] $yh $xm [expr $y0+3]] 208 foreach ts [list {cts ctss} {cts2 ctss} trk] { 209 set it [eval $ccp create polygon $cps -width 1] 210 # to avoid problems with spaces in names of colours 211 $ccp itemconfig $it -fill $COLOUR(dialbg) -tags $ts 212 } 213 $ccp raise trk 214 set ym [expr $ccph/2] 215 set cs "" 216 foreach "x y" $cps { 217 lappend cs [expr $x-$xm] [expr $y-$ym] 218 } 219 set Travel(wdgts,trk) [set Travel(wdgts,cts) \ 220 [set Travel(wdgts,cts2) [list trkcts $cs $xm $ym]]] 221 # draw N,E,S,W letters 222 set xx0 [expr $xm-2] ; set xxe [expr $xm+2] ; set yye [expr $y0-6] 223 set csn [list $xx0 $y0 $xx0 $yye $xxe $y0 $xxe $yye] 224 eval $ccp create line $csn -width 1 -fill red -tags north 225 set xx1 [expr $xe+1] ; set xx2 [expr $xe+6] 226 set yy1 [expr $ym-3] ; set yy2 [expr $ym+3] 227 set cse [list $xx2 $yy1 $xx1 $yy1 $xx1 $ym [expr $xx1+4] $ym \ 228 $xx1 $ym $xx1 $yy2 $xx2 $yy2] 229 eval $ccp create line $cse -width 1 -fill blue -tags east 230 set yy3 [expr $ye+3] ; set yy4 [expr $ye+6] 231 set css [list $xxe $ye $xx0 $ye $xx0 $yy3 $xxe $yy3 \ 232 $xxe $yy4 $xx0 $yy4] 233 eval $ccp create line $css -width 1 -fill blue -tags south 234 set xx3 [expr $x0-6] ; set xx4 [expr $x0-1] 235 set csw [list $xx3 $yy1 $xx3 $yy2 [expr $x0-3] [expr $yy2-3] \ 236 $xx4 $yy2 $xx4 $yy1] 237 eval $ccp create line $csw -width 1 -fill blue -tags west 238 set ts [list trkcts $xm $ym] 239 foreach e "north east south west" l "csn cse css csw" { 240 set cs "" 241 foreach "x y" [set $l] { 242 lappend cs [expr $x-$xm] [expr $y-$ym] 243 } 244 lappend ts $e $cs 245 } 246 set Travel(wdgts,nesw) $ts 247 248 TravelDraw $fr $dsp 249 } 250 grid $fr.fctrl.ctrl -row 0 -column 0 -columnspan 2 251 grid $fr.fctrl -row 0 -column 0 252 grid $fr.fri.f$Travel(travel,cdsp) 253 grid $fr.fri -row 0 -column 1 254 return 255} 256 257proc TravelChangeDisplay {dsp pfr} { 258 # change to display $dsp 259 # $pfr is parent frame of displays 260 global Travel WConf 261 262 grid remove $pfr.f$Travel(travel,cdsp) 263 grid $pfr.f$dsp 264 set Travel(travel,cdsp) $dsp 265 return 266} 267 268proc TravelDraw {fr dsp} { 269 # draw widgets for displaying travel information 270 # $fr is the main travel frame 271 # $dsp gives the secondary frame 272 # the list $Travel(conf,$dsp) gives the elements and canvases to be 273 # displayed; element names can be preceded by lab+ asking for a title 274 # label 275 global Travel 276 277 set r 0 ; set c 0 278 foreach e $Travel(conf,$dsp) { 279 if { $e == "c_trkcts" } { 280 # this needs 2 rows 281 if { $r != 0 } { set r 0 ; incr c 2 } 282 grid $fr.fri.f$dsp.$e -row 0 -rowspan 2 -column $c -sticky nesw 283 set r 0 ; incr c 284 } elseif { [string first "c_" $e] == 0 } { 285 # other arrow graphics 286 grid $fr.fri.f$dsp.$e -row $r -column $c -columnspan 2 -sticky ew 287 set c [expr $c+2*$r] ; set r [expr 1-$r] 288 } elseif { [regsub {^lab\+} $e "" ne] } { 289 # with title label 290 grid $fr.fri.f$dsp.t_$ne -row $r -column $c -sticky e 291 grid $fr.fri.f$dsp.$ne -row $r -column [expr $c+1] -sticky w 292 set c [expr $c+2*$r] ; set r [expr 1-$r] 293 } else { 294 grid $fr.fri.f$dsp.$e -row $r -column $c -columnspan 2 295 set c [expr $c+2*$r] ; set r [expr 1-$r] 296 } 297 } 298 return 299} 300 301proc TravelChgGoal {} { 302 # dialog for setting the parameter on when to change from 303 # current to next goal when following a RT or TR 304 global Travel TXT DPOSX DPOSY 305 306 set w .trvchggoal 307 if { [winfo exists $w] } { Raise $w ; return } 308 GMToplevel $w chginggoal +$DPOSX+$DPOSY {} \ 309 [list WM_DELETE_WINDOW "destroy $w"] {} 310 311 frame $w.ft 312 label $w.ft.tit -text $TXT(chginggoal) 313 BalloonButton $w.ft.bhlp chggoalhlp 314 grid $w.ft.tit 315 grid $w.ft.bhlp -row 0 -column 1 -sticky sw 316 317 frame $w.fr -relief flat -borderwidth 5 318 label $w.fr.t1 -text $TXT(soon) 319 scale $w.fr.s -orient horizontal -from 0 -to $Travel(chggmaxix) \ 320 -showvalue 0 -width 12 -length 100 -variable Travel(chggix) 321 label $w.fr.t2 -text $TXT(late) 322 grid $w.fr.t1 -row 0 -column 0 323 grid $w.fr.s -row 0 -column 1 324 grid $w.fr.t2 -row 0 -column 2 325 326 button $w.ok -text $TXT(ok) -command "destroy $w" 327 328 pack $w.ft $w.fr $w.ok -pady 5 329 update idletasks 330 return 331} 332 333proc TravelChgGParam {n no op} { 334 # called by trace when $Travel(chggix) has been changed 335 global Travel 336 337 set ix $Travel(chggix) 338 set Travel(chggparam) [lindex $Travel(chggvals) $ix] 339 set Travel(chggwparam) [lindex $Travel(chggwvals) $ix] 340 return 341} 342 343proc NoTravel {} { 344 # change the map window when stopping travelling 345 # the frame $WConf(travel,alt) will replace frame $WConf(travel,fr) 346 # assumed to be the only widget in their parent and managed by grid 347 global WConf Travelling 348 349 set Travelling 0 350 grid remove $WConf(travel,fr) 351 grid $WConf(travel,alt) 352 return 353} 354 355proc TravelRealTimeOff {} { 356 # real-time logging stopped 357 global Travel TXT 358 359 TravelDoWarn $TXT(trvwnolog) important 360 TravelDisplayChange notraveldata 361 if { $Travel(nav) == "on" } { 362 TravelNavCmd suspend 363 set Travel(nav) nolog 364 set Travel(nav,ok) 0 365 } 366 return 367} 368 369proc TravelRealTimeOn {} { 370 # real-time logging (re-)started 371 global Travel 372 373 if { $Travel(nav) == "nolog" } { 374 TravelNavCmd resume 375 } 376 return 377} 378 379##### configuring the travel displays 380 381proc TravelSetUp {dsp} { 382 # set up/change the contents of the travel display $dsp 383 global Travel WConf TXT MESS DPOSX DPOSY COLOUR 384 385 # used explicitly elsewhere 386 set w .travsetup 387 if { [winfo exists $w] } { bell ; Raise $w ; return } 388 389 set Travel(font,new) [set Travel(font,txt) ""] 390 391 GMToplevel $w travdsetup +$DPOSX+$DPOSY {} \ 392 [list WM_DELETE_WINDOW "destroy $w"] \ 393 [list <Key-Return> "TravelSUAction ok $dsp"] 394 395 label $w.tit -text "$TXT(travdsetup) $dsp" 396 frame $w.fr -relief flat -borderwidth 5 397 398 # values and titles 399 frame $w.fr.frl 400 foreach l "hide show" col "0 3" { 401 label $w.fr.frl.$l -text $TXT($l) 402 BalloonBindings $w.fr.frl.$l trvhlpbox 403 grid $w.fr.frl.$l -row 0 -column $col -sticky nesw 404 } 405 foreach b "a b" col "0 3" e "nuels cfels" { 406 listbox $w.fr.frl.bx$b -height 12 -width 15 -relief groove \ 407 -yscrollcommand "$w.fr.frl.bscr$b set" -selectmode extended 408 scrollbar $w.fr.frl.bscr$b -command "$w.fr.frl.bx$b yview" 409 set Travel(move,bx$b) "" 410 grid $w.fr.frl.bx$b -row 1 -column $col -sticky nesw 411 grid $w.fr.frl.bscr$b -row 1 -column [expr $col+1] -sticky nesw 412 foreach ev "<Button-3> <ButtonRelease-3>" p "start end" { 413 bind $w.fr.frl.bx$b $ev "TravelSUMove $p bx$b $e %x %y" 414 } 415 bind $w.fr.frl.bx$b <B3-Enter> \ 416 "TravelSUMove enter-down bx$b $e %X %Y; break" 417 foreach ev "<B3-Motion> <Any-Enter> <B3-Leave>" p "go enter leave" { 418 bind $w.fr.frl.bx$b $ev "TravelSUMove $p bx$b $e %X %Y" 419 } 420 } 421 set Travel(dsup,cfels) "" 422 set Travel(dsup,nuels) [concat $Travel(cvss) $Travel(els)] 423 foreach e $Travel(conf,$dsp) { 424 lappend Travel(dsup,cfels) $e 425 if { [regsub {^lab\+} $e "" e] } { 426 set t "$TXT(TRV$e), $TXT(label)" 427 } else { set t $TXT(TRV$e) } 428 $w.fr.frl.bxb insert end $t 429 if { [set ix [lsearch -exact $Travel(dsup,nuels) $e]] != -1 } { 430 set Travel(dsup,nuels) [lreplace $Travel(dsup,nuels) $ix $ix] 431 } else { 432 destroy $w 433 set Travel(conf,$dsp) "" 434 GMMessage $MESS(badtrvconf) 435 return [TravelSetUp $dsp] 436 } 437 } 438 foreach e $Travel(dsup,nuels) { 439 $w.fr.frl.bxa insert end $TXT(TRV$e) 440 } 441 frame $w.fr.frl.frb 442 foreach b "a at r" ti "add addlabelled remove" al "- - <" ar "> > -" { 443 button $w.fr.frl.frb.b$b -text "${al}--$TXT($ti)--$ar" \ 444 -command "TravelSUAction $ti $dsp" 445 grid $w.fr.frl.frb.b$b 446 } 447 grid [BalloonButton $w.fr.frl.frb.bhlp trvhlpbxs] 448 grid $w.fr.frl.frb -row 1 -column 2 -sticky n 449 450 # options: font 451 frame $w.fr.fro -borderwidth 1 -bg $COLOUR(messbg) 452 button $w.fr.fro.ftsel -text $TXT(optTRAVELFONT) -relief raised \ 453 -command "TravelSUAction font $dsp \[GMSelectFont\]" 454 label $w.fr.fro.ft -textvariable Travel(font,txt) -width 40 455 grid $w.fr.fro.ftsel $w.fr.fro.ft 456 457 # ok, cancel buttons 458 frame $w.fr.frbs 459 button $w.fr.frbs.ok -text $TXT(ok) \ 460 -command "destroy $w ; TravelSUAction ok $dsp" 461 button $w.fr.frbs.cnc -text $TXT(cancel) -command "destroy $w" 462 grid $w.fr.frbs.ok 463 grid $w.fr.frbs.cnc -row 0 -column 1 464 465 grid $w.fr.frl 466 grid $w.fr.fro -pady 5 467 grid $w.fr.frbs -pady 7 468 grid $w.tit 469 grid $w.fr 470 471 # change to display $dsp 472 $WConf(travel,fr).fctrl.b$dsp invoke 473 $WConf(travel,fr).fctrl.b$dsp select 474 update idletasks 475 return 476} 477 478proc TravelSUMove {how box lref x y} { 479 # move element in listbox $box under travel display set up dialog 480 # $how in {start, go, end, enter-down, enter, leave} 481 # $lref is used to access the list $Travel(dsup,$lref) containing the 482 # internal representations of the listbox elements 483 # $x,$y are either the coordinates inside the listbox (for $how==start 484 # and $how==end) or the global coordinates 485 global Travel COLOUR 486 487 set pb .travsetup.fr.frl.$box 488 set tb .travmv$box 489 switch $how { 490 start { 491 set ix [$pb index @$x,$y] 492 if { [set el [$pb get $ix]] == "" } { return } 493 if { $Travel(move,$box) != "" } { 494 destroy $tb 495 } else { set Travel(move,$box) in } 496 NewBalloon $tb $el \ 497 +[expr $x+[winfo rootx $pb]+9]+[expr $y+[winfo rooty $pb]+9] 498 set Travel(move,$box,el) $el 499 set Travel(move,$box,ix) $ix 500 } 501 enter-down { 502 if { $Travel(move,$box) == "out" } { 503 if { [winfo exists $tb] } { 504 set Travel(move,$box) in 505 wm geometry $tb +[expr $x+9]+[expr $y+9] 506 } else { 507 set Travel(move,$box) "" 508 } 509 } 510 } 511 enter { 512 if { $Travel(move,$box) != "" } { 513 destroy $tb ; set Travel(move,$box) "" 514 } 515 } 516 go { 517 if { $Travel(move,$box) == "in" && [winfo exists $tb] } { 518 wm geometry $tb +[expr $x+9]+[expr $y+9] 519 } 520 } 521 end { 522 if { $Travel(move,$box) == "in" && [winfo exists $tb] } { 523 destroy $tb ; set Travel(move,$box) "" 524 set fix [$pb index @$x,$y] 525 set ix $Travel(move,$box,ix) 526 set e [lindex $Travel(dsup,$lref) $ix] 527 if { $fix != $ix } { 528 $pb delete $ix 529 $pb insert $fix $Travel(move,$box,el) 530 set Travel(dsup,$lref) \ 531 [lreplace $Travel(dsup,$lref) $ix $ix] 532 set Travel(dsup,$lref) \ 533 [linsert $Travel(dsup,$lref) $fix $e] 534 } 535 } 536 } 537 leave { 538 if { $Travel(move,$box) == "in" } { set Travel(move,$box) "out" } 539 } 540 } 541 return 542} 543 544proc TravelSUAction {act dsp args} { 545 # deal with user action when setting up the travel display number $dsp 546 # $act in {ok, add, addlabelled, remove, font} 547 # $args contains result of proc GMSelectFont if $act==font 548 global Travel WConf TXT TRAVELFONT TkDefaultFont 549 550 set w .travsetup 551 set bxfrom $w.fr.frl.bxa ; set bxto $w.fr.frl.bxb 552 set fr $WConf(travel,fr) 553 switch $act { 554 add { 555 if { [set s [$bxfrom curselection]] == "" } { 556 if { [$bxfrom size] != 1 } { 557 bell ; return 558 } else { set s 0 } 559 } 560 set s [lsort -integer -decreasing $s] 561 set iix [$bxto size] 562 foreach ix $s { 563 set ne [lindex $Travel(dsup,nuels) $ix] 564 set Travel(dsup,nuels) [lreplace $Travel(dsup,nuels) $ix $ix] 565 $bxfrom delete $ix $ix 566 $bxto insert $iix $TXT(TRV$ne) 567 set Travel(dsup,cfels) [linsert $Travel(dsup,cfels) $iix $ne] 568 } 569 } 570 addlabelled { 571 if { [set s [$bxfrom curselection]] == "" } { 572 if { [$bxfrom size] != 1 } { 573 bell ; return 574 } else { set s 0 } 575 } 576 if { [llength $s] == 1 } { 577 set e [lindex $Travel(dsup,nuels) $s] 578 if { [string first "c_" $e] == 0 } { bell ; return } 579 } else { set s [lsort -integer -decreasing $s] } 580 set iix [$bxto size] 581 foreach ix $s { 582 set ne [lindex $Travel(dsup,nuels) $ix] 583 set Travel(dsup,nuels) [lreplace $Travel(dsup,nuels) $ix $ix] 584 $bxfrom delete $ix $ix 585 if { [string first "c_" $ne] == 0 } { 586 set t $TXT(TRV$ne) 587 } else { 588 set t "$TXT(TRV$ne), $TXT(label)" 589 set ne lab+$ne 590 } 591 $bxto insert $iix $t 592 set Travel(dsup,cfels) [linsert $Travel(dsup,cfels) $iix $ne] 593 } 594 } 595 remove { 596 if { [set s [$bxto curselection]] == "" } { 597 if { [$bxto size] != 1 } { 598 bell ; return 599 } else { set s 0 } 600 } 601 set s [lsort -integer -decreasing $s] 602 set iix [$bxfrom size] 603 foreach ix $s { 604 set ne [lindex $Travel(dsup,cfels) $ix] 605 regsub {^lab\+} $ne "" ne 606 set Travel(dsup,cfels) [lreplace $Travel(dsup,cfels) $ix $ix] 607 $bxto delete $ix $ix 608 $bxfrom insert $iix $TXT(TRV$ne) 609 set Travel(dsup,nuels) [linsert $Travel(dsup,nuels) $iix $ne] 610 } 611 } 612 font { 613 if { [set f [lindex $args 0]] != "" } { 614 if { [set ft $f] == "default" } { 615 set ft $TXT(default) 616 if { [set f $TRAVELFONT] == "default" } { 617 set f $TkDefaultFont 618 } 619 } 620 set Travel(font,txt) $ft 621 set Travel(font,new) $f 622 } 623 } 624 ok { 625 if { $Travel(font,new) != "" } { 626 set Travel(font) $Travel(font,new) 627 TravelInitFonts recreate 628 foreach e $Travel(els) { 629 $fr.fri.f$dsp.$e configure -font $Travel(font) 630 $fr.fri.f$dsp.t_$e configure -font $Travel(font) 631 } 632 } 633 if { $Travel(dsup,cfels) != $Travel(conf,$dsp) } { 634 set Travel(conf,$dsp) $Travel(dsup,cfels) 635 foreach s [grid slaves $fr.fri.f$dsp] { grid forget $s } 636 TravelDraw $fr $dsp 637 } 638 } 639 } 640 return 641} 642 643proc TravelInitFonts {how} { 644 # create/recreate auxiliary fonts for travel display 645 # $how=="recreate" means that the $Travel(font) changed and 646 # the auxiliary fonts must be remade 647 # two variants of the travel frame font are at stake and 648 # have fixed names: travelfontb, travelfontb2 649 # recreating a font automatically updates widgets using it 650 # as the name is the same 651 global Travel 652 653 if { $how == "recreate" } { 654 font delete travelfontb travelfontb2 655 } elseif { ! [catch {set $Travel(fontb)}] } { return } 656 657 set avps [font actual $Travel(font)] 658 foreach {a v} $avps { 659 set [string replace $a 0 0] $v 660 } 661 if { $size > 0 } { set d2 2 } else { set d2 -2 } 662 if { $weight == "bold" } { 663 # change the slant to make it different 664 if { $slant == "italic" } { 665 set opts "-slant roman" 666 } else { set opts "-slant italic" } 667 } else { set opts "-weight bold" } 668 set fb [eval font create travelfontb $avps] 669 eval font configure $fb $opts 670 set Travel(fontb) $fb 671 append opts " -size " [expr $size+$d2] 672 set fb2 [eval font create travelfontb2 $avps] 673 eval font configure $fb2 $opts 674 set Travel(fontb2) $fb2 675 return 676} 677 678##### warnings 679 680proc TravelWarnConfigure {} { 681 # configure warnings 682 # warnings considered here as belonging to $Travel(warnings): 683 # prox, anchor, speed, trn, vspeed, xtk 684 # all values in $Travel(warn,...) saved to Travel(wcfg,...) 685 global Travel COLOUR DPOSX DPOSY TXT NAMEWIDTH DTUNIT SPUNIT 686 687 set w .travwrnconf 688 if { [winfo exists $w] } { bell ; Raise $w ; return } 689 690 foreach p [array names Travel warn,*] { 691 regsub {^warn,} $p "" s 692 set Travel(wcfg,$s) $Travel($p) 693 } 694 695 GMToplevel $w warnconf +$DPOSX+$DPOSY {} \ 696 [list WM_DELETE_WINDOW "destroy $w"] \ 697 {<Key-Return> {TravelWCAction ok}} 698 699 label $w.tit -text $TXT(warnconf) 700 frame $w.fr -relief flat -borderwidth 5 701 frame $w.fr.fc -relief flat -borderwidth 1 -bg $COLOUR(messbg) 702 set fr $w.fr.fc 703 label $fr.prior -text $TXT(priority) 704 foreach x "prox anchor speed trn vspeed xtk" { 705 checkbutton $fr.chk$x -text $TXT(warn$x) -variable Travel(wcfg,$x) \ 706 -anchor w -selectcolor $COLOUR(check) 707 frame $fr.frl$x 708 set c -1 709 foreach l "high medium low" { 710 radiobutton $fr.frl$x.l$l -text $TXT($l) -value $l -anchor w \ 711 -variable Travel(wcfg,$x,level) -selectcolor $COLOUR(check) 712 grid $fr.frl$x.l$l -row 0 -column [incr c] -sticky w 713 } 714 } 715 set nl $NAMEWIDTH 716 foreach x "prox anchor" { 717 button $fr.ch$x -text $TXT(select) -command "TravelWCAction selwp $x" 718 label $fr.wp$x -textvariable Travel(wcfg,$x,wpn) -width $nl 719 entry $fr.dt$x -textvariable Travel(wcfg,$x,dst) -width 4 \ 720 -justify right 721 label $fr.du$x -text $DTUNIT 722 } 723 foreach x "speed trn xtk" \ 724 u [list $SPUNIT $TXT(degrees) $DTUNIT] { 725 entry $fr.max$x -textvariable Travel(wcfg,$x,max) -width 4 \ 726 -justify right 727 label $fr.un$x -text $u 728 } 729 frame $fr.fs 730 entry $fr.fs.minvspeed -textvariable Travel(wcfg,vspeed,min) -width 4 \ 731 -justify right 732 label $fr.fs.sepvspeed -text "---" 733 entry $fr.fs.maxvspeed -textvariable Travel(wcfg,vspeed,max) -width 4 \ 734 -justify right 735 label $fr.fs.unvspeed -text m/s 736 737 grid $fr.prior -row 0 -column 5 -sticky ew 738 set r 0 739 foreach x "prox anchor speed vspeed trn xtk" { 740 grid $fr.chk$x -row [incr r] -column 0 -sticky ew 741 grid $fr.frl$x -row $r -column 5 -sticky ew 742 set row_$x $r 743 } 744 foreach x "prox anchor" { 745 set r [set row_$x] 746 grid $fr.dt$x -row $r -column 1 -sticky ew 747 grid $fr.du$x -row $r -column 2 -sticky w 748 grid $fr.ch$x -row $r -column 3 -padx 5 749 grid $fr.wp$x -row $r -column 4 750 } 751 foreach x "speed trn xtk" { 752 set r [set row_$x] 753 grid $fr.max$x -row $r -column 1 -sticky ew 754 grid $fr.un$x -row $r -column 2 -sticky w 755 } 756 grid $fr.fs.minvspeed -row 0 -column 0 -sticky ew 757 grid $fr.fs.sepvspeed -row 0 -column 1 -sticky ew 758 grid $fr.fs.maxvspeed -row 0 -column 2 -sticky w 759 grid $fr.fs.unvspeed -row 0 -column 3 -sticky w 760 grid $fr.fs -row $row_vspeed -column 1 -columnspan 3 -sticky w 761 762 frame $w.fr.frbs 763 button $w.fr.frbs.ok -text $TXT(ok) \ 764 -command "$w.fr.frbs.ok configure -state normal ; \ 765 TravelWCAction ok $w" 766 button $w.fr.frbs.cnc -text $TXT(cancel) -command "destroy $w" 767 grid $w.fr.frbs.ok 768 grid $w.fr.frbs.cnc -row 0 -column 1 769 770 grid $w.fr.fc 771 grid $w.fr.frbs -pady 7 772 grid $w.tit ; grid $w.fr 773 return 774} 775 776proc TravelWCAction {act args} { 777 # react to action when configuring warnings 778 # $args: 779 # if $act==ok (end of configuration): window to destroy on success 780 # if $act=selwp: name of warning in {prox, anchor} 781 # warnings considered here as belonging to $Travel(warnings): 782 # prox, anchor, speed, trn, vspeed, xtk 783 global Travel WPName WPPosn WPDatum TXT MESS 784 785 switch $act { 786 selwp { 787 if { [set ix [ChooseItems WP single]] == "" } { return } 788 set Travel(wcfg,$args,wpn) $WPName($ix) 789 set Travel(wcfg-int,$args,wpix) $ix 790 } 791 ok { 792 # check values for all active warnings 793 set ws "" 794 foreach e $Travel(warnings) { 795 if { $Travel(wcfg,$e) } { 796 lappend ws $e 797 switch $e { 798 prox - anchor { 799 if { $Travel(wcfg,$e,wpn) == "" } { 800 GMMessage $MESS(badWP) 801 return 802 } 803 if { [BadParam $TXT(warn$e) float>0 \ 804 $Travel(wcfg,$e,dst)] } { return } 805 } 806 trn { 807 if { [BadParam $TXT(warn$e) long=0,180 \ 808 $Travel(wcfg,$e,max)] } { return } 809 810 } 811 vspeed { 812 if { [BadParam $TXT(warn$e) float \ 813 $Travel(wcfg,$e,min)] || \ 814 [BadParam $TXT(warn$e) \ 815 float>$Travel(wcfg,$e,min) \ 816 $Travel(wcfg,$e,max)] } { return } 817 } 818 speed - xtk { 819 if { [BadParam $TXT(warn$e) float>0 \ 820 $Travel(wcfg,$e,max)] } { return } 821 } 822 } 823 } 824 } 825 foreach e $ws { 826 foreach p [array names Travel wcfg,$e*] { 827 regsub {^wcfg,} $p "" s 828 set Travel(warn,$s) $Travel($p) 829 } 830 if { $e == "prox" || $e == "anchor" } { 831 set ix $Travel(wcfg-int,$e,wpix) 832 set p $WPPosn($ix) 833 if { $WPDatum($ix) != $Travel(nav,datum) } { 834 set p [ToDatum [lindex $p 0] [lindex $p 1] \ 835 $WPDatum($ix) $Travel(nav,datum)] 836 } 837 set Travel(warn,$e,pos) $p 838 } 839 } 840 destroy $args 841 } 842 } 843 return 844} 845 846proc TravelWarn {mess level} { 847 # issue warning message if $Travel(warn) 848 global Travel 849 850 if { $Travel(warn) } { TravelDoWarn $mess $level } 851 return 852} 853 854proc TravelDoWarn {mess level} { 855 # display warning message on left-upper corner of map 856 # $level in {important, high, medium, normal, low, info} is the priority 857 # level used in cancelling existing warnings and in selecting the 858 # colour 859 global Travel Map MAPCOLOUR 860 861 set n [lsearch -exact {important high medium normal low info} $level] 862 if { [winfo exists .travelwarn] } { 863 if { $n > $Travel(warnprior) } { return } 864 after cancel $Travel(warncancel) 865 destroy .travelwarn 866 } 867 set Travel(warnprior) $n 868 GMToplevel .travelwarn "" +[winfo rootx $Map]+[winfo rooty $Map] {} {} {} 869 wm resizable .travelwarn 0 0 870 wm overrideredirect .travelwarn 1 871 872 message .travelwarn.m -aspect 800 -text $mess \ 873 -font $Travel(font) -fg $MAPCOLOUR(trvwrn$level) 874 pack .travelwarn.m 875 set Travel(warncancel) [after 4000 { destroy .travelwarn }] 876 return 877} 878 879##### navigation 880 881proc TravelNav {where} { 882 # start navigation 883 # $where in {MOB, WP, RT, TR, LN, GoBack} 884 global Travel WConf RealTimeLogOn TXT 885 886 if { ! $RealTimeLogOn } { 887 TravelDoWarn $TXT(trvwnolog) important 888 return 889 } 890 if { $Travel(nav) != "" } { 891 TravelDisplayChange clear 892 set Travel(nav) "" 893 } 894 TravelDisplayChange restore 895 if { $where == "MOB" } { 896 if { $Travel(prevtime) == -1 } { 897 TravelDoWarn $TXT(trvwnopos) important 898 return 899 } 900 TravelNavToMOB 901 } else { 902 if { $where == "WP" } { 903 set ix [ChooseItems WP single] 904 } elseif { $where == "GoBack" } { 905 if { $Travel(posns) == "" } { 906 TravelDoWarn $TXT(trvwnopos) important 907 set ix "" 908 } else { set ix ok } 909 } else { 910 # RT, TR, LN 911 set ix [ChooseItems $where single \ 912 "Travel(nav,pmode) Travel(nav,pnear) Travel(nav,prvrs)" \ 913 [list "@$TXT(exactly)" "@$TXT(fromnrst)" "@$TXT(inrvrs)"]] 914 } 915 if { $ix == "" || ! [TravelNavTo$where $ix] } { 916 TravelDisplayChange clear 917 return 918 } 919 } 920 set mn $WConf(travel,fr).fctrl.ctrl.mn 921 foreach z "abort suspend" { 922 $mn entryconfigure $Travel(travel,mn$z) -state normal 923 } 924 set Travel(nav) on ; set Travel(nav,dtype) $where 925 set Travel(nav,ok) 1 ; set Travel(nav,towarn) $Travel(warn) 926 return 927} 928 929proc TravelNavToWP {ix} { 930 # start navigation to WP with given index 931 # return 1 (cannot fail) 932 global Travel WPPosn WPDatum WPName 933 934 set p $WPPosn($ix) 935 if { $WPDatum($ix) != $Travel(nav,datum) } { 936 set p [ToDatum [lindex $p 0] [lindex $p 1] \ 937 $WPDatum($ix) $Travel(nav,datum)] 938 } 939 set Travel(nav,nxtgoal) $p 940 set Travel(nav,afternxt) "" 941 set Travel(nav,save) nxtWP 942 set Travel(nav,mode) exact 943 set Travel(nav,state) starting 944 set Travel(info,nxtWP) $WPName($ix) 945 return 1 946} 947 948proc TravelNavToMOB {} { 949 # start navigation to previous position (MOB) 950 global Travel RealTimeLogAnim 951 952 # create MOB WP 953 set p [FormatLatLong [lindex $Travel(prevposn) 0] \ 954 [lindex $Travel(prevposn) 1] DDD] 955 set n [NewName WP MOB] 956 set d [FormData WP "Name Commt Posn PFrmt Datum Symbol Obs" \ 957 [list $n MOB $p DDD $Travel(nav,datum) MOB "MOB\n[NowTZ]"]] 958 # display on map if animating 959 StoreWP -1 $n $d $RealTimeLogAnim 960 # go there 961 TravelNavToWP [IndexNamed WP $n] 962 return 963} 964 965proc TravelMarkPoint {} { 966 # create waypoint at current log position 967 global Travel RealTimeLogAnim TXT CREATIONDATE 968 969 if { [set secs $Travel(prevtime)] == -1 } { 970 TravelDoWarn $TXT(trvwnopos) info 971 return 972 } 973 set p [FormatLatLong [lindex $Travel(prevposn) 0] \ 974 [lindex $Travel(prevposn) 1] DDD] 975 set opts [list create revert cancel] 976 set dt [DateFromSecs $secs] 977 if { $CREATIONDATE } { 978 GMWPoint -1 $opts \ 979 [FormData WP "PFrmt Posn Datum Date Displ" \ 980 [list DDD $p $Travel(nav,datum) $dt $RealTimeLogAnim]] 981 } else { 982 GMWPoint -1 $opts \ 983 [FormData WP "Commt PFrmt Posn Datum Displ" \ 984 [list [DateCommt $dt] DDD $p $Travel(nav,datum) \ 985 $RealTimeLogAnim]] 986 } 987 return 988} 989 990proc TravelNavToRT {ix} { 991 # start navigation to RT with given index 992 # return 0 on failure 993 global Travel RTWPoints WPPosn WPDatum TXT 994 995 set ps "" 996 foreach nwp [set wpns $RTWPoints($ix)] { 997 if { [set wpix [IndexNamed WP $nwp]] == -1 } { 998 TravelDoWarn $TXT(trvwuwps) normal 999 return 0 1000 } 1001 set p $WPPosn($wpix) 1002 if { $WPDatum($wpix) != $Travel(nav,datum) } { 1003 set p [ToDatum [lindex $p 0] [lindex $p 1] \ 1004 $WPDatum($wpix) $Travel(nav,datum)] 1005 } 1006 lappend ps $p 1007 lappend wpixs $wpix 1008 } 1009 if { $Travel(nav,pmode) } { 1010 set Travel(nav,mode) exact 1011 } else { 1012 set Travel(nav,mode) approx 1013 set Travel(nav,nxtleg) "" 1014 } 1015 foreach "ps wpns" [TravelNavParams $ps $wpns] {} 1016 set Travel(nav,wpns) $wpns 1017 TravelNavLine $ps [lindex $wpns 0] 1018 return 1 1019} 1020 1021proc TravelNavToTR {ix} { 1022 # start navigation to TR with given index 1023 # return 0 on failure 1024 global Travel TRTPoints TRDatum TXT 1025 1026 if { $Travel(nav,pmode) } { 1027 set Travel(nav,mode) exact 1028 } else { 1029 set Travel(nav,mode) approx 1030 set Travel(nav,nxtleg) "" 1031 } 1032 set ps $TRTPoints($ix) ; set trdatum $TRDatum($ix) 1033 set datum $Travel(nav,datum) 1034 set Travel(nav,conv) "" 1035 if { $Travel(nav,mode) == "approx" && [llength $ps] > 150 } { 1036 # convert to list of at most 150 points and follow it 1037 set ps [TRCvTR $ps 150 $trdatum travel] 1038 set Travel(nav,conv) "*" 1039 } 1040 if { $TRDatum($ix) != $datum } { 1041 set ps [ChangeTPsDatum $ps $trdatum $datum] 1042 } 1043 set ps [lindex [TravelNavParams $ps ""] 0] 1044 TravelNavLine $ps "$TXT(TP) $Travel(nav,conv)0" 1045 return 1 1046} 1047 1048proc TravelNavToLN {ix} { 1049 # start navigation to LN with given index 1050 # return 0 on failure 1051 global Travel LNLPoints LNDatum TXT 1052 1053 if { $Travel(nav,pmode) } { 1054 set Travel(nav,mode) exact 1055 } else { 1056 set Travel(nav,mode) approx 1057 set Travel(nav,nxtleg) "" 1058 } 1059 set ps "" 1060 foreach lp $LNLPoints($ix) { 1061 lappend ps [lindex $lp 0] 1062 } 1063 set lndatum $LNDatum($ix) ; set datum $Travel(nav,datum) 1064 set Travel(nav,conv) "" 1065 if { $Travel(nav,mode) == "approx" && [llength $ps] > 150 } { 1066 # convert to list of at most 150 points and follow it 1067 set ps [TRCvTR $ps 150 $lndatum travel] 1068 set Travel(nav,conv) "*" 1069 } 1070 if { $lndatum != $datum } { 1071 set ps [ChangeLPsDatum $ps $lndatum $datum DDD] 1072 } 1073 set ps [lindex [TravelNavParams $ps ""] 0] 1074 TravelNavLine $ps "$TXT(LP) $Travel(nav,conv)0" 1075 return 1 1076} 1077 1078proc TravelNavToGoBack {args} { 1079 # go back using current list of positions 1080 # follow it exactly, from last position to first ($Travel(posns) is 1081 # in that order) 1082 global Travel TXT 1083 1084 set Travel(nav,mode) exact 1085 set Travel(nav,conv) "*" 1086 TravelNavLine $Travel(posns) "$TXT(TP) $Travel(nav,conv)0" 1087 return 1 1088} 1089 1090proc TravelNavLine {ps np} { 1091 # initialize variables to follow a line (RT, TR, LN or log) 1092 # $ps is list of positions 1093 # $np is name of next point 1094 global Travel WConf 1095 1096 set Travel(nav,ps) $ps 1097 set Travel(nav,nxtgoal) [lindex $ps 0] 1098 set Travel(nav,afternxt) [lindex $ps 1] 1099 set Travel(nav,save) "prvWP nxtWP" 1100 set Travel(nav,state) starting 1101 set Travel(nav,ix) 0 1102 if { [set Travel(nav,maxix) [expr [llength $ps]-1]] > 0 } { 1103 set mn $WConf(travel,fr).fctrl.ctrl.mn 1104 $mn entryconfigure $Travel(travel,mnchggoal) -state normal 1105 } 1106 set Travel(info,prvWP) "" 1107 set Travel(info,nxtWP) $np 1108 # used for TR, LN and GoBack 1109 set Travel(ptname) [lindex $np 0] 1110 return 1111} 1112 1113proc TravelNavParams {ps ns} { 1114 # using list of positions and corresponding names (may be void) 1115 # return pair with new lists taking into account the selected 1116 # parameters: 1117 # $Travel(nav,pnear) if to start from nearest point 1118 # $Travel(nav,prvrs) if to follow in reverse order 1119 global Travel TXT 1120 1121 set rev $Travel(nav,prvrs) 1122 if { $Travel(nav,pnear) } { 1123 if { $Travel(prevtime) != -1 } { 1124 set datum $Travel(nav,datum) 1125 set currpos $Travel(prevposn) 1126 set dmin 1e77 ; set ix 0 1127 foreach p $ps { 1128 if { [set nd [ComputeDist $currpos $p $datum]] < $dmin } { 1129 set ixm $ix ; set dmin $nd 1130 } 1131 incr ix 1132 } 1133 if { $rev } { 1134 set rps [lrange $ps 0 $ixm] ; set rns [lrange $ns 0 $ixm] 1135 set ps "" ; set ns "" 1136 foreach p $rps n $rns { 1137 set ps [linsert $ps 0 $p] ; set ns [linsert $ns 0 $n] 1138 } 1139 } else { 1140 set ps [lrange $ps $ixm end] ; set ns [lrange $ns $ixm end] 1141 } 1142 set Travel(nav,conv) "*" 1143 return [list $ps $ns] 1144 } 1145 TravelDoWarn $TXT(trvwnopos) important 1146 } 1147 if { $rev } { 1148 set rps $ps ; set rns $ns 1149 set ps "" ; set ns "" 1150 foreach p $rps n $rns { 1151 set ps [linsert $ps 0 $p] ; set ns [linsert $ns 0 $n] 1152 } 1153 set Travel(nav,conv) "*" 1154 } 1155 return [list $ps $ns] 1156} 1157 1158proc TravelNavCmd {cmd} { 1159 # process user/internal command when navigating 1160 # $cmd in {chggoal, abort, suspend, resume} 1161 global Travel WConf 1162 1163 set mn $WConf(travel,fr).fctrl.ctrl.mn 1164 switch $cmd { 1165 abort { 1166 set Travel(nav) "" 1167 foreach z "chggoal abort suspend resume" { 1168 $mn entryconfigure $Travel(travel,mn$z) -state disabled 1169 } 1170 TravelDisplayChange clear 1171 } 1172 suspend { 1173 set Travel(nav) susp ; set vs "" 1174 foreach e $Travel(nav,save) { lappend vs $Travel(info,$e) } 1175 set Travel(nav,saved) $vs 1176 set Travel(nav,chggstate) \ 1177 [$mn entrycget $Travel(travel,mnchggoal) -state] 1178 $mn entryconfigure $Travel(travel,mnchggoal) -state disabled 1179 $mn entryconfigure $Travel(travel,mnsuspend) -state disabled 1180 $mn entryconfigure $Travel(travel,mnresume) -state normal 1181 TravelDisplayChange suspend 1182 } 1183 resume { 1184 $mn entryconfigure $Travel(travel,mnchggoal) \ 1185 -state $Travel(nav,chggstate) 1186 $mn entryconfigure $Travel(travel,mnsuspend) -state normal 1187 $mn entryconfigure $Travel(travel,mnresume) -state disabled 1188 TravelDisplayChange restore 1189 foreach e $Travel(nav,save) v $Travel(nav,saved) { 1190 set Travel(info,$e) $v 1191 } 1192 set Travel(nav) on 1193 } 1194 chggoal { 1195 if { [TravelChangeGoal] || $Travel(nav,afternxt) == "" } { 1196 $mn entryconfigure $Travel(travel,mnchggoal) -state disabled 1197 } 1198 } 1199 } 1200 return 1201} 1202 1203##### displaying information 1204 1205proc TravelDisplayChange {act} { 1206 # change information on current travel/navigation in displays 1207 # $act in {notraveldata, clear, suspend, restore} 1208 # assume $Travel(_,els) is list of relevant $e used in accessing 1209 # Travel(info,$e), and $Travel(_,cvels) is list of pairs with 1210 # canvas and tag $t of relevant item in canvas (coloured 1211 # $MAPCOLOUR(trv$t) when in normal state) 1212 global Travel WConf COLOUR MAPCOLOUR 1213 1214 set nels $Travel(nav,els) ; set cvels $Travel(nav,cvels) 1215 set fri $WConf(travel,fr).fri 1216 switch $act { 1217 notraveldata { 1218 foreach e $Travel(trav,els) { set Travel(info,$e) "" } 1219 set Travel(info,vel_z) "" 1220 foreach p $Travel(trav,cvels) { 1221 foreach "cv tag" $p {} 1222 foreach dsp $Travel(displays) { 1223 $fri.f$dsp.$cv itemconfigure $tag -fill $COLOUR(dialbg) 1224 $fri.f$dsp.$cv lower $tag 1225 } 1226 } 1227 } 1228 clear { 1229 foreach e $nels { set Travel(info,$e) "" } 1230 foreach p $cvels { 1231 foreach "cv tag" $p {} 1232 foreach dsp $Travel(displays) { 1233 $fri.f$dsp.$cv itemconfigure $tag -fill $COLOUR(dialbg) 1234 $fri.f$dsp.$cv lower $tag 1235 } 1236 } 1237 } 1238 suspend { 1239 foreach e $nels { 1240 foreach dsp $Travel(displays) { 1241 $fri.f$dsp.$e configure -bg red 1242 } 1243 } 1244 foreach p $cvels { 1245 foreach "cv tag" $p {} 1246 foreach dsp $Travel(displays) { 1247 $fri.f$dsp.$cv itemconfigure $tag -fill red 1248 } 1249 } 1250 } 1251 restore { 1252 foreach e $nels { 1253 set Travel(info,$e) "" 1254 foreach dsp $Travel(displays) { 1255 $fri.f$dsp.$e configure -bg $COLOUR(bg) 1256 } 1257 } 1258 foreach p $cvels { 1259 foreach "cv tag" $p {} 1260 foreach dsp $Travel(displays) { 1261 $fri.f$dsp.$cv itemconfigure $tag -fill $MAPCOLOUR(trv$tag) 1262 } 1263 } 1264 } 1265 } 1266 return 1267} 1268 1269proc TravelBadDate {} { 1270 # a message with invalid date was received 1271 global WConf Travel 1272 1273 foreach dsp $Travel(displays) { 1274 $WConf(travel,fr).fri.f$dsp.hour configure -bg orange 1275 } 1276 return 1277} 1278 1279proc TravelData {hms posn lat long fix alt velx vely vel_z trk speed} { 1280 # compute and display new data 1281 # $hms is list with hour, minutes and seconds 1282 # $posn is current position 1283 # $lat, $long in formatted DMS corresponding to $posn 1284 # $fix in {error, _, 2D, 3D, 2D-diff, 3D-diff, GPS, DGPS, Auto, 1285 # simul} 1286 # the following arguments may be "_" for undefined, and stand for 1287 # altitude (m), velocity components (m/s), true course (degrees), 1288 # and speed (km/h) 1289 global WConf Travel RealTimeLogLast COLOUR MAPCOLOUR TXT DSCALE 1290 1291 set fr $WConf(travel,fr) 1292 # fix 1293 if { $fix == "error" } { 1294 if { $Travel(nav) == "on" && $Travel(nav,ok) } { 1295 TravelNavCmd suspend 1296 set Travel(nav,ok) 0 1297 } 1298 foreach dsp $Travel(displays) { $fr.fri.f$dsp.fix configure -bg red } 1299 return 1300 } 1301 if { $fix == "_" || $fix == "simul" } { 1302 set c orange 1303 } else { set c lightgreen } 1304 foreach dsp $Travel(displays) { $fr.fri.f$dsp.fix configure -bg $c } 1305 # time 1306 set hour [eval format %d:%02d:%02d $hms] 1307 foreach dsp $Travel(displays) { 1308 $fr.fri.f$dsp.hour configure -bg $COLOUR(bg) 1309 } 1310 # formatted position 1311 set pos "$lat $long" 1312 # altitude 1313 if { [string first "2D" $fix] == 0 } { 1314 set alt "" ; set vel_z "_" 1315 } elseif { $alt != "_" } { 1316 set alt [expr round($alt)] 1317 } else { set alt "" } 1318 # vertical speed 1319 if { $vel_z == "_" } { 1320 set vel_z "" 1321 foreach dsp $Travel(displays) { 1322 $fr.fri.f$dsp.c_vel_z itemconfigure vel_z -fill $COLOUR(dialbg) 1323 } 1324 } else { 1325 if { $vel_z < 0 } { 1326 if { $Travel(wdgts,vel_z,up) } { 1327 TravelObjectUpDown vel_z 1328 set Travel(wdgts,vel_z,up) 0 1329 } 1330 } elseif { $vel_z > 0 && ! $Travel(wdgts,vel_z,up) } { 1331 TravelObjectUpDown vel_z 1332 set Travel(wdgts,vel_z,up) 1 1333 } 1334 # used below as number! 1335 set vel_z [format "%4d" [expr round($vel_z)]] 1336 } 1337 # speed, true course and horizontal velocity vector 1338 set dtime [expr $RealTimeLogLast-$Travel(prevtime)] 1339 if { $velx == "_" || $vely == "_" } { 1340 if { $speed != "_" && $trk != "_" } { 1341 set a [expr $trk*0.01745329251994329576] 1342 # m/s 1343 set velx [expr $speed*sin($a)/3.6] 1344 set vely [expr $speed*cos($a)/3.6] 1345 } elseif { $dtime < $Travel(nav,maxdtime) } { 1346 # assume $Travel(prevtime) != -1 because $RealTimeLogLast 1347 # is much larger than $Travel(nav,maxdtime) 1348 # m/s 1349 set latp [lindex $Travel(prevposn) 0] 1350 set longp [lindex $Travel(prevposn) 1] 1351 set latc [lindex $posn 0] ; set longc [lindex $posn 1] 1352 set cosmlat [expr cos(($latp+$latc)*0.00872664625997164788)] 1353 set velx [expr 111120.0*($longc-$longp)*$cosmlat/$dtime] 1354 set vely [expr 111120.0*($latc-$latp)/$dtime] 1355 } else { set velx "_" ; set vely "_" } 1356 } 1357 if { $velx != "_" } { 1358 set novel 0 ; set notrk 0 1359 if { $trk == "_" && [set trk [VectorBearing $velx $vely]] == "_" } { 1360 set notrk 1 1361 } 1362 # speed in km/h 1363 if { $speed == "_" } { 1364 set speed [expr sqrt($velx*$velx+$vely*$vely)*3.6] 1365 } 1366 } else { 1367 set novel 1 1368 if { $trk == "_" } { set notrk 1 } else { set notrk 0 } 1369 } 1370 if { $notrk } { 1371 set trk "" 1372 foreach c "trkcts trkcts trn trn" e "trk ctss left right" { 1373 foreach dsp $Travel(displays) { 1374 $fr.fri.f$dsp.c_$c itemconfigure $e -fill $COLOUR(dialbg) 1375 } 1376 } 1377 } else { 1378 TravelTurnObjects nesw $trk 1379 foreach dsp $Travel(displays) { 1380 $fr.fri.f$dsp.c_trkcts itemconfigure trk -fill $MAPCOLOUR(trvtrk) 1381 } 1382 set trk [expr round($trk)] 1383 } 1384 # external representations of values 1385 set fix $TXT(posfix$fix) 1386 if { $speed != "_" } { 1387 set ispeed $speed 1388 # speed in user units /h 1389 set speed [expr round($speed*$DSCALE)] 1390 } else { set speed "" } 1391 foreach e "fix hour speed vel_z pos alt trk" { 1392 set Travel(info,$e) [set $e] 1393 } 1394 # needed for warnings and not set if navigation is off 1395 set trn "" ; set xtk "" 1396 set datum $Travel(nav,datum) 1397 # navigation 1398 if { $Travel(nav) == "on" } { 1399 if { ! $Travel(nav,ok) } { 1400 TravelNavCmd resume 1401 set Travel(nav,ok) 1 1402 } 1403 # compute: ete eta vmg xtk cts trn dist 1404 set es "ete eta xtk dist vmg cts trn" 1405 set rho $Travel(nav,datum,a) 1406 while 1 { 1407 # loop through subsequent points (if any) when arrived 1408 set showcts2 0 1409 set nxtgoal $Travel(nav,nxtgoal) 1410 set db [ComputeDistBear $posn $nxtgoal $datum] 1411 set dtkp [lindex $db 1] 1412 if { $Travel(nav,state) == "starting" } { 1413 set Travel(nav,state) on 1414 set Travel(nav,dtk) $dtkp 1415 set Travel(nav,posn0) $posn 1416 if { [set afternxt $Travel(nav,afternxt)] != "" } { 1417 set Travel(nav,dtkfn) \ 1418 [ComputeBear $nxtgoal $afternxt $datum] 1419 } 1420 } 1421 # distance in km 1422 set idist [lindex $db 0] 1423 # and in user units 1424 set dist [expr $idist*$DSCALE] 1425 foreach "d b" [ComputeDistBear $Travel(nav,posn0) $posn $datum] {} 1426 # in user units 1427 set xtk [expr 1e-3*$rho*$DSCALE*asin(sin(1000.0*$d/$rho)* \ 1428 sin(($b-$Travel(nav,dtk))*0.01745329251994329576))] 1429 set dtype $Travel(nav,dtype) ; set done 0 1430 if { $dist <= $Travel(mindist) } { 1431 # issue arrival warning 1432 if { $Travel(nav,towarn) } { 1433 TravelWarn \ 1434 [format $TXT(trvwarrv) $Travel(info,nxtWP)] normal 1435 } 1436 if { $dtype == "WP" || $dtype == "MOB" } { 1437 set done 1 1438 break 1439 } 1440 if { [set done [TravelChangeGoal]] } { break } 1441 continue 1442 } elseif { $Travel(nav,mode) == "approx" && \ 1443 [set afternxt $Travel(nav,afternxt)] != ""} { 1444 if { $Travel(nav,nxtleg) == "" } { 1445 set Travel(nav,nxtleg) \ 1446 [ComputeDist $nxtgoal $afternxt $datum] 1447 } 1448 set d2 [ComputeDist $posn $afternxt $datum] 1449 set sd [expr $idist+$Travel(nav,nxtleg)] 1450 if { $d2 < $Travel(chggparam)*$sd } { 1451 # change goal 1452 if { [set done [TravelChangeGoal]] } { break } 1453 continue 1454 } 1455 if { $d2 < $Travel(chggwparam)*$sd } { 1456 # show arrow pointing to goal after next 1457 set showcts2 1 1458 } 1459 } 1460 break 1461 } 1462 if { $done } { 1463 foreach e "ete eta xtk dist" { set $e 0 } 1464 foreach e "vmg cts trn" { set $e "" } 1465 foreach dsp $Travel(displays) { 1466 $fr.fri.f$dsp.c_trkcts itemconfigure ctss -fill $COLOUR(dialbg) 1467 $fr.fri.f$dsp.c_trn itemconfigure left -fill $COLOUR(dialbg) 1468 $fr.fri.f$dsp.c_trn itemconfigure right -fill $COLOUR(dialbg) 1469 } 1470 set showcts2 0 1471 } elseif { $notrk } { 1472 foreach e "ete eta vmg cts trn" { set $e "" } 1473 set showcts2 0 1474 } else { 1475 # in km/h 1476 set vmg [expr $ispeed*cos(abs($dtkp-$trk)*0.01745329251994329576)] 1477 if { $vmg < 0.001 } { 1478 set ete [set eta "######"] 1479 set cts $dtkp 1480 } else { 1481 # seconds 1482 set ete [expr round(3600.0*$idist/$vmg)] 1483 # time from receiver; cannot use computer time 1484 # and Tcl "clock" procedure 1485 foreach "h m s" $hms {} 1486 incr s $ete ; incr m [expr $s/60] 1487 set s [expr $s%60] ; set h [expr ($h+$m/60)%24] 1488 set m [expr $m%60] 1489 set eta [format %d:%02d:%02d $h $m $s] 1490 set ete [clock format $ete -format %T] 1491 # no computation of drift 1492 set cts $dtkp 1493 } 1494 set trn [TravelLeftRight trn [expr $cts-$trk]] 1495 TravelTurnArrow cts $trn 1496 set vmg [expr round($vmg*$DSCALE)] 1497 } 1498 foreach e "dist xtk" { 1499 set $e [expr round([set $e])] 1500 } 1501 if { $showcts2 } { 1502 TravelTurnArrow cts2 \ 1503 [expr [ComputeBear $posn $afternxt $datum]-$trk] 1504 } else { 1505 foreach dsp $Travel(displays) { 1506 $fr.fri.f$dsp.c_trkcts itemconfigure cts2 -fill $COLOUR(dialbg) 1507 $fr.fri.f$dsp.c_trkcts lower cts2 trk 1508 } 1509 } 1510 foreach e $es { set Travel(info,$e) [set $e] } 1511 } 1512 # warnings (see initialization of Travel(warn:...) for list of 1513 # variables assumed to be defined here 1514 foreach e $Travel(warnings) { 1515 if { $Travel(warn,$e) && [expr $Travel(warn:$e,cond)] } { 1516 eval TravelWarn $Travel(warn:$e,cont) $Travel(warn,$e,level) 1517 } 1518 } 1519 # saving current position and time-stamp 1520 set Travel(prevposn) $posn ; set Travel(prevtime) $RealTimeLogLast 1521 set Travel(posns) [linsert $Travel(posns) 0 $posn] 1522 1523 update idletasks 1524 return 1525} 1526 1527proc TravelChangeGoal {} { 1528 # change leg when following RT, TR or LN 1529 # return 1 if there are no more points 1530 global Travel TXT 1531 1532 if { [set tix $Travel(nav,ix)] >= $Travel(nav,maxix) } { return 1 } 1533 if { $Travel(nav,dtype) == "RT" } { 1534 set Travel(info,prvWP) [lindex $Travel(nav,wpns) $tix] 1535 set Travel(info,nxtWP) [lindex $Travel(nav,wpns) [incr tix]] 1536 } else { 1537 # TR, LN or GoBack 1538 set Travel(info,prvWP) "$Travel(ptname) $Travel(nav,conv)$tix" 1539 set Travel(info,nxtWP) "$Travel(ptname) $Travel(nav,conv)[incr tix]" 1540 } 1541 # issue change warning 1542 if { $Travel(nav,towarn) } { 1543 TravelWarn [format $TXT(trvwchg) $Travel(info,nxtWP)] info 1544 } 1545 set Travel(nav,nxtgoal) $Travel(nav,afternxt) 1546 set Travel(nav,afternxt) [lindex $Travel(nav,ps) [expr $tix+1]] 1547 set Travel(nav,nxtleg) "" 1548 set Travel(nav,state) starting 1549 set Travel(nav,ix) $tix 1550 return 0 1551} 1552 1553##### graphical 1554 1555proc TravelTurnArrow {el trk} { 1556 # turn arrow to point to $trk degrees and colour it 1557 # $el is used in indexing $Travel(wdgts,$el) and $MAPCOLOUR(trv$el); 1558 # the former is a list with canvas id, list of coordinates from origin 1559 # (x_m, y_m) of arrow pointing to 0, and x_m and y_m (coordinates 1560 # of rotation centre) 1561 # of x and y) 1562 global Travel MAPCOLOUR 1563 1564 set rad [expr (360-$trk)*0.01745329251994329576] 1565 set cos [expr cos($rad)] ; set sin [expr sin($rad)] 1566 foreach "cid cs0 xm ym" $Travel(wdgts,$el) {} 1567 set cs "" 1568 foreach "x y" $cs0 { 1569 lappend cs [expr round($xm+$x*$cos+$y*$sin)] \ 1570 [expr round($ym-$x*$sin+$y*$cos)] 1571 } 1572 foreach dsp $Travel(displays) { 1573 set cv $Travel(travel,dsppfr).f$dsp.c_$cid 1574 eval $cv coords $el $cs 1575 $cv itemconfigure $el -fill $MAPCOLOUR(trv$el) 1576 $cv raise $el 1577 } 1578 update idletasks 1579 return 1580} 1581 1582proc TravelTurnObjects {el trk} { 1583 # turn objects $trk degrees from vertical north 1584 # $el is used in indexing $Travel(wdgts,$el) which is a list with canvas 1585 # id, x_m and y_m (coordinates of rotation centre), followed by 1586 # object tag and list of coordinates from origin (x_m, y_m) of 1587 # object at initial position for each object 1588 global Travel 1589 1590 set dsppfr $Travel(travel,dsppfr) 1591 set rad [expr $trk*0.01745329251994329576] 1592 set cos [expr cos($rad)] ; set sin [expr sin($rad)] 1593 foreach "cid xm ym" $Travel(wdgts,$el) { break } 1594 foreach "tag cs0" [lrange $Travel(wdgts,$el) 3 end] { 1595 set cs "" 1596 foreach "x y" $cs0 { 1597 lappend cs [expr round($xm+$x*$cos+$y*$sin)] \ 1598 [expr round($ym-$x*$sin+$y*$cos)] 1599 } 1600 foreach dsp $Travel(displays) { 1601 eval $dsppfr.f$dsp.c_$cid coords $tag $cs 1602 } 1603 } 1604 update idletasks 1605 return 1606} 1607 1608proc TravelLeftRight {el diff} { 1609 # change colours of pair of left-right arrows 1610 # $el is used the canvas id and in indexing $MAPCOLOUR(trv$el); 1611 # the canvas has two items with tags "left" and "right" 1612 # $diff is desired bearing minus current bearing (both in 0..359) 1613 # assume $COLOUR(dialbg) to be the "off" colour 1614 # return turn in -180..180 1615 global Travel MAPCOLOUR COLOUR 1616 1617 set cu $MAPCOLOUR(trv$el) ; set cd $COLOUR(dialbg) 1618 set dir right ; set odir left 1619 if { $diff == 180 } { 1620 set cd $cu 1621 } elseif { $diff == 0 } { 1622 set cu $cd 1623 } else { 1624 if { $diff > 180 } { 1625 incr diff -360 1626 } elseif { $diff < -180 } { incr diff 360 } 1627 if { $diff < 0 } { 1628 set dir left ; set odir right 1629 } 1630 } 1631 foreach dsp $Travel(displays) { 1632 set cv $Travel(travel,dsppfr).f$dsp.c_$el 1633 $cv itemconfigure $dir -fill $cu 1634 $cv itemconfigure $odir -fill $cd 1635 } 1636 return $diff 1637} 1638 1639proc TravelObjectUpDown {el} { 1640 # turn canvas object upside down and colour it 1641 # $el is used as the canvas id and in indexing $Travel(wdgts,$el) and 1642 # $MAPCOLOUR(trv$el) 1643 # $Travel(wdgts,$el) is the sum of minimum and maximum y 1644 # the object is turned by changing the signs of the y-coordinates and 1645 # adding this sum 1646 global Travel MAPCOLOUR 1647 1648 set cs "" 1649 set sum $Travel(wdgts,$el) 1650 set x 1 1651 set cv $Travel(travel,dsppfr).f1.c_$el 1652 foreach xory [$cv coords $el] { 1653 if { $x } { lappend cs $xory } else { 1654 lappend cs [expr $sum-$xory] 1655 } 1656 set x [expr 1-$x] 1657 } 1658 foreach dsp $Travel(displays) { 1659 set cv $Travel(travel,dsppfr).f$dsp.c_$el 1660 $cv coords $el $cs 1661 $cv itemconfigure $el -fill $MAPCOLOUR(trv$el) 1662 } 1663 update idletasks 1664 return 1665} 1666 1667