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: wrtdials.tcl 22# Last change: 6 October 2013 23# 24# Includes contributions by 25# - Brian Baulch (baulchb _AT_ onthenet.com.au) marked "BSB contribution" 26# - Alessandro Palmas (alpalmas _AT_ tin.it) marked "AP contribution" 27# - Stefan Heinen (stefan.heinen _AT_ djh-freeweb.de) marked "SH contribution" 28# - Martin Buck (m _AT_ rtin-buck.de) marked "MB contribution" 29# - Jean H Theoret (ve2za _AT_ rac.ca) marked "JHT contribution" 30# - Benoit Steiner (benetsteph _AT_ free.fr) marked "BS contribution" 31# - Rudolf Martin (rudolf.martin _AT_ gmx.de) marked "RM contribution" 32# 33 34# BSB contribution: WPNum field accomodated 35proc GMWPoint {index options data} { 36 # create dialog window for editing/showing data of WP with given index 37 # $index is -1 if this is a new WP 38 # $options is a list of buttons to display; 39 # an empty list means no editing; supported options are: 40 # cancel, create, change, revert, forget 41 # change and forget assume $index != -1 42 # see proc GMButton for further details 43 # if $options is empty, $index cannot be -1 as this is not a new WP 44 # the only button is OK, and only binding: return to destroy 45 # order of elements in $data list reflects order in $Storage(WP) 46 # which is used below 47 # return window path 48 global GMEd MapLoading COLOUR DPOSX DPOSY NAMEWIDTH COMMENTWIDTH \ 49 CREATIONDATE OBSWIDTH OBSHEIGHT TXT ICONWIDTH ICONHEIGHT \ 50 MAXMENUITEMS DISPOPTS ChangedPosn UNIX ALUNIT 51 52 foreach "name num commt obs pformt posn datum date symbol dispopt \ 53 alt mbak hidden displ" $data {} 54 if { $options != "" } { 55 if { [winfo exists .gmWP] } { Raise .gmWP ; bell ; return .gmWP } 56 set ed 1 ; set st normal 57 set w .gmWP 58 set GMEd(WP,Index) $index ; set GMEd(WP,Num) $num 59 set GMEd(WP,Datum) $datum ; set GMEd(WP,Displ) $displ 60 set GMEd(WP,Symbol) $symbol ; set GMEd(WP,DispOpt) $dispopt 61 set GMEd(WP,Alt) $alt ; set GMEd(WP,MBack) $mbak 62 set GMEd(WP,Hidden) $hidden 63 # this will be set to 1 if the user edits the position entries 64 # and will contain current position (possibly "") otherwise; 65 # use of this variable assumes a single .gmWP window at a time! 66 set ChangedPosn $posn 67 # this depends on Storage(WP) 68 set GMEd(WP,Data) $data 69 set GMEd(WP,MapChg) 0 70 set x $DPOSX ; set y $DPOSY 71 } else { 72 set ed 0 ; set st disabled 73 set w .gmWPsh$index 74 if { [winfo exists $w] } { destroy $w } 75 incr GMEd(WP,Show) 76 set x [expr $DPOSX+45*(1+$GMEd(WP,Show) % 5)] 77 set y [expr $DPOSY+45*(1+$GMEd(WP,Show) % 5)] 78 } 79 80 GMToplevel $w waypoint +$x+$y {} {} {} 81 if { ! $UNIX } { 82 # SH contribution 83 focus $w 84 } 85 if { ! $ed } { 86 wm protocol $w WM_DELETE_WINDOW "destroy $w" 87 bind $w <Key-Return> "destroy $w" 88 } else { 89 wm protocol $w WM_DELETE_WINDOW { GMButton WP cancel } 90 } 91 92 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 93 94 frame $w.fr.fr1 -relief flat -borderwidth 0 95 label $w.fr.fr1.ntitle -text "$TXT(name):" 96 entry $w.fr.fr1.id -width $NAMEWIDTH -exportselection 1 97 ShowTEdit $w.fr.fr1.id $name $ed 98 label $w.fr.fr1.dtitle -text "$TXT(created):" 99 entry $w.fr.fr1.date -width 18 -exportselection 1 100 ShowTEdit $w.fr.fr1.date $date $ed 101 if { $ed } { 102 ShowPosnDatum $w.fr $pformt [list $posn] GMWPChangeDatum GMEd \ 103 GMEd(WP,Datum) $st $ed ChangedPosn 104 } else { 105 ShowPosnDatum $w.fr $pformt [list $posn] "" "" $datum $st 0 nil 106 } 107 108 frame $w.fr.fr11 -relief flat -borderwidth 0 109 label $w.fr.fr11.atit -text "$TXT(alt) ($ALUNIT):" 110 entry $w.fr.fr11.alt -width 7 -exportselection 1 111 set valt [UserAltitude $alt] 112 ShowTEdit $w.fr.fr11.alt $valt $ed 113 114 frame $w.fr.fr2 -relief flat -borderwidth 0 115 label $w.fr.fr2.ctitle -text "$TXT(cmmt):" 116 entry $w.fr.fr2.commt -width $COMMENTWIDTH -exportselection 1 117 ShowTEdit $w.fr.fr2.commt $commt $ed 118 if { $hidden != "" } { 119 button $w.fr.fr2.hidd -text $TXT(hiddendata) \ 120 -command "$w.fr.fr2.hidd configure -state normal ; \ 121 ShowHiddenData WP {$hidden}" 122 } 123 124 frame $w.fr.fr3 -relief flat -borderwidth 0 125 label $w.fr.fr3.obstit -text "$TXT(rmrk):" 126 text $w.fr.fr3.obs -wrap word -width $OBSWIDTH -height $OBSHEIGHT \ 127 -exportselection true 128 $w.fr.fr3.obs insert 0.0 $obs 129 $w.fr.fr3.obs configure -state $st 130 TextBindings $w.fr.fr3.obs 131 132 frame $w.fr.fr4 -relief flat -borderwidth 0 133 menubutton $w.fr.fr4.symb -text $TXT(symbol) -relief raised \ 134 -direction below -menu $w.fr.fr4.symb.m -state $st 135 set mw $w.fr.fr4.symb.m 136 menu $mw -tearoff 0 137 FillSymbolsMenu $mw ChangeWPSymbol 138 canvas $w.fr.fr4.symbim -width $ICONWIDTH -height [expr $ICONHEIGHT+2] 139 foreach "syim sytxt" [SymbolImageName $symbol] {} 140 $w.fr.fr4.symbim create image 1 5 -anchor nw -image $syim 141 label $w.fr.fr4.symbname -text $sytxt 142 menubutton $w.fr.fr4.dispopt -text $TXT(dispopt): -relief raised \ 143 -direction below -menu $w.fr.fr4.dispopt.m -state $st 144 set mw $w.fr.fr4.dispopt.m 145 menu $mw -tearoff 0 146 foreach opt $DISPOPTS { 147 $mw add command -label $TXT(DISP$opt) -command "ChangeWPDispOpt $opt" 148 } 149 label $w.fr.fr4.dispo -text $TXT(DISP$dispopt) -width 15 150 151 frame $w.fr.fr5 152 CreateMBackWidgets WP $w.fr.fr5 $mbak $ed 153 154 # frame used for plug-ins (see array PLGSWelcomed, plugins.tcl) 155 frame $w.fr.fr6 156 button $w.fr.fr6.route -text $TXT(nameRT) \ 157 -command "ShowRTForWP $index" 158 menubutton $w.fr.fr6.comp -text $TXT(comp) -relief raised \ 159 -direction below -menu $w.fr.fr6.comp.m 160 menu $w.fr.fr6.comp.m -tearoff 0 161 menu $w.fr.fr6.comp.m.mothers -tearoff 0 162 $w.fr.fr6.comp.m add command -label $TXT(distazim) \ 163 -command "ChItemsCall WP single GMCompDistBearWP $w $ed" 164 $w.fr.fr6.comp.m add command -label $TXT(nearestWPs) \ 165 -command "GMWPNearest $w $ed" 166 button $w.fr.fr6.newat -text $TXT(newWPatdb) \ 167 -command "CreateWPAtDistBear $index" 168 169 frame $w.fr.frsel -relief flat -borderwidth 0 -background $COLOUR(selbg) 170 frame $w.fr.frdw 171 if { $ed } { 172 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 173 -variable GMEd(WP,Displ) -onvalue 1 -offvalue 0 \ 174 -selectcolor $COLOUR(check) 175 if { $MapLoading != 0 } { 176 $w.fr.frdw.displayed configure -state disabled 177 } 178 set c -1 179 set b $w.fr.frsel.b 180 foreach e $options { 181 button $b$e -text $TXT($e) \ 182 -command "$b$e configure -state normal ; GMButton WP $e" 183 grid $b$e -row 0 -column [incr c] -padx 3 184 } 185 } else { 186 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 187 -selectcolor $COLOUR(check) -state disabled 188 if { $displ } { $w.fr.frdw.displayed select } 189 button $w.fr.frsel.b -text $TXT(ok) -command "destroy $w" 190 pack $w.fr.frsel.b 191 } 192 193 pack $w.fr -side top 194 grid $w.fr.fr1.ntitle -row 0 -column 0 -sticky nesw 195 grid $w.fr.fr1.id -row 0 -column 1 -sticky nesw 196 if { $CREATIONDATE } { 197 grid $w.fr.fr1.dtitle -row 1 -column 0 -sticky nesw 198 grid $w.fr.fr1.date -row 1 -column 1 -sticky nesw 199 } 200 grid $w.fr.fr11.atit -row 0 -column 0 -sticky nesw 201 grid $w.fr.fr11.alt -row 0 -column 1 -sticky nesw 202 set r 0 203 if { $hidden != "" } { 204 grid $w.fr.fr2.hidd -row 0 -column 0 -sticky nesw 205 incr r 206 } 207 grid $w.fr.fr2.ctitle -row $r -column 0 -sticky nesw 208 grid $w.fr.fr2.commt -row $r -column 1 -sticky nesw 209 210 grid $w.fr.fr3.obstit -row 0 -column 0 -sticky nesw 211 grid $w.fr.fr3.obs -row 0 -column 1 -sticky nesw 212 213 set c -1 214 foreach x "symb symbim symbname dispopt dispo" { 215 grid $w.fr.fr4.$x -row 0 -column [incr c] -sticky nesw -padx 3 216 } 217 218 set c -1 219 foreach x "route comp newat" { 220 grid $w.fr.fr6.$x -row 0 -column [incr c] -sticky nesw -padx 10 221 } 222 pack $w.fr.frdw.displayed 223 224 set r -1 225 set d 2 226 foreach x "fr1 frp frd fr11 fr2 fr3 fr4 fr5 fr6 frdw frsel" \ 227 y "$d $d 0 0 $d 0 $d $d $d $d $d" { 228 if { $y == 0 } { 229 grid $w.fr.$x -row [incr r] -column 0 -sticky nesw 230 } else { 231 grid $w.fr.$x -row [incr r] -column 0 -sticky nesw -pady $y 232 } 233 } 234 235 AttachPlugIns $w 236 237 update idletasks 238 return $w 239} 240 241# BSB contribution: indices in GMEd(WP,Data) affected by new WPNum field 242proc RevertWP {} { 243 # reset data in WP edit window to initial values 244 # this depends on Storage(WP) 245 global GMEd INVTXT ChangedPosn POSTYPE 246 247 set data $GMEd(WP,Data) 248 .gmWP.fr.fr1.id delete 0 end 249 .gmWP.fr.fr1.id insert 0 [lindex $data 0] 250 .gmWP.fr.fr2.commt delete 0 end 251 .gmWP.fr.fr2.commt insert 0 [lindex $data 2] 252 .gmWP.fr.fr3.obs delete 1.0 end 253 .gmWP.fr.fr3.obs insert 1.0 [lindex $data 3] 254 set pft $POSTYPE($INVTXT([.gmWP.fr.frp.pfmt cget -text])) 255 set opf [lindex $data 4] ; set t $POSTYPE($opf) 256 set p [lindex $data 5] 257 if { $pft == $t } { 258 RevertPos .gmWP.fr.frp.frp1 $opf $t $p 259 } else { 260 RedrawPos .gmWP.fr.frp.frp1 $opf $p ChangedPosn normal 261 } 262 set ChangedPosn $p 263 set GMEd(WP,Datum) [lindex $data 6] 264 .gmWP.fr.fr1.date delete 0 end 265 .gmWP.fr.fr1.date insert 0 [lindex $data 7] 266 ChangeWPSymbol [lindex $data 8] 267 ChangeWPDispOpt [lindex $data 9] 268 .gmWP.fr.fr11.alt delete 0 end 269 .gmWP.fr.fr11.alt insert 0 [UserAltitude [lindex $data 10]] 270 set GMEd(WP,MBack) [lindex $data 11] 271 # hidden: lindex $data 12 272 set GMEd(WP,Displ) [lindex $data end] 273 if { $GMEd(WP,Displ) } { 274 .gmWP.fr.frdw.displayed select 275 } else { 276 .gmWP.fr.frdw.displayed deselect 277 } 278 return 279} 280 281proc GMWPCheck {} { 282 # check validity of data in WP edit window 283 # this depends on Storage(WP) 284 global GMEd INVTXT KEEPHIDDEN MESS 285 # BSB contribution: WPNum 286 287 set r [CheckEntries GMMessage nil "{.gmWP.fr.fr1.id CheckName} \ 288 {.gmWP.fr.fr2.commt CheckComment} {.gmWP.fr.fr1.date CheckDate}"] 289 if { $r == "nil" } { return nil } 290 set p [PosnGetCheck .gmWP.fr.frp.frp1 $GMEd(WP,Datum) GMMessage \ 291 ChangedPosn] 292 if { $p == "nil" } { return nil } 293 set valt [string trim [.gmWP.fr.fr11.alt get]] 294 if { [set alt [AltitudeList $valt]] == "nil" } { 295 GMMessage $MESS(badalt) 296 return nil 297 } 298 if { $GMEd(WP,Hidden) != "" } { 299 switch $KEEPHIDDEN { 300 never { set GMEd(WP,Hidden) "" } 301 always { } 302 ask { 303 if { [GMConfirm $MESS(nohidden)] } { set GMEd(WP,Hidden) "" } 304 } 305 } 306 } 307 lappend r $GMEd(WP,Symbol) $GMEd(WP,DispOpt) $alt $GMEd(WP,MBack) \ 308 $GMEd(WP,Hidden) $GMEd(WP,Displ) 309 set nb [CheckNB [.gmWP.fr.fr3.obs get 0.0 end]] 310 set GMEd(WP,MapChg) 1 311 set r [linsert $r 2 $nb $INVTXT([.gmWP.fr.frp.pfmt cget -text]) \ 312 $p $GMEd(WP,Datum)] 313 # BSB contribution 314 return [linsert $r 1 $GMEd(WP,Num)] 315} 316 317proc ShowRTForWP {ix} { 318 # let user select and open RT having WP of given index 319 global WPRoute TXT LISTWIDTH 320 321 if { $ix == -1 } { return } 322 set rtname [GMChooseFrom single [list $TXT(select) $TXT(nameRT)] \ 323 $LISTWIDTH $WPRoute($ix) $WPRoute($ix)] 324 if { $rtname == "" } { return } 325 if { [set ix [IndexNamed RT $rtname]] != -1 } { 326 OpenItem RT $ix 327 } else { bell } 328 return 329} 330 331proc GMWPChangeDatum {datum args} { 332 # change datum of WP being edited 333 # $args is not used but is needed as this is called-back from a menu 334 335 ChangeDatum $datum GMEd GMEd(WP,Datum) ChangedPosn .gmWP.fr.frp normal 336 return 337} 338 339proc ChangeWPSymbol {symbol args} { 340 # change symbol of WP being edited 341 # $args not used, but called back like this 342 global GMEd 343 344 set GMEd(WP,Symbol) $symbol 345 foreach "syim sytxt" [SymbolImageName $symbol] {} 346 set w .gmWP 347 $w.fr.fr4.symbim delete all 348 $w.fr.fr4.symbim create image 1 5 -anchor nw -image $syim 349 $w.fr.fr4.symbname configure -text $sytxt 350 return 351} 352 353proc ChangeWPDispOpt {opt} { 354 # change display option of WP being edited 355 global GMEd TXT 356 357 set GMEd(WP,DispOpt) $opt 358 .gmWP.fr.fr4.dispo configure -text $TXT(DISP$opt) 359 return 360} 361 362proc GMCompDistBearWP {window editing wp2} { 363 # create dialog to show distance and bearing from WP of a edit/show 364 # window to another WP with name $wp2 365 global GMEd WPPosn WPDatum DPOSX DPOSY COLOUR MESS TXT DSCALE DTUNIT \ 366 FixedFont 367 368 set w ${window}.topcdb 369 if { [winfo exists $w] } { Raise $w ; bell ; return } 370 371 set wp1 [$window.fr.fr1.id get] 372 if { $editing } { 373 set p1 [PosnGetCheck $window.fr.frp.frp1 $GMEd(WP,Datum) GMMessage \ 374 ChangedPosn] 375 if { $p1 == "nil" } { return } 376 set d1 $GMEd(WP,Datum) 377 if { $wp1 == "" } { set wp1 "(???)" } 378 } else { 379 set ix1 [IndexNamed WP $wp1] 380 set p1 $WPPosn($ix1) ; set d1 $WPDatum($ix1) 381 } 382 set ix2 [IndexNamed WP $wp2] 383 set p2 $WPPosn($ix2) ; set d2 $WPDatum($ix2) 384 set db [CompDistBearDatums $p1 $d1 $p2 $d2] 385 set dist [format "%8.2f" [expr [lindex $db 0]*$DSCALE]] 386 set bear [format "%5d" [lindex $db 1]] 387 388 GMToplevel $w distazim +[expr $DPOSX+100]+[expr $DPOSY+100] {} \ 389 [list WM_DELETE_WINDOW "destroy $w"] {} 390 391 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 392 label $w.fr.fromto -text [format $TXT(fromto) $wp1 $wp2] 393 frame $w.fr.fr1 -relief flat -borderwidth 0 394 label $w.fr.fr1.dist -text "$dist $DTUNIT" -width 15 -font $FixedFont \ 395 -anchor w 396 label $w.fr.fr1.bear -text "$bear $TXT(degrees)" -width 15 \ 397 -font $FixedFont -anchor w 398 frame $w.fr.frsel -relief flat -borderwidth 0 399 button $w.fr.frsel.save -text "$TXT(save) ..." \ 400 -command "SaveFile comp WPDistBear $w ; \ 401 $w.fr.frsel.save configure -state normal" 402 button $w.fr.frsel.ok -text $TXT(ok) -command "destroy $w" 403 404 pack $w.fr -side top 405 pack $w.fr.fr1.dist $w.fr.fr1.bear -side top -pady 2 406 pack $w.fr.frsel.save $w.fr.frsel.ok -side left -padx 5 407 pack $w.fr.fromto $w.fr.fr1 $w.fr.frsel -side top 408 return 409} 410 411proc GMWPNearest {window editing} { 412 # create dialog to show nearest WPs to WP of given edit/show window 413 # actually compute distances and bearings to all other WPs and sort 414 # by increasing distance 415 global GMEd WPName WPPosn WPDatum DPOSX DPOSY COLOUR MESS TXT LsW \ 416 DSCALE FixedFont 417 418 set w ${window}.topcn 419 if { [winfo exists $w] } { Raise $w ; bell ; return } 420 421 set wp1 [$window.fr.fr1.id get] 422 if { $editing } { 423 set p1 [PosnGetCheck $window.fr.frp.frp1 $GMEd(WP,Datum) GMMessage \ 424 ChangedPosn] 425 if { $p1 == "nil" } { return } 426 set d1 $GMEd(WP,Datum) ; set ix1 -1 427 if { $wp1 == "" } { set wp1 "(???)" } 428 } else { 429 set ix1 [IndexNamed WP $wp1] 430 set p1 $WPPosn($ix1) ; set d1 $WPDatum($ix1) 431 } 432 433 GMToplevel $w distazim +[expr $DPOSX+100]+[expr $DPOSY+100] {} \ 434 [list WM_DELETE_WINDOW "destroy $w"] {} 435 436 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 437 label $w.fr.from -text [format $TXT(fromto) $wp1 ""] 438 frame $w.fr.fr1 -relief flat -borderwidth 0 439 frame $w.fr.fr1.frtits -relief flat -borderwidth 0 440 label $w.fr.fr1.frtits.fill -width 2 -font $FixedFont 441 frame $w.fr.fr1.frbx -relief flat -borderwidth 0 442 set h [$LsW.frlWP.frl.box size] 443 if { $h > 15 } { set h 15 } 444 foreach b "xn xd xb" m "8 8 4" t $TXT(WPnearflds) { 445 label $w.fr.fr1.frtits.tit$b -width $m -text $t -font $FixedFont 446 listbox $w.fr.fr1.frbx.b$b -height $h -width $m -relief flat \ 447 -yscrollcommand "$w.fr.fr1.frbx.bscr set" \ 448 -selectmode single -exportselection false -font $FixedFont 449 bind $w.fr.fr1.frbx.b$b <Double-1> { 450 set n [[winfo parent %W].bxn get [%W nearest %y]] 451 if { $n != "" } { 452 OpenItem WP [IndexNamed WP $n] 453 } 454 } 455 bind $w.fr.fr1.frbx.b$b <Button-3> { 456 set n [[winfo parent %W].bxn get [%W nearest %y]] 457 if { $n != "" } { 458 ToggleDisplayNamed WP $n 459 } 460 } 461 bind $w.fr.fr1.frbx.b$b <Button-1> { 462 MultSelect [winfo parent %W] [%W nearest %y] {bxn bxd bxb} 463 } 464 } 465 # BSB contribution: wheelmouse scrolling 466 set boxes [list $w.fr.fr1.frbx.bxn $w.fr.fr1.frbx.bxd $w.fr.fr1.frbx.bxb] 467 scrollbar $w.fr.fr1.frbx.bscr -command [list ScrollMany $boxes] 468 Mscroll $boxes 469 470 set wpixs [array names WPName] 471 if { [lindex $wpixs 100] != "" } { 472 set slow 1 473 set slowid [SlowOpWindow $TXT(comp)] 474 } else { 475 set slow 0 476 SetCursor . watch 477 } 478 SetDatumData $d1 479 set i 0 480 foreach ix2 $wpixs { 481 if { $wp1 != $WPName($ix2) } { 482 if { $slow && [SlowOpAborted] } { 483 destroy $w 484 SlowOpFinish $slowid "" 485 return 486 } 487 set p2 $WPPosn($ix2) ; set d2 $WPDatum($ix2) 488 if { $d1 != $d2 } { 489 set p2 [ToDatum [lindex $p2 0] [lindex $p2 1] $d2 $d1] 490 } 491 set db [ComputeDistBearFD $p1 $p2] 492 set d [expr [lindex $db 0]*$DSCALE] 493 set dist [format "%8.2f" $d] 494 set bear [format "%4d" [lindex $db 1]] 495 if { $i } { 496 set i0 0 ; set in $i 497 while { 1 } { 498 set z [expr int(($in-$i0)/2)+$i0] 499 if { [set m [$w.fr.fr1.frbx.bxd get $z]] > $d } { 500 if { $z==0 || \ 501 [$w.fr.fr1.frbx.bxd get [expr $z-1]] <= $d } { 502 break 503 } 504 set in $z 505 } elseif { $m < $d } { 506 if { $z==[expr $in-1] } { 507 set z end 508 break 509 } 510 set i0 $z 511 } else { break } 512 } 513 } else { 514 set z 0 515 } 516 $w.fr.fr1.frbx.bxn insert $z $WPName($ix2) 517 $w.fr.fr1.frbx.bxd insert $z $dist 518 $w.fr.fr1.frbx.bxb insert $z $bear 519 incr i 520 } 521 } 522 if { $slow } { 523 SlowOpFinish $slowid "" 524 } else { ResetCursor . } 525 526 frame $w.fr.frsel -relief flat -borderwidth 0 527 button $w.fr.frsel.save -text "$TXT(save) ..." \ 528 -command "SaveFile comp WPNearest $w ; \ 529 $w.fr.frsel.save configure -state normal" 530 button $w.fr.frsel.ok -text $TXT(ok) -command "destroy $w" 531 532 pack $w.fr -side top 533 pack $w.fr.fr1.frtits.titxn $w.fr.fr1.frtits.titxd \ 534 $w.fr.fr1.frtits.titxb $w.fr.fr1.frtits.fill -side left -fill y 535 pack $w.fr.fr1.frbx.bxn $w.fr.fr1.frbx.bxd $w.fr.fr1.frbx.bxb \ 536 $w.fr.fr1.frbx.bscr -side left -fill y 537 pack $w.fr.frsel.save $w.fr.frsel.ok -side left -padx 5 538 pack $w.fr.fr1.frtits $w.fr.fr1.frbx -side top -fill y -pady 1 539 pack $w.fr.from $w.fr.fr1 $w.fr.frsel -side top -pady 3 540 541 return 542} 543 544proc GMRoute {index options data} { 545 # create dialog window for editing/showing data of RT with given index 546 # including computed distances and bearings 547 # $index is -1 if this is a new RT 548 # $options is a list of buttons to display; 549 # an empty list means no editing; supported options are: 550 # cancel, create, change, revert, forget 551 # change and forget assume $index != -1 552 # see proc GMButton for further details 553 # if $options is empty, $index cannot be -1 as this is not a new RT 554 # the only button is OK, and only binding: return to destroy 555 # an editing window created when $MapMakingRT is true will have some 556 # of its buttons disabled 557 # order of elements in $data list reflects order in $Storage(RT) 558 # which is used below 559 # return window path 560 global GMEd DPOSX DPOSY DPOSRTMAP COLOUR LISTHEIGHT NAMEWIDTH \ 561 COMMENTWIDTH OBSWIDTH OBSHEIGHT TXT DTUNIT MapMakingRT MapLoading \ 562 Map MapWidth UNIX FixedFont 563 564 foreach "number commt obs wps stages width colour mbak displ" $data {} 565 if { $options != "" } { 566 if { [winfo exists .gmRT] } { Raise .gmRT ; bell ; return .gmRT } 567 set ed 1 ; set st normal ; set stmm normal 568 if { $MapMakingRT } { 569 set stmm disabled 570 set x [expr [winfo rootx $Map]+$MapWidth+$DPOSRTMAP] 571 } else { 572 set x $DPOSX 573 } 574 set y $DPOSY 575 set w .gmRT 576 set GMEd(RT,Index) $index ; set GMEd(RT,Width) $width 577 set GMEd(RT,Colour) $colour ; set GMEd(RT,MBack) $mbak 578 set GMEd(RT,WPoints) $wps ; set GMEd(RT,Displ) $displ 579 set GMEd(RT,MapChg) 0 580 # this depends on Storage(RT) 581 set GMEd(RT,Data) $data 582 # GMEd(RT,windows) is a list of windows that should be closed 583 # when the route is changed such as the plot windows created by 584 # procs Hgraph and HG3D (elevation.tcl) 585 # It should be accessed by calling proc ManageAuxWindows 586 set GMEd(RT,windows) {} 587 } else { 588 set ed 0 ; set st disabled ; set stmm disabled 589 set w .gmRTsh$index 590 if { [winfo exists $w] } { destroy $w } 591 incr GMEd(RT,Show) 592 set x [expr $DPOSX+50*(1+$GMEd(RT,Show) % 5)] 593 set y [expr $DPOSY+50*(1+$GMEd(RT,Show) % 5)] 594 } 595 596 GMToplevel $w route +$x+$y {} {} {} 597 if { ! $UNIX } { 598 # SH contribution 599 if {$MapMakingRT} {lower $w $Map} {focus $w} 600 } 601 if { ! $ed } { 602 wm protocol $w WM_DELETE_WINDOW "destroy $w" 603 bind $w <Key-Return> "destroy $w" 604 } else { 605 wm protocol $w WM_DELETE_WINDOW { GMButton RT cancel } 606 } 607 608 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 609 610 frame $w.fr.fr1 -relief flat -borderwidth 0 611 label $w.fr.fr1.ntitle -text "$TXT(numberid):" 612 entry $w.fr.fr1.id -width 10 -exportselection 1 613 ShowTEdit $w.fr.fr1.id $number $ed 614 615 frame $w.fr.fr2 -relief flat -borderwidth 0 616 label $w.fr.fr2.ctitle -text "$TXT(cmmt):" 617 entry $w.fr.fr2.commt -width $COMMENTWIDTH -exportselection 1 618 ShowTEdit $w.fr.fr2.commt $commt $ed 619 620 frame $w.fr.fr21 -relief flat -borderwidth 0 621 label $w.fr.fr21.obstit -text "$TXT(rmrk):" 622 text $w.fr.fr21.obs -wrap word -width $OBSWIDTH -height $OBSHEIGHT \ 623 -exportselection true 624 $w.fr.fr21.obs insert 0.0 $obs 625 $w.fr.fr21.obs configure -state $st 626 TextBindings $w.fr.fr21.obs 627 628 frame $w.fr.fr3 -relief flat -borderwidth 0 629 frame $w.fr.fr3.fr31 -relief flat -borderwidth 0 630 set frb $w.fr.fr3.fr31 631 frame $frb.frtits -relief flat -borderwidth 0 632 label $frb.frtits.fill -width 2 -font $FixedFont 633 frame $frb.frbx -relief flat -borderwidth 0 634 set boxes "" 635 foreach b "xn ox xd xb xda xsc xsl" \ 636 m "4 $NAMEWIDTH 8 4 9 $COMMENTWIDTH $NAMEWIDTH" \ 637 t $TXT(RTcompflds) { 638 lappend boxes $frb.frbx.b$b 639 label $frb.frtits.tit$b -width $m -text $t -font $FixedFont 640 listbox $frb.frbx.b$b -height 15 -width $m -relief flat \ 641 -yscrollcommand "$frb.frbx.bscr set" \ 642 -selectmode extended -exportselection false -font $FixedFont 643 bind $frb.frbx.b$b <<ListboxSelect>> \ 644 "MultExtSelect $frb.frbx.b$b {bxn box bxd bxb bxda bxsc bxsl}" 645 bind $frb.frbx.b$b <Button-3> { 646 set n [[winfo parent %W].box get [%W nearest %y]] 647 if { $n != "" } { 648 ToggleDisplayNamed WP $n 649 } 650 } 651 } 652 foreach b "xn ox xd xb xda" { 653 bind $frb.frbx.b$b <Double-1> { 654 set n [[winfo parent %W].box get [%W nearest %y]] 655 if { $n != "" } { 656 OpenItem WP [IndexNamed WP $n] 657 } 658 } 659 } 660 foreach b "xsc xsl" { 661 bind $frb.frbx.b$b <Double-1> { 662 set p [winfo parent %W] 663 if { [set i [%W nearest %y]] < [$p.box size]-1 && \ 664 [$p.box get $i] != "" } { 665 GMRTStage $p $i 666 } 667 } 668 } 669 # $boxes defined in the foreach loop that creates them 670 if { $ed } { set GMEd(RT,boxes) $boxes } 671 # BSB contribution: wheelmouse scrolling 672 scrollbar $frb.frbx.bscr -command [list ScrollMany $boxes] 673 Mscroll $boxes 674 675 set i 1 ; set n [llength $wps] 676 set td 0 ; set tddef 1 677 678 foreach wp $wps nxt [lreplace $wps 0 0] stg $stages { 679 $frb.frbx.bxn insert end [format "%3d." $i] 680 incr i 681 $frb.frbx.box insert end $wp 682 set d [GMRTDistBearDAltWP $frb.frbx end 0 $wp $nxt] 683 if { $d != "---" } { 684 set td [expr $td+$d] 685 } else { set tddef 0 } 686 # $stg may be "" 687 $frb.frbx.bxsc insert end [lindex $stg 0] 688 $frb.frbx.bxsl insert end [lindex $stg 1] 689 } 690 691 frame $frb.frt -relief flat -borderwidth 0 692 if { $tddef } { 693 set td [format "%8.2f" $td] 694 } else { set td "---" } 695 label $frb.frt.tit -text [format $TXT(totdst) $DTUNIT] 696 label $frb.frt.tt -text $td 697 698 frame $w.fr.fr3.frbt -relief flat -borderwidth 0 699 label $w.fr.fr3.frbt.title -text $TXT(nameWP) 700 foreach a "insb insa repl" { 701 button $w.fr.fr3.frbt.$a -text $TXT($a) -state $stmm \ 702 -command "ChItemsCall WP single GMRTChange $a" 703 } 704 button $w.fr.fr3.frbt.del -text $TXT(del) -state $stmm \ 705 -command { GMRTChange del } 706 frame $w.fr.fr3.frbt.sep -height 6 -bg $COLOUR(dialbg) \ 707 -relief flat -borderwidth 0 708 menubutton $w.fr.fr3.frbt.chg -text $TXT(change) -relief raised \ 709 -direction right -menu $w.fr.fr3.frbt.chg.m -state $stmm 710 menu $w.fr.fr3.frbt.chg.m -tearoff 0 711 $w.fr.fr3.frbt.chg.m add command -label $TXT(invert) \ 712 -command { GMRTChange inv } 713 $w.fr.fr3.frbt.chg.m add command -label $TXT(chophd) \ 714 -command { GMRTChange chh } 715 $w.fr.fr3.frbt.chg.m add command -label $TXT(choptl) \ 716 -command { GMRTChange cht } 717 foreach a "incb inca" { 718 $w.fr.fr3.frbt.chg.m add command -label $TXT($a) \ 719 -command "ChItemsCall RT single GMRTChange $a" 720 } 721 $w.fr.fr3.frbt.chg.m add command -label $TXT(clear) \ 722 -command { GMRTChange clear } 723 button $w.fr.fr3.frbt.edmap -text $TXT(edmap) -state $stmm \ 724 -command "$w.fr.fr3.frbt.edmap configure -state normal ; \ 725 MapEditRT" 726 menubutton $w.fr.fr3.frbt.cnv -text $TXT(convert) -relief raised \ 727 -direction right -menu $w.fr.fr3.frbt.cnv.m 728 menu $w.fr.fr3.frbt.cnv.m -tearoff 0 729 $w.fr.fr3.frbt.cnv.m add command -label $TXT(mkTR) -command "RTToTR $w" 730 $w.fr.fr3.frbt.cnv.m add command -label $TXT(split) \ 731 -command "SplitPolyLine RT sel $w $ed $index" 732 menubutton $w.fr.fr3.frbt.comp -text $TXT(computations) -relief raised \ 733 -direction right -menu $w.fr.fr3.frbt.comp.m 734 menu $w.fr.fr3.frbt.comp.m -tearoff 0 735 $w.fr.fr3.frbt.comp.m add command -label "$TXT(savecomp) ..." \ 736 -command "SaveFile comp RTComp $w" 737 $w.fr.fr3.frbt.comp.m add command -label "$TXT(comparea) ..." \ 738 -command "ComputeArea $w" 739 740 frame $w.fr.frsel -relief flat -borderwidth 0 741 # frame used for plug-ins (see array PLGSWelcomed, plugins.tcl) 742 frame $w.fr.frdw 743 set mn $w.fr.frdw.mw.m 744 menubutton $w.fr.frdw.mw -text $TXT(width) -relief raised \ 745 -direction below -menu $mn -state $st 746 menu $mn -tearoff 0 747 button $w.fr.frdw.b -text $TXT(Colour) -relief raised \ 748 -command "ChooseColour GMEd GMEd(RT,Colour) $w.fr.frdw $w" \ 749 -state $st 750 label $w.fr.frdw.bc -relief groove -background $colour -width 2 751 752 frame $w.fr.frmb 753 CreateMBackWidgets RT $w.fr.frmb $mbak $ed 754 755 if { $ed } { 756 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 757 -variable GMEd(RT,Displ) -onvalue 1 -offvalue 0 \ 758 -selectcolor $COLOUR(check) 759 foreach i "1 2 3 4 5 6 7 8" { 760 $mn add command -label $i -command "set GMEd(RT,Width) $i" 761 } 762 label $w.fr.frdw.wv -width 3 -textvariable GMEd(RT,Width) 763 if { $MapLoading != 0 } { 764 foreach i "displayed mw" { 765 $w.fr.frdw.$i configure -state disabled 766 } 767 } 768 set b $w.fr.frsel.b 769 foreach e $options { 770 button $b$e -text $TXT($e) \ 771 -command "$b$e configure -state normal ; GMButton RT $e" 772 pack $b$e -side left 773 } 774 } else { 775 checkbutton $w.fr.frdw.displayed -text $TXT(displ) -state disabled \ 776 -selectcolor $COLOUR(check) 777 if { $displ } { $w.fr.frdw.displayed select } 778 label $w.fr.frdw.wv -width 3 -text $width 779 button $w.fr.frsel.b -text $TXT(ok) -command "destroy $w" 780 pack $w.fr.frsel.b 781 } 782 # AP contribution ; changed by MF 783 set mn $w.fr.fr3.frbt.hgraph.m 784 menubutton $w.fr.fr3.frbt.hgraph -text $TXT(elevation) -relief raised \ 785 -menu $mn 786 menu $mn -tearoff 0 787 if { $ed } { 788 $mn add command -label $TXT(sideview) \ 789 -command "ManageAuxWindows RT add \[GMRTHgraph $w\]" 790 $mn add command -label $TXT(persptv) \ 791 -command "ManageAuxWindows RT add \[RTHG3D $w\]" 792 } else { 793 $mn add command -label $TXT(sideview) -command "GMRTHgraph $w" 794 $mn add command -label $TXT(persptv) -command "RTHG3D $w" 795 } 796 797 pack $w.fr -side top 798 pack $w.fr.fr1.ntitle $w.fr.fr1.id -side left -padx 3 799 pack $w.fr.fr2.ctitle $w.fr.fr2.commt -side left -padx 3 800 pack $w.fr.fr21.obstit $w.fr.fr21.obs -side left -padx 3 801 pack $frb.frtits.titxn $frb.frtits.titox $frb.frtits.titxd \ 802 $frb.frtits.titxb $frb.frtits.titxda $frb.frtits.titxsc \ 803 $frb.frtits.titxsl $frb.frtits.fill -side left -fill y 804 eval pack $boxes $frb.frbx.bscr -side left -fill y 805 pack $frb.frt.tit $frb.frt.tt -side left 806 pack $frb.frtits $frb.frbx -side top -fill y -pady 1 807 pack $frb.frt -side top -fill y -pady 5 808 # AP contribution: hgraph button 809 pack $w.fr.fr3.frbt.title $w.fr.fr3.frbt.insb \ 810 $w.fr.fr3.frbt.insa $w.fr.fr3.frbt.del \ 811 $w.fr.fr3.frbt.repl $w.fr.fr3.frbt.sep \ 812 $w.fr.fr3.frbt.chg $w.fr.fr3.frbt.edmap \ 813 $w.fr.fr3.frbt.cnv $w.fr.fr3.frbt.comp \ 814 $w.fr.fr3.frbt.hgraph -side top -pady 3 -fill x 815 pack $frb $w.fr.fr3.frbt -side left -padx 5 816 pack $w.fr.frdw.displayed $w.fr.frdw.mw -side left -padx 3 817 pack $w.fr.frdw.wv -side left -padx 0 818 pack $w.fr.frdw.b -side left -padx 10 819 pack $w.fr.frdw.bc -side left -padx 0 820 pack $w.fr.fr1 $w.fr.fr2 $w.fr.fr21 $w.fr.fr3 $w.fr.frdw -side top -pady 5 821 pack $w.fr.frmb -side top 822 pack $w.fr.frsel -side top -pady 5 823 824 AttachPlugIns $w 825 826 update idletasks 827 return $w 828} 829 830proc GMRouteMapEdit {} { 831 # change RT edit window when the RT is to be edited on the map 832 global Map MapWidth DPOSRTMAP DPOSY UNIX 833 834 set x [expr [winfo rootx $Map]+$MapWidth+$DPOSRTMAP] 835 wm geometry .gmRT +$x+$DPOSY 836 foreach b "insb insa repl chg edmap" { 837 .gmRT.fr.fr3.frbt.$b configure -state disabled 838 } 839 foreach i "displayed mw b" { 840 .gmRT.fr.frdw.$i configure -state disabled 841 } 842 if { ! $UNIX } { 843 # SH contribution 844 lower .gmRT $Map 845 } 846 return 847} 848 849proc GMRouteMapEditEnd {} { 850 # change RT edit window when the RT stops being edited on the map 851 # assume the RT has changed 852 global RT 853 854 set GMEd(RT,MapChg) 1 855 foreach b "insb insa repl chg edmap" { 856 .gmRT.fr.fr3.frbt.$b configure -state normal 857 } 858 foreach i "displayed mw b" { 859 .gmRT.fr.frdw.$i configure -state normal 860 } 861 return 862} 863 864proc GMRouteSelect {i} { 865 # select $i-th WP in RT edit window 866 # $i may be an integer from 0, or "end" 867 868 set frbx .gmRT.fr.fr3.fr31.frbx 869 foreach b "bxn box bxd bxb" { 870 $frbx.$b selection clear 0 end 871 $frbx.$b selection set $i 872 } 873 foreach b "bxda bxsc bxsl" { $frbx.$b selection clear 0 end } 874 return 875} 876 877proc RevertRT {} { 878 # reset data in RT edit window to initial values 879 # this depends on Storage(RT) 880 global GMEd MapMakingRT 881 882 if { $MapMakingRT } { MapCancelRT dontask dontclose } 883 set GMEd(RT,MapChg) 0 ; set data $GMEd(RT,Data) 884 .gmRT.fr.fr1.id delete 0 end 885 .gmRT.fr.fr1.id insert 0 [lindex $data 0] 886 .gmRT.fr.fr2.commt delete 0 end 887 .gmRT.fr.fr2.commt insert 0 [lindex $data 1] 888 .gmRT.fr.fr21.obs delete 1.0 end 889 .gmRT.fr.fr21.obs insert 1.0 [lindex $data 2] 890 set frb .gmRT.fr.fr3.fr31 891 foreach box $GMEd(RT,boxes) { $box delete 0 end } 892 set wps $GMEd(RT,WPoints) ; set stages [lindex $data 4] 893 set i 1 ; set n [llength $wps] 894 set td 0 ; set tddef 1 895 foreach wp $wps nxt [lrange $wps 1 end] st $stages { 896 $frb.frbx.bxn insert end [format "%3d." $i] 897 incr i 898 $frb.frbx.box insert end $wp 899 set d [GMRTDistBearDAltWP $frb.frbx end 0 $wp $nxt] 900 if { $d != "---" } { 901 set td [expr $td+$d] 902 } else { set tddef 0 } 903 # $st may be "" 904 $frb.frbx.bxsc insert end [lindex $st 0] 905 $frb.frbx.bxsl insert end [lindex $st 1] 906 } 907 if { $tddef } { 908 set td [format "%8.2f" $td] 909 } else { set td "---" } 910 $frb.frt.tt configure -text $td 911 912 set GMEd(RT,Width) [lindex $data 5] 913 set GMEd(RT,Colour) [lindex $data 6] 914 .gmRT.fr.frdw.bc configure -background $GMEd(RT,Colour) 915 set GMEd(RT,MBack) [lindex $data 7] 916 if { [set d [lindex $data end]] && ! $GMEd(RT,Displ) } { 917 PutMapRT $GMEd(RT,Index) 918 } 919 if { [set GMEd(RT,Displ) $d] } { 920 .gmRT.fr.frdw.displayed select 921 } else { 922 .gmRT.fr.frdw.displayed deselect 923 } 924 # assume that data in the window changed 925 ManageAuxWindows RT close_all 926 return 927} 928 929proc GMRTCheck {} { 930 # check validity of data in RT edit window 931 # this depends on Storage(RT) 932 global GMEd MAXWPINROUTE MESS TXT DataIndex 933 934 set r [CheckEntries GMMessage nil [list {.gmRT.fr.fr2.commt CheckComment}]] 935 set n [.gmRT.fr.fr3.fr31.frbx.box size] 936 if { $n == 0 } { 937 GMMessage $MESS(voidRT) 938 set r nil 939 } elseif { $n > $MAXWPINROUTE && \ 940 ![GMConfirm [format $MESS(toomany) $TXT(nameWP) $MAXWPINROUTE]] } { 941 set r nil 942 } 943 if { [set id [.gmRT.fr.fr1.id get]] == "" } { 944 GMMessage $MESS(namevoid) 945 return nil 946 } 947 if { $id == 0 && ! [GMConfirm $MESS(activeRT)] } { 948 return nil 949 } 950 if { $r != "nil" } { 951 set r [linsert $r 0 $id] 952 set nb [CheckNB [.gmRT.fr.fr21.obs get 0.0 end]] 953 set stages [GMRTStages .gmRT.fr.fr3.fr31.frbx] 954 if { ! $GMEd(RT,MapChg) && \ 955 ( $stages != [lindex $GMEd(RT,Data) 4] || \ 956 $GMEd(RT,Width) != [lindex $GMEd(RT,Data) 5] || \ 957 $GMEd(RT,Colour) != [lindex $GMEd(RT,Data) 6] ) } { 958 set GMEd(RT,MapChg) 1 959 } 960 lappend r [.gmRT.fr.fr3.fr31.frbx.box get 0 end] $stages \ 961 $GMEd(RT,Width) $GMEd(RT,Colour) $GMEd(RT,MBack) $GMEd(RT,Displ) 962 set r [linsert $r 2 $nb] 963 } 964 return $r 965} 966 967proc GMRTStage {sfr i} { 968 # edit stage from frame $sfr at position $i of listbox in RT edit window 969 global TXT DPOSX DPOSY COLOUR COMMENTWIDTH NAMEWIDTH GMEd 970 971 if { $i == [$sfr.bxn size] } { return } 972 set w .gmRS 973 if { [winfo exists $w] } { Raise $w ; bell ; return } 974 set GMEd(RT,RSgrabs) [set gs [grab current]] 975 GMToplevel $w stage +$DPOSX+$DPOSY .gmRT \ 976 [list WM_DELETE_WINDOW [list DestroyRGrabs $w $gs]] {} 977 978 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 979 label $w.fr.title -text "[$sfr.box get $i]-[$sfr.box get [expr $i+1]]" 980 981 frame $w.fr.fr1 -relief flat -borderwidth 0 982 label $w.fr.fr1.ctitle -text "$TXT(cmmt):" 983 entry $w.fr.fr1.commt -width $COMMENTWIDTH -exportselection 1 984 ShowTEdit $w.fr.fr1.commt [$sfr.bxsc get $i] 1 985 label $w.fr.fr1.ltitle -text "$TXT(label):" 986 entry $w.fr.fr1.label -width $NAMEWIDTH -exportselection 1 987 ShowTEdit $w.fr.fr1.label [$sfr.bxsl get $i] 1 988 989 frame $w.fr.bs -relief flat -borderwidth 0 990 button $w.fr.bs.ok -text $TXT(ok) -command "GMRTStageFinish $sfr $i" 991 button $w.fr.bs.cancel -text $TXT(cancel) \ 992 -command [list DestroyRGrabs $w $gs] 993 994 grid config $w.fr.fr1.ctitle -column 0 -row 0 -sticky w 995 grid config $w.fr.fr1.commt -column 1 -row 0 -sticky w 996 grid config $w.fr.fr1.ltitle -column 0 -row 1 -sticky w 997 grid config $w.fr.fr1.label -column 1 -row 1 -sticky w 998 pack $w.fr.bs.ok $w.fr.bs.cancel -side left -pady 5 999 pack $w.fr.title $w.fr.fr1 $w.fr.bs -side top -pady 5 1000 pack $w.fr -side top 1001 1002 update idletasks 1003 grab $w 1004 RaiseWindow $w 1005 return 1006} 1007 1008proc GMRTStageFinish {sfr i} { 1009 # change RT stage as in corresponding edit window 1010 # (see proc GMRTStage for the details) 1011 global GMEd 1012 1013 set efr .gmRS.fr.fr1 1014 $sfr.bxsc insert $i [string trim [$efr.commt get]] 1015 $sfr.bxsl insert $i [string trim [$efr.label get]] 1016 foreach b "bxsc bxsl" { 1017 $sfr.$b delete [expr $i+1] ; $sfr.$b selection set $i 1018 } 1019 DestroyRGrabs .gmRS $GMEd(RT,RSgrabs) 1020 return 1021} 1022 1023proc GMRTStages {w} { 1024 # get information on stages from frame $w in RT edit window 1025 # return "" if no information found 1026 1027 set sts "" ; set noinfo 1 ; set lstbut1 [expr [$w.box size]-2] 1028 foreach sc [$w.bxsc get 0 $lstbut1] sl [$w.bxsl get 0 $lstbut1] { 1029 set sc [string trim $sc] ; set sl [string trim $sl] 1030 if { $sc != "" || $sl != "" } { 1031 set noinfo 0 1032 set st [list $sc $sl] 1033 } else { set st "" } 1034 lappend sts $st 1035 } 1036 if { $noinfo } { return "" } 1037 return $sts 1038} 1039 1040proc GMRTChange {how args} { 1041 # perform edit operations on RT 1042 # $how is one of 1043 # insb insert WP before first selected WP in list or at the beginning 1044 # insa insert WP after last selected WP in list or at the end 1045 # repl replace the first selected WP by another one 1046 # del delete all selected WPs 1047 # inv invert RT 1048 # chh chop head: delete all WPs from first to first selected 1049 # inclusive or just the first one if there is no selection 1050 # cht chop tail: delete all WPs from last selected to end or only 1051 # last one 1052 # incb include RT before first selected or at beginning 1053 # inca include RT after last selected or at end 1054 # clear clear all WPs 1055 # $args 1056 # for $how in {insb, insa, repl}, is the name of the other WP 1057 # for $how==del, if making RT on map and in answer to event on map 1058 # is either 0 or "sel" for previous; otherwise (Delete button 1059 # in RT window), is "" 1060 # for $how in {incb, inca}, is the name of the other RT 1061 # in other cases, is "" 1062 # if making RT on map there must be more than one WP 1063 global GMEd MapMakingRT MapRTLast RTWPoints RTStages 1064 1065 set GMEd(RT,MapChg) 1 1066 set frbx .gmRT.fr.fr3.fr31.frbx 1067 # more than one WP can now be selected 1068 set sel [lsort -integer -increasing [$frbx.box curselection]] 1069 set sel0 [lindex $sel 0] ; set sell [lindex $sel end] 1070 switch $how { 1071 insb { 1072 set owp [lindex $args 0] 1073 if { $sel0 != "" } { 1074 set nxt [expr $sel0+1] 1075 } else { set nxt [set sel0 0] } 1076 set tddef 1 1077 if { $sel0 != 0 } { 1078 set p [expr $sel0-1] 1079 set wpp [$frbx.box get $p] 1080 set d [GMRTDistBearDAltWP $frbx $p 1 $wpp $owp] 1081 if { $d == "---" } { 1082 set tddef 0 1083 } 1084 } 1085 set d [GMRTDistBearDAltWP $frbx $sel0 0 $owp [$frbx.box get $sel0]] 1086 if { $d == "---" } { 1087 set tddef 0 1088 } 1089 $frbx.box insert $sel0 $owp 1090 $frbx.bxn insert end [format %3d. [$frbx.box size]] 1091 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt $tddef 1092 $frbx.bxsc insert $sel0 "" ; $frbx.bxsl insert $sel0 "" 1093 if { $nxt } { 1094 $frbx.bxn selection clear $sel0 end 1095 foreach ix $sel { 1096 if { $ix >= $sel0 } { 1097 incr ix 1098 $frbx.bxn selection set $ix 1099 } 1100 } 1101 } 1102 } 1103 insa { 1104 set owp [lindex $args 0] 1105 set tddef 1 1106 if { $sel == "" || \ 1107 [set last [expr [$frbx.bxn size]-1]] == $sell } { 1108 set sell [set nxt end] 1109 set wpnxt "" 1110 } else { 1111 set nxt [expr $sell+1] 1112 set wpnxt [$frbx.box get $nxt] 1113 } 1114 if { [set cwp [$frbx.box get $sell]] == "" } { 1115 set d "---" ; set tddef 0 1116 } else { 1117 set d [GMRTDistBearDAltWP $frbx $sell 1 $cwp $owp] 1118 if { $d == "---" } { 1119 set tddef 0 1120 } 1121 } 1122 set d [GMRTDistBearDAltWP $frbx $nxt 0 $owp $wpnxt] 1123 if { $d == "---" } { 1124 set tddef 0 1125 } 1126 $frbx.box insert $nxt $owp 1127 $frbx.bxn insert end [format %3d. [$frbx.box size]] 1128 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt $tddef 1129 $frbx.bxsc insert $nxt "" ; $frbx.bxsl insert $nxt "" 1130 if { $sell == "end" } { set sell [expr [$frbx.box size]-2] } 1131 foreach b {bxd bxb bxda} { 1132 $frbx.$b selection clear $nxt 1133 if { $sell >= 0 } { $frbx.$b selection set $sell } 1134 } 1135 if { $nxt != "end" } { 1136 $frbx.bxn selection clear $nxt end 1137 foreach ix $sel { 1138 if { $ix > $nxt } { 1139 incr ix -1 1140 $frbx.bxn selection set $ix 1141 } 1142 } 1143 } 1144 } 1145 repl { 1146 set owp [lindex $args 0] 1147 if { $sel0 == {} } { return } 1148 ReplaceWPInRTWindow $sel0 $frbx .gmRT.fr.fr3.fr31.frt $owp 1 1149 } 1150 del { 1151 set last [expr [$frbx.bxn size]-1] 1152 if { $MapMakingRT } { 1153 # if called in answer to event on the map 1154 # $args may be "0" (delete 1st WP) for "sel" (delete selected) 1155 # otherwise $args=="" 1156 if { $MapRTLast == 0 } { bell ; return } 1157 if { $MapRTLast == 1 } { 1158 .gmRT.fr.fr3.frbt.del configure -state disabled 1159 } 1160 # as there were at least 2 WPs, $prev will be set below 1161 # unless the 1st WP is being deleted 1162 if { [lindex $args 0] == 0 } { 1163 set sel 0 1164 } elseif { $sel == "" } { BUG "no selected WP to delete" } 1165 set delwp [$frbx.box get $sel] 1166 } elseif { $sel == {} } { return } 1167 set tddef 1 1168 foreach sl [lsort -integer -decreasing $sel] { 1169 if { $sl > 0 } { 1170 set p [expr $sl-1] 1171 set prev [$frbx.box get $p] 1172 if { $sl == $last } { 1173 $frbx.bxd delete $p ; $frbx.bxd insert $p "========" 1174 $frbx.bxb delete $p ; $frbx.bxb insert $p "===" 1175 $frbx.bxsc delete $p ; $frbx.bxsl delete $p 1176 } else { 1177 set d [GMRTDistBearDAltWP $frbx $p 1 $prev \ 1178 [$frbx.box get [expr $sl+1]]] 1179 if { $d == "---" } { set tddef 0 } 1180 } 1181 } 1182 foreach b "ox xd xb xda xsc xsl" { 1183 $frbx.b$b delete $sl 1184 $frbx.b$b selection clear 0 end 1185 } 1186 $frbx.bxn delete end 1187 if { $MapMakingRT } { 1188 if { $sel == 0 } { 1189 MapDelRT1st $delwp 1190 } else { MapDelRTPrevious $prev $delwp } 1191 } 1192 } 1193 $frbx.bxn selection clear 0 end 1194 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt $tddef 1195 } 1196 inv { 1197 if { [set lstbut1 [expr [$frbx.bxn size]-2]] < 0 } { return } 1198 set wps [$frbx.box get 0 end] 1199 set stcs [$frbx.bxsc get 0 $lstbut1] 1200 set stls [$frbx.bxsl get 0 $lstbut1] 1201 set ds [$frbx.bxd get 0 $lstbut1] 1202 set bs [$frbx.bxb get 0 $lstbut1] 1203 set das [$frbx.bxda get 0 $lstbut1] 1204 foreach b "ox xd xb xda xsc xsl" { 1205 $frbx.b$b delete 0 end 1206 } 1207 foreach w $wps { 1208 $frbx.box insert 0 $w 1209 } 1210 $frbx.bxd insert 0 "========" ; $frbx.bxb insert 0 "===" 1211 foreach d $ds b $bs da $das { 1212 if { $b > 179 } { 1213 set b [expr $b-180] 1214 } else { set b [expr 180+$b] } 1215 $frbx.bxd insert 0 $d ; $frbx.bxb insert 0 [format %4d $b] 1216 if { $da != "" } { set da [format %7.1f [expr -$da]] } 1217 $frbx.bxda insert 0 $da 1218 } 1219 foreach stc $stcs stl $stls { 1220 $frbx.bxsc insert 0 $stc ; $frbx.bxsl insert 0 $stl 1221 } 1222 foreach b "xn ox xd xb xda xsc xsl" { 1223 $frbx.b$b selection clear 0 end 1224 } 1225 } 1226 clear { 1227 foreach b "xn ox xd xb xda xsc xsl" { 1228 $frbx.b$b delete 0 end 1229 } 1230 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt 1 1231 } 1232 chh { 1233 # chop head: delete WPs from first to first selected, or first one 1234 if { $sel == "" } { set sel0 0 } 1235 foreach b "ox xd xb xda xsc xsl" { 1236 $frbx.b$b delete 0 $sel0 1237 } 1238 $frbx.bxn delete [$frbx.box size] end 1239 $frbx.bxn selection clear 0 end 1240 foreach sl $sel { 1241 if { $sl > $sel0 } { 1242 set sl [expr $sl-$sel0-1] 1243 $frbx.bxn selection set $sl 1244 } 1245 } 1246 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt 1 1247 } 1248 cht { 1249 # chop tail: delete all WPs from last selected to end, or last one 1250 if { $sel == "" } { set sell end } 1251 foreach b "xn ox xd xb xda xsc xsl" { 1252 $frbx.b$b delete $sell end 1253 $frbx.b$b yview end 1254 } 1255 foreach b "xd xb xda xsc xsl" v "======== ==== {} {} {}" { 1256 $frbx.b$b delete end ; $frbx.b$b insert end $v 1257 $frbx.b$b yview end 1258 } 1259 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt 1 1260 } 1261 incb { 1262 # include RT before first selected or first 1263 if { [set ixrt [IndexNamed RT [lindex $args 0]]] == -1 } { 1264 return 1265 } 1266 if { $sel == "" } { set sel0 0 } 1267 set wps $RTWPoints($ixrt) 1268 set tddef 1 1269 if { $sel0 != 0 } { 1270 set pr [expr $sel0-1] 1271 set wp [$frbx.box get $pr] 1272 set d [GMRTDistBearDAltWP $frbx $pr 1 $wp [lindex $wps 0]] 1273 if { $d == "---" } { set tddef 0 } 1274 } 1275 set nwps [lrange $wps 1 end] ; lappend nwps [$frbx.box get $sel0] 1276 set i [$frbx.bxn size] 1277 foreach wp $wps nxt $nwps stg $RTStages($ixrt) { 1278 incr i 1279 $frbx.bxn insert end [format "%3d." $i] 1280 $frbx.box insert $sel0 $wp 1281 set d [GMRTDistBearDAltWP $frbx $sel0 0 $wp $nxt] 1282 if { $d == "---" } { set tddef 0 } 1283 # $stg may be "" 1284 $frbx.bxsc insert end [lindex $stg 0] 1285 $frbx.bxsl insert end [lindex $stg 1] 1286 incr sel0 1287 } 1288 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt $tddef 1289 foreach b "xn ox xd xb xda xsc xsl" { 1290 $frbx.b$b selection clear 0 end 1291 } 1292 } 1293 inca { 1294 # include RT after last selected or at end 1295 if { [set ixrt [IndexNamed RT [lindex $args 0]]] == -1 } { 1296 return 1297 } 1298 set i [$frbx.bxn size] 1299 if { $sel == "" } { set sell [expr $i-1] } 1300 set wps $RTWPoints($ixrt) 1301 set wp [$frbx.box get $sell] 1302 set d [GMRTDistBearDAltWP $frbx $sell 1 $wp [lindex $wps 0]] 1303 if { $d == "---" } { 1304 set tddef 0 1305 } else { set tddef 1 } 1306 set nwps [lrange $wps 1 end] 1307 if { $sell < $i-1 } { 1308 lappend nwps [$frbx.box get [expr $sell+1]] 1309 } 1310 foreach wp $wps nxt $nwps stg $RTStages($ixrt) { 1311 incr i ; incr sell 1312 $frbx.bxn insert end [format "%3d." $i] 1313 $frbx.box insert $sell $wp 1314 set d [GMRTDistBearDAltWP $frbx $sell 0 $wp $nxt] 1315 if { $d == "---" } { set tddef 0 } 1316 # $stg may be "" 1317 $frbx.bxsc insert $sell [lindex $stg 0] 1318 $frbx.bxsl insert $sell [lindex $stg 1] 1319 } 1320 GMRTConfigTDist $frbx .gmRT.fr.fr3.fr31.frt $tddef 1321 foreach b "xn ox xd xb xda xsc xsl" { 1322 $frbx.b$b selection clear 0 end 1323 } 1324 } 1325 } 1326 ManageAuxWindows RT close_all 1327 return 1328} 1329 1330proc ReplaceWPInRTWindow {i frbx frt wpn recomp} { 1331 # replace WP at position $i in boxes framed by $frbx by WP named $wpn 1332 # $frt is the frame where the total distance is shown 1333 # $recomp is set if distances must be recalculated, in which case 1334 # edited WP is assumed to have already been stored in the data-base 1335 # selection state is kept 1336 1337 set selected [$frbx.box selection includes $i] 1338 $frbx.box insert $i $wpn 1339 $frbx.box delete [expr $i+1] 1340 if { $recomp } { 1341 set tddef 1 1342 if { $i > 0 } { 1343 set p [expr $i-1] 1344 set d [GMRTDistBearDAltWP $frbx $p 1 [$frbx.box get $p] $wpn] 1345 if { $d == "---" } { 1346 set tddef 0 1347 } 1348 } 1349 if { $i < [expr [$frbx.bxn size]-1] } { 1350 set p [expr $i+1] 1351 set d [GMRTDistBearDAltWP $frbx $i 1 $wpn [$frbx.box get $p]] 1352 if { $d == "---" } { set tddef 0 } 1353 } 1354 GMRTConfigTDist $frbx $frt $tddef 1355 } 1356 if { $selected } { 1357 foreach b "xn ox xd xb xda xsc xsl" { 1358 $frbx.b$b selection set $i 1359 } 1360 } 1361 return 1362} 1363 1364proc GMRTDistBearDAltWP {fr i del wp1 wp2} { 1365 # compute distance, bearing and difference in altitude between two WPs 1366 # and insert them in listboxes under $fr at index $i, deleting previous 1367 # value if $del is set; $wp2 can be "" 1368 # (see GMRoute for structure of $fr and listboxes) 1369 # return distance or "---" if could not compute it, or 0 if $wp2 is "" 1370 global DSCALE ALSCALE WPAlt 1371 1372 set da "" 1373 if { $wp2 != "" } { 1374 set db [CompWPDistBear $wp1 $wp2] 1375 set d [lindex $db 0] 1376 if { $d != "---" } { 1377 set d [expr $d*$DSCALE] 1378 set pd [format %8.2f $d] 1379 set db [format %4d [lindex $db 1]] 1380 } else { 1381 set db "---" ; set pd "--------" 1382 } 1383 if { [set ix1 [IndexNamed WP $wp1]] != -1 && \ 1384 [set ix2 [IndexNamed WP $wp2]] != -1 && \ 1385 [set a1 [lindex $WPAlt($ix1) 0]] != {} && \ 1386 [set a2 [lindex $WPAlt($ix2) 0]] != {} } { 1387 set da [format "%7.1f" [expr ($a2-$a1)/$ALSCALE]] 1388 } 1389 } else { set d 0 ; set pd "========" ; set db "====" } 1390 if { $del } { 1391 $fr.bxd delete $i ; $fr.bxb delete $i ; $fr.bxda delete $i 1392 } 1393 $fr.bxd insert $i $pd ; $fr.bxb insert $i $db 1394 $fr.bxda insert $i $da 1395 return $d 1396} 1397 1398proc GMRTConfigTDist {frbx frt def} { 1399 # compute and configure total distance if expected to be defined 1400 # $frbx is frame for listboxes with distances 1401 # $frt is the frame for the total distance label 1402 # $def is 1 if distance is expected to be defined 1403 1404 if { $def } { 1405 set td 0 1406 foreach d [$frbx.bxd get 0 end] { 1407 if { [string first "---" $d] == 0 } { 1408 $frt.tt configure -text "---" 1409 break 1410 } 1411 if { $d != "========" } { 1412 set td [expr $td+$d] 1413 } 1414 } 1415 $frt.tt configure -text [format %8.2f $td] 1416 } else { 1417 $frt.tt configure -text "---" 1418 } 1419 return 1420} 1421 1422proc ChangeWPInRTWindows {oldname newname recomp} { 1423 # replace name of WP in RT windows and/or recompute distances 1424 # a WP name may occur several times 1425 # $recomp is set if distances must be recalculated, in which case 1426 # edited WP is assumed to have already been stored in the data-base 1427 # change data on RT being edited if WP belongs to it and was renamed 1428 global GMEd 1429 1430 set diffname [string compare $oldname $newname] 1431 if { [winfo exists .gmRT] && $diffname } { 1432 # window update is done below 1433 # this depends on Storage(RT) 1434 set wps [lindex $GMEd(RT,Data) 3] ; set chg 0 1435 foreach i [lsearch -exact -all $wps $oldname] { 1436 set wps [lreplace $wps $i $i $newname] 1437 incr chg 1438 } 1439 if { $chg } { set GMEd(RT,Data) [lreplace $GMEd(RT,Data) 3 3 $wps] } 1440 } 1441 set ws [winfo children .] 1442 while { [set i [lsearch -glob $ws ".gmRT*"]] != -1 } { 1443 set w [lindex $ws $i] 1444 set ws [lrange $ws [expr $i+1] end] 1445 set frbx $w.fr.fr3.fr31.frbx 1446 foreach i [lsearch -exact -all [$frbx.box get 0 end] $oldname] { 1447 ReplaceWPInRTWindow $i $frbx $w.fr.fr3.fr31.frt $newname $recomp 1448 } 1449 } 1450 return 1451} 1452 1453proc RTToTR {w} { 1454 # make a TR from the RT in window $w 1455 global WPPosn WPAlt WPDatum Datum EdWindow MESS TXT 1456 1457 set tpfs "latd longd latDMS longDMS" 1458 set tpfsa "alt latd longd latDMS longDMS" 1459 set tps "" 1460 foreach wpn [$w.fr.fr3.fr31.frbx.box get 0 end] { 1461 if { [set wpix [IndexNamed WP $wpn]] != -1 } { 1462 set p $WPPosn($wpix) 1463 set p [lindex [FormatPosition [lindex $p 0] [lindex $p 1] \ 1464 $WPDatum($wpix) DMS $Datum] 0] 1465 set p [lrange $p 0 3] 1466 if { [set a $WPAlt($wpix)] != "" } { 1467 lappend tps [FormData TP $tpfsa [linsert $p 0 $a]] 1468 } else { lappend tps [FormData TP $tpfs $p] } 1469 } 1470 } 1471 if { $tps == "" } { bell ; return } 1472 if { [winfo exists $EdWindow(TR)] } { 1473 set name [NewName TR] 1474 set data [FormData TR "Name Datum TPoints" [list $name $Datum $tps]] 1475 CreateItem TR $data 1476 GMMessage [format $MESS(convres) $TXT(TR) $name] 1477 } else { 1478 set opts "create revert cancel" 1479 GMTrack -1 $opts [FormData TR "Datum TPoints" [list $Datum $tps]] 1480 } 1481 return 1482} 1483 1484proc ComputeArea {w} { 1485 # compute area of polygon whose boundary is the RT in window $w 1486 # the RT cannot intersect itself; in particular its WPs cannot occur 1487 # twice except for the 1st one that can appear also as last one 1488 # only this particular case is checked 1489 # computation is either based on a spherical approximation, or, if that 1490 # has precision problems (too small areas), done by projecting on the 1491 # plane and calculating the area of projected polygon; the projection 1492 # used for this is the Transverse Mercator, or the Universal Polar 1493 # Stereographic for absolute latitudes above ca. 80 degrees 1494 global MESS ASCALE ARUNIT 1495 1496 set wps [$w.fr.fr3.fr31.frbx.box get 0 end] 1497 if { [lindex $wps 0] == [lindex $wps end] } { 1498 set wps [lreplace $wps end end] 1499 } 1500 if { [set n [llength $wps]] < 3 } { 1501 GMMessage $MESS(missingdata) 1502 return 1503 } 1504 set wpixs [Apply $wps IndexNamed WP] 1505 set os [lreplace $wpixs 0 0] 1506 foreach ix $wpixs { 1507 foreach ixn $os { 1508 if { $ix == $ixn } { 1509 GMMessage $MESS(selfintsct) 1510 return 1511 } 1512 } 1513 set os [lreplace $os 0 0] 1514 } 1515 if { [set area [SphericalArea $wpixs]] < 0 } { 1516 GMMessage $MESS(projarea) 1517 set area [ProjectedArea $wpixs] 1518 if { $area < 0.001 } { 1519 GMMessage [format $MESS(areatoosmall) 0.001] 1520 return 1521 } 1522 } 1523 GMMessage [format $MESS(areais) [expr $area*$ASCALE] $ARUNIT] 1524 return 1525} 1526 1527proc GMTrack {index options data} { 1528 # create dialog window for editing/showing data of TR with given index 1529 # $options is a list of buttons to display; 1530 # $index is -1 if this is a new TR 1531 # an empty list means no editing; supported options are: 1532 # cancel, create, change, revert, forget 1533 # change and forget assume $index != -1 1534 # see proc GMButton for further details 1535 # if $options is empty, $index cannot be -1 as this is not a new TR 1536 # the only button is OK, and only binding: return to destroy 1537 # order of elements in $data list reflects order in $Storage(TR) 1538 # which is used below 1539 # return window path 1540 global GMEd MapLoading DPOSX DPOSY COLOUR LISTHEIGHT COMMENTWIDTH \ 1541 DATEWIDTH OBSWIDTH OBSHEIGHT TXT DATUMWIDTH 1542 1543 foreach "name obs datum tps segsts hidden width colour mbak displ" $data {} 1544 set ed 0 ; set st disabled 1545 if { $options != "" } { 1546 if { [winfo exists .gmTR] } { Raise .gmTR ; bell ; return .gmTR } 1547 set ed 1 ; set st normal 1548 set w .gmTR 1549 set GMEd(TR,Index) $index ; set GMEd(TR,Displ) $displ 1550 set GMEd(TR,Datum) $datum ; set GMEd(TR,TPs) $tps 1551 set GMEd(TR,Hidden) $hidden ; set GMEd(TR,MapChg) 0 1552 set GMEd(TR,SgSts) $segsts ; set GMEd(TR,Width) $width 1553 set GMEd(TR,Colour) $colour ; set GMEd(TR,MBack) $mbak 1554 # this depends on Storage(TR) 1555 set GMEd(TR,Data) $data 1556 # GMEd(TR,windows) is a list of windows that should be closed 1557 # when the track is changed such as the computation window and 1558 # the plot windows created by procs Hgraph and HG3D (elevation.tcl) 1559 # It should be accessed by calling proc ManageAuxWindows 1560 set GMEd(TR,windows) {} 1561 set x $DPOSX 1562 set y $DPOSY 1563 } else { 1564 set w .gmTRsh$index 1565 if { [winfo exists $w] } { destroy $w } 1566 incr GMEd(TR,Show) 1567 set x [expr $DPOSX+50*((1+$GMEd(TR,Show)) % 5)] 1568 set y [expr $DPOSY+50*((1+$GMEd(TR,Show)) % 5)] 1569 } 1570 1571 GMToplevel $w track +$x+$y {} {} {} 1572 if { ! $ed } { 1573 wm protocol $w WM_DELETE_WINDOW "destroy $w" 1574 bind $w <Key-Return> "destroy $w" 1575 } else { 1576 wm protocol $w WM_DELETE_WINDOW { GMButton TR cancel } 1577 } 1578 1579 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 1580 1581 frame $w.fr.fr1 -relief flat -borderwidth 0 1582 label $w.fr.fr1.ntitle -text "$TXT(name):" 1583 entry $w.fr.fr1.id -width $DATEWIDTH -exportselection 1 1584 ShowTEdit $w.fr.fr1.id $name $ed 1585 1586 frame $w.fr.fr2 -relief flat -borderwidth 0 1587 label $w.fr.fr2.obstit -text "$TXT(rmrk):" 1588 text $w.fr.fr2.obs -wrap word -width $OBSWIDTH -height $OBSHEIGHT \ 1589 -exportselection true 1590 $w.fr.fr2.obs insert 0.0 $obs 1591 $w.fr.fr2.obs configure -state $st 1592 TextBindings $w.fr.fr2.obs 1593 1594 frame $w.fr.frd -relief flat -borderwidth 0 1595 menubutton $w.fr.frd.dttitle -text Datum -relief raised \ 1596 -direction below -menu $w.fr.frd.dttitle.m -state $st 1597 menu $w.fr.frd.dttitle.m -tearoff 0 1598 if { $ed } { 1599 FillDatumMenu $w.fr.frd.dttitle.m GMTRChangeDatum 1600 label $w.fr.frd.datum -text $GMEd(TR,Datum) \ 1601 -textvariable GMEd(TR,Datum) \ 1602 -width $DATUMWIDTH 1603 } else { 1604 label $w.fr.frd.datum -text $datum -width $DATUMWIDTH 1605 } 1606 1607 if { $hidden != "" } { 1608 button $w.fr.hidd -text $TXT(hiddendata) \ 1609 -command "$w.fr.hidd configure -state normal ; \ 1610 ShowHiddenData TR {$hidden}" 1611 } 1612 1613 frame $w.fr.fr3 -relief flat -borderwidth 0 1614 frame $w.fr.fr3.frbx -relief flat -borderwidth 0 1615 set boxes "" 1616 foreach b "n d lat long alt dep seg" m "5 $DATEWIDTH 12 12 7 7 1" { 1617 listbox $w.fr.fr3.frbx.bx$b -height 15 -width $m -relief flat \ 1618 -yscrollcommand "$w.fr.fr3.frbx.bscr set" \ 1619 -selectmode extended -exportselection false 1620 lappend boxes $w.fr.fr3.frbx.bx$b 1621 bind $w.fr.fr3.frbx.bx$b <<ListboxSelect>> \ 1622 "MultExtSelect $w.fr.fr3.frbx.bx$b {bxn bxd bxlat bxlong bxalt bxdep bxseg}" 1623 bind $w.fr.fr3.frbx.bx$b <Double-1> \ 1624 { MarkPoint TR [winfo toplevel %W] [%W nearest %y] } 1625 } 1626 if { $ed } { 1627 set GMEd(TR,boxes) $boxes 1628 bind $w.fr.fr3.frbx.bxseg <Button-3> { 1629 GMToggleSegStart TR %W [%W nearest %y] 1630 ManageAuxWindows TR close_all 1631 } 1632 } 1633 # BSB contribution: wheelmouse scrolling 1634 scrollbar $w.fr.fr3.frbx.bscr -command [list ScrollMany $boxes] 1635 Mscroll $boxes 1636 FillTPs $w $tps $segsts 1637 1638 frame $w.fr.fr3.frbt -relief flat -borderwidth 0 1639 button $w.fr.fr3.frbt.chh -text $TXT(chophd) -state $st \ 1640 -command { GMTRChange chh } 1641 button $w.fr.fr3.frbt.cht -text $TXT(choptl) -state $st \ 1642 -command { GMTRChange cht } 1643 foreach a "incb app" { 1644 button $w.fr.fr3.frbt.$a -text $TXT($a) -state $st \ 1645 -command "ChItemsCall TR single GMTRChange $a" 1646 } 1647 # MB contribution 1648 button $w.fr.fr3.frbt.del -text $TXT(del) -state $st \ 1649 -command { GMTRChange del } 1650 #---- 1651 button $w.fr.fr3.frbt.clear -text $TXT(clear) -state $st \ 1652 -command { GMTRChange clear } 1653 frame $w.fr.fr3.frbt.sep -height 6 -bg $COLOUR(dialbg) \ 1654 -relief flat -borderwidth 0 1655 button $w.fr.fr3.frbt.anim -text $TXT(animation) -command "GMTRAnimate $w" 1656 button $w.fr.fr3.frbt.comp -text $TXT(comp) -command "GMTRCompute $w" 1657 set mnc $w.fr.fr3.frbt.cnv.m 1658 menubutton $w.fr.fr3.frbt.cnv -text $TXT(convert) -relief raised \ 1659 -direction right -menu $mnc 1660 menu $mnc -tearoff 0 1661 $mnc add command -label $TXT(mkavgWP) -command "GMTRtoWP $w" 1662 set mn $mnc.mnsm 1663 $mnc add cascade -label $TXT(simplTRto) -menu $mn 1664 menu $mn -tearoff 0 1665 foreach wh "RT TR LN" { 1666 $mn add command -label $TXT(name$wh) -command "GMTRtoLine $wh $w" 1667 } 1668 $mnc add cascade -label $TXT(split) -menu $mnc.mns 1669 menu $mnc.mns -tearoff 0 1670 $mnc.mns add command -label $TXT(bysel) \ 1671 -command "SplitPolyLine TR sel $w $ed $index" 1672 $mnc.mns add command -label $TXT(byseg) \ 1673 -command "SplitPolyLine TR segm $w $ed $index" 1674 1675 frame $w.fr.frsel -relief flat -borderwidth 0 1676 # frame used for plug-ins (see array PLGSWelcomed, plugins.tcl) 1677 frame $w.fr.frdw 1678 set mn $w.fr.frdw.mw.m 1679 menubutton $w.fr.frdw.mw -text $TXT(width) -relief raised \ 1680 -direction below -menu $mn -state $st 1681 menu $mn -tearoff 0 1682 button $w.fr.frdw.b -text $TXT(Colour) -relief raised \ 1683 -command "ChooseColour GMEd GMEd(TR,Colour) $w.fr.frdw $w" \ 1684 -state $st 1685 label $w.fr.frdw.bc -relief groove -background $colour -width 2 1686 1687 frame $w.fr.frmb 1688 CreateMBackWidgets TR $w.fr.frmb $mbak $ed 1689 1690 if { $ed } { 1691 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 1692 -variable GMEd(TR,Displ) -onvalue 1 -offvalue 0 \ 1693 -selectcolor $COLOUR(check) 1694 foreach i "1 2 3 4 5 6 7 8" { 1695 $mn add command -label $i -command "set GMEd(TR,Width) $i" 1696 } 1697 label $w.fr.frdw.wv -width 3 -textvariable GMEd(TR,Width) 1698 if { $MapLoading != 0 } { 1699 foreach i "displayed mw" { 1700 $w.fr.frdw.$i configure -state disabled 1701 } 1702 } 1703 set b $w.fr.frsel.b 1704 foreach e $options { 1705 button $b$e -text $TXT($e) \ 1706 -command "$b$e configure -state normal ; GMButton TR $e" 1707 pack $b$e -side left 1708 } 1709 } else { 1710 checkbutton $w.fr.frdw.displayed -text $TXT(displ) -state disabled \ 1711 -selectcolor $COLOUR(check) 1712 if { $displ } { $w.fr.frdw.displayed select } 1713 label $w.fr.frdw.wv -width 3 -text $width 1714 button $w.fr.frsel.b -text $TXT(ok) -command "destroy $w" 1715 pack $w.fr.frsel.b 1716 } 1717 1718 pack $w.fr -side top 1719 pack $w.fr.fr1.ntitle $w.fr.fr1.id -side left -padx 3 1720 pack $w.fr.fr2.obstit $w.fr.fr2.obs -side left -padx 3 1721 pack $w.fr.frd.dttitle $w.fr.frd.datum -side left -padx 3 1722 eval pack $boxes $w.fr.fr3.frbx.bscr -side left -fill y 1723 # includes MB contribution 1724 pack $w.fr.fr3.frbt.chh $w.fr.fr3.frbt.cht $w.fr.fr3.frbt.incb \ 1725 $w.fr.fr3.frbt.app $w.fr.fr3.frbt.del $w.fr.fr3.frbt.clear \ 1726 $w.fr.fr3.frbt.sep $w.fr.fr3.frbt.anim $w.fr.fr3.frbt.comp \ 1727 $w.fr.fr3.frbt.cnv -side top -pady 2 -fill x 1728 pack $w.fr.fr3.frbx $w.fr.fr3.frbt -side left -padx 5 1729 pack $w.fr.frdw.displayed $w.fr.frdw.mw -side left -padx 3 1730 pack $w.fr.frdw.wv -side left -padx 0 1731 pack $w.fr.frdw.b -side left -padx 10 1732 pack $w.fr.frdw.bc -side left -padx 0 1733 if { $hidden != "" } { 1734 pack $w.fr.fr1 $w.fr.fr2 $w.fr.frd -side top -pady 5 1735 pack $w.fr.hidd -side top -pady 2 1736 pack $w.fr.fr3 $w.fr.frdw -side top -pady 5 1737 pack $w.fr.frmb -side top 1738 pack $w.fr.frsel -side top -pady 5 1739 } else { 1740 pack $w.fr.fr1 $w.fr.fr2 $w.fr.frd $w.fr.fr3 $w.fr.frdw -side top \ 1741 -pady 5 1742 pack $w.fr.frmb -side top 1743 pack $w.fr.frsel -side top -pady 5 1744 } 1745 1746 AttachPlugIns $w 1747 1748 update idletasks 1749 return $w 1750} 1751 1752proc RevertTR {} { 1753 # reset data in TR edit window to initial values 1754 # this depends on Storage(TR) 1755 global GMEd 1756 1757 set GMEd(TR,MapChg) 0 ; set data $GMEd(TR,Data) 1758 .gmTR.fr.fr1.id delete 0 end 1759 .gmTR.fr.fr1.id insert 0 [lindex $data 0] 1760 .gmTR.fr.fr2.obs delete 1.0 end 1761 .gmTR.fr.fr2.obs insert 1.0 [lindex $data 1] 1762 foreach box $GMEd(TR,boxes) { $box delete 0 end } 1763 foreach e "Datum TPs SgSts" v [lrange $data 2 4] { 1764 set GMEd(TR,$e) $v 1765 } 1766 # hidden attributes: [lindex $GMEd(TR,Data) 5] 1767 foreach e "Width Colour MBack Displ" v [lrange $data 6 end] { 1768 set GMEd(TR,$e) $v 1769 } 1770 FillTPs .gmTR $GMEd(TR,TPs) $GMEd(TR,SgSts) 1771 .gmTR.fr.frdw.bc configure -background $GMEd(TR,Colour) 1772 if { $GMEd(TR,Displ) } { 1773 .gmTR.fr.frdw.displayed select 1774 } else { 1775 .gmTR.fr.frdw.displayed deselect 1776 } 1777 # assume that data in the window changed 1778 ManageAuxWindows TR close_all 1779 return 1780} 1781 1782proc GMTRCheck {} { 1783 # check validity of data in TR edit window 1784 # this depends on Storage(TR) 1785 global GMEd MESS KEEPHIDDEN 1786 1787 set id [.gmTR.fr.fr1.id get] 1788 if { ! [CheckString GMMessage $id] } { 1789 focus .gmTR.fr.fr1.id 1790 return nil 1791 } 1792 if { [llength $GMEd(TR,TPs)] == 0 } { 1793 GMMessage $MESS(voidTR) 1794 return nil 1795 } 1796 if { $GMEd(TR,Hidden) != "" } { 1797 switch $KEEPHIDDEN { 1798 never { set GMEd(TR,Hidden) "" } 1799 always { } 1800 ask { 1801 if { [GMConfirm $MESS(nohidden)] } { set GMEd(TR,Hidden) "" } 1802 } 1803 } 1804 } 1805 if { ! $GMEd(TR,MapChg) && \ 1806 ( $GMEd(TR,Width) != [lindex $GMEd(TR,Data) 6] || \ 1807 $GMEd(TR,Colour) != [lindex $GMEd(TR,Data) 7] ) } { 1808 set GMEd(TR,MapChg) 1 1809 } 1810 set r [list $id [CheckNB [.gmTR.fr.fr2.obs get 0.0 end]]] 1811 foreach e "Datum TPs SgSts Hidden Width Colour MBack Displ" { 1812 lappend r $GMEd(TR,$e) 1813 } 1814 return $r 1815} 1816 1817proc GMTRNewDate {tpsa tpsb} { 1818 # create dialog window to get new date for the first point of a TR ($tpsa) 1819 # when appending it to a another one ($tpsb) 1820 global DATEWIDTH EPOSX EPOSY COLOUR TempTR GMEd TXT FixedFont 1821 1822 set l [set na [llength $tpsa]] 1823 if { $na > 4 } { set na 4 } 1824 set tpsa [lrange $tpsa [expr $l-$na] end] 1825 set l [set nb [llength $tpsb]] 1826 if { $nb > 4 } { set nb 4 } 1827 set tpsb [lrange $tpsb 0 [expr $nb-1]] 1828 1829 GMToplevel .gmTRnd date +$EPOSX+$EPOSY .gmTR \ 1830 {WM_DELETE_WINDOW {set TmpTR cnc}} \ 1831 {<Key-Return> {set TmpTR ok}} 1832 1833 frame .gmTRnd.fr -relief flat -borderwidth 5 -bg $COLOUR(selbg) 1834 label .gmTRnd.fr.tit -text $TXT(newdate) -relief sunken 1835 1836 set ll [Measure "$TXT(endprTR):"] 1837 frame .gmTRnd.fr.frbxp -relief flat -borderwidth 0 1838 label .gmTRnd.fr.frbxp.tit -text "$TXT(endprTR):" -width $ll 1839 listbox .gmTRnd.fr.frbxp.bxt -width $DATEWIDTH -height 4 \ 1840 -exportselection 0 -font $FixedFont 1841 bind .gmTRnd.fr.frbxp.bxt <Button-1> { 1842 .gmTRnd.fr.frbxp.bxt selection clear 0 end 1843 } 1844 listbox .gmTRnd.fr.frbxp.bxl -width 8 -height 4 -exportselection 0 \ 1845 -font $FixedFont 1846 bind .gmTRnd.fr.frbxp.bxl <Button-1> { 1847 .gmTRnd.fr.frbxp.bxl selection clear 0 end 1848 } 1849 set dst 0 1850 foreach tp $tpsa nxt [lrange $tpsa 1 end] { 1851 .gmTRnd.fr.frbxp.bxt insert end [lindex $tp 4] 1852 if { $nxt != "" } { 1853 set d [ComputeDist $tp $nxt $GMEd(TR,Datum)] 1854 set dst [expr $dst+$d] 1855 .gmTRnd.fr.frbxp.bxl insert end [format "%8.2f" $d] 1856 } 1857 } 1858 set d [ComputeDist [lindex $tpsa end] [lindex $tpsb 0] $GMEd(TR,Datum)] 1859 .gmTRnd.fr.frbxp.bxl insert end [format "%8.2f" $d] 1860 set tl [lindex [lindex $tpsa end] 5] 1861 if { $dst != 0 } { 1862 set t [expr $tl-[lindex [lindex $tpsa 0] 5]] 1863 set ns [expr round($t*$d/$dst)+$tl] 1864 } else { set ns $tl } 1865 1866 frame .gmTRnd.fr.frbxn -relief flat -borderwidth 0 1867 label .gmTRnd.fr.frbxn.tit -text "$TXT(begnxt):" -width $ll 1868 listbox .gmTRnd.fr.frbxn.bxt -width $DATEWIDTH -height 4 \ 1869 -exportselection 0 -font $FixedFont 1870 bind .gmTRnd.fr.frbxn.bxt <Button-1> { 1871 .gmTRnd.fr.frbxn.bxt selection clear 0 end 1872 } 1873 listbox .gmTRnd.fr.frbxn.bxl -width 8 -height 4 -exportselection 0 \ 1874 -font $FixedFont 1875 bind .gmTRnd.fr.frbxn.bxl <Button-1> { 1876 .gmTRnd.fr.frbxn.bxl selection clear 0 end 1877 } 1878 foreach tp $tpsb nxt [lrange $tpsb 1 end] { 1879 .gmTRnd.fr.frbxn.bxt insert end [lindex $tp 4] 1880 if { $nxt != "" } { 1881 set d [ComputeDist $tp $nxt $GMEd(TR,Datum)] 1882 .gmTRnd.fr.frbxn.bxl insert end [format "%8.2f" $d] 1883 } 1884 } 1885 1886 frame .gmTRnd.fr.fe -relief flat -borderwidth 0 1887 label .gmTRnd.fr.fe.tit -text "$TXT(date1st):" 1888 entry .gmTRnd.fr.fe.en -width $DATEWIDTH -exportselection 1 1889 .gmTRnd.fr.fe.en insert 0 [DateFromSecs $ns] 1890 TextBindings .gmTRnd.fr.fe.en 1891 1892 frame .gmTRnd.fr.bs -relief flat -borderwidth 0 1893 button .gmTRnd.fr.bs.ok -text $TXT(ok) -command { set TempTR ok } 1894 button .gmTRnd.fr.bs.cnc -text $TXT(cancel) -command { set TempTR cnc } 1895 1896 pack .gmTRnd.fr.frbxp.tit .gmTRnd.fr.frbxp.bxt .gmTRnd.fr.frbxp.bxl \ 1897 -side left -fill y 1898 pack .gmTRnd.fr.frbxn.tit .gmTRnd.fr.frbxn.bxt .gmTRnd.fr.frbxn.bxl \ 1899 -side left -fill y 1900 pack .gmTRnd.fr.fe.tit .gmTRnd.fr.fe.en -side top -pady 3 1901 pack .gmTRnd.fr.bs.ok .gmTRnd.fr.bs.cnc -side left -pady 5 1902 pack .gmTRnd.fr.tit .gmTRnd.fr.frbxp .gmTRnd.fr.frbxn .gmTRnd.fr.fe \ 1903 .gmTRnd.fr.bs -side top -pady 5 1904 pack .gmTRnd.fr -side top 1905 1906 update idletasks 1907 set gs [grab current] 1908 grab .gmTRnd 1909 RaiseWindow .gmTRnd 1910 while 1 { 1911 tkwait variable TempTR 1912 1913 switch $TempTR { 1914 cnc { 1915 set res -1 1916 break 1917 } 1918 ok { 1919 set fn [string trim [.gmTRnd.fr.fe.en get] " "] 1920 set d [CheckConvDate $fn] 1921 if { $d != "" } { 1922 set res $d 1923 break 1924 } 1925 } 1926 } 1927 } 1928 DestroyRGrabs .gmTRnd $gs 1929 update idletasks 1930 return $d 1931} 1932 1933proc GMTRChange {how args} { 1934 # perform edit operations on TR 1935 1936 GMPolyChange TR $how $args 1937 ManageAuxWindows TR close_all 1938 return 1939} 1940 1941proc GMTRAnimate {window} { 1942 # launch animation for TR in edit/show window 1943 global GMEd TRTPoints TRDatum TXT MESS 1944 1945 set name [$window.fr.fr1.id get] 1946 if { $window == ".gmTR" } { 1947 set tps $GMEd(TR,TPs) 1948 if { $tps == "" } { 1949 GMMessage $MESS(voidTR) 1950 return 1951 } 1952 set datum $GMEd(TR,Datum) 1953 } else { 1954 set ixt [IndexNamed TR $name] 1955 set tps $TRTPoints($ixt) ; set datum $TRDatum($ixt) 1956 } 1957 InitAnimation TR "$TXT(nameTR): $name" $tps $datum 1958 return 1959} 1960 1961proc GMTRCompute {window} { 1962 # create dialog to show results of computation for TR of edit/show window 1963 global DPOSX DPOSY COLOUR GMEd TRTPoints TRSegStarts TRDatum TXT MESS \ 1964 DTUNIT SPUNIT ALUNIT DSCALE FixedFont DATEWIDTH ALTHRESHOLD 1965 1966 set w ${window}.topc 1967 if { [winfo exists $w] } { Raise $w ; bell ; return } 1968 1969 if { $window == ".gmTR" } { 1970 set edit 1 1971 ManageAuxWindows TR add $w 1972 set tps $GMEd(TR,TPs) 1973 if { $tps == "" } { 1974 GMMessage $MESS(voidTR) 1975 return 1976 } 1977 set segsts $GMEd(TR,SgSts) 1978 set datum $GMEd(TR,Datum) 1979 } else { 1980 set edit 0 1981 set ixt [IndexNamed TR [$window.fr.fr1.id get]] 1982 set tps $TRTPoints($ixt) ; set segsts $TRSegStarts($ixt) 1983 set datum $TRDatum($ixt) 1984 } 1985 if { [lindex $tps 1000] != "" && ! [GMConfirm $MESS(timeconsmg)] } { 1986 return 1987 } 1988 SetCursor . watch 1989 GMToplevel $w TRcomp +[expr $DPOSX+100]+[expr $DPOSY+100] {} {} {} 1990 1991 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 1992 frame $w.fr.fr1 -relief flat -borderwidth 0 1993 label $w.fr.fr1.ntitle -text "$TXT(name): [$window.fr.fr1.id get]" 1994 1995 frame $w.fr.fr3 -relief flat -borderwidth 0 1996 frame $w.fr.fr3.frtits -relief flat -borderwidth 0 1997 label $w.fr.fr3.frtits.fill -width 2 -font $FixedFont 1998 frame $w.fr.fr3.frbx -relief flat -borderwidth 0 1999 set h [$window.fr.fr3.frbx.bxn size] 2000 if { $h > 15 } { set h 15 } 2001 set boxes "" 2002 foreach b "xn xd xlat xlong al xl tl dt sp bg" \ 2003 m "5 $DATEWIDTH 12 12 7 8 8 8 6 4" t $TXT(TRcompflds) { 2004 label $w.fr.fr3.frtits.tit$b -width $m -text $t -font $FixedFont 2005 listbox $w.fr.fr3.frbx.b$b -height $h -width $m -relief flat \ 2006 -yscrollcommand "$w.fr.fr3.frbx.bscr set" \ 2007 -selectmode single -exportselection false -font $FixedFont 2008 lappend boxes $w.fr.fr3.frbx.b$b 2009 bind $w.fr.fr3.frbx.b$b <Button-1> { 2010 MultSelect [winfo parent %W] [%W nearest %y] \ 2011 {bxn bxd bxlat bxlong bal bxl btl bdt bsp bbg} 2012 } 2013 } 2014 # $boxes computed in the previous loop 2015 # BSB contribution: wheelmouse scrolling 2016 scrollbar $w.fr.fr3.frbx.bscr -command [list ScrollMany $boxes] 2017 Mscroll $boxes 2018 2019 # distance from first TP, its maximum and index of corresponding TP 2020 set d0 0 ; set mxd0 0 ; set ismxd0 "" 2021 # total distance (chainage) / total time including segment gaps 2022 set td 0 ; set tt 0 2023 # proposed RM contribution: display chainage instead of 2024 # sum of distance from start to next; 1 of 4 2025 # this line should be commented out 2026 set sd [format "%8.3f" $td] 2027 # total distance without segment gaps 2028 set tdng 0 ; set ttng 0 2029 # extreme speed values and indices of corresponding TPs 2030 set mxsp 0 ; set mnsp 1e70 ; set imx 0 ; set imn 0 2031 # lists of: total distance and speed; seconds, altitude and start 2032 # segment flag; seconds and speed 2033 set speeds "" ; set salts "" ; set sspeeds "" 2034 SetDatumData $datum 2035 set tp0 [lindex $tps 0] 2036 # AP contribution 2037 #====== 2038 #get start point alt and put it in lllist with 0 km. 2039 # MF change: inserted start segment flag 2040 set lll [list [list 0.0 [UserAltitude [lindex $tp0 6]] 0]] 2041 # MF change: moved computation of $tmp3D $tmp3D2 to next foreach 2042 set tmp3D "" ; set tmp3D2 "" 2043 # 3D elevation graph: call HG3D $tmp3D $tmp3D2 $datum 2044 #====== 2045 set secs2 [lindex $tp0 5] 2046 set nsgst [lindex $segsts 0] ; set segsts [lreplace $segsts 0 0] 2047 set endsegm 0 2048 set i 1 2049 # BS contribution: definition variable 2050 # RM change variablename 2051 set cumula 0 2052 set cumula_temp 0 2053 #====== 2054 # MF contribution: also for cumulative descent 2055 set cumuld 0 ; set cumuld_temp 0 2056 #====== 2057 set maxalt -1e10 ; set minalt 1e10 2058 set imaxalt 0; set iminalt 0 2059 # RM contribution: searching for rest periods 2060 set limit_resttime 300 ; # 5min 2061 set limit_restdist [expr 0.050*$DSCALE] ; # 50m 2062 set limit_restspeed [expr 0.3*$DSCALE] ; # 0.3kph 2063 set trt 0 ; # total resttime 2064 set tmt 0 ; # total time in motion 2065 set rest "" ; # list with index, chainage, tracktime, resttime 2066 #====== 2067 2068 foreach tp $tps nxt [lreplace $tps 0 0] { 2069 # $tp altitude in user units and time-stamp in seconds 2070 if { [set al [UserAltitude [lindex $tp 6]]] != "" } { 2071 if { $al > $maxalt } { 2072 set maxalt $al 2073 set imaxalt $i 2074 } 2075 if { $al < $minalt } { 2076 set minalt $al 2077 set iminalt $i 2078 } 2079 } 2080 set secs $secs2 2081 # $tp starts a new segment if the previous TP ended one 2082 set newsegm $endsegm 2083 lappend salts [list $secs $al $newsegm] 2084 # AP contribution (MF: from above) 2085 lappend tmp3D [list [lindex $tp 0] [lindex $tp 1] $datum] 2086 lappend tmp3D2 [list $al] 2087 #--- 2088 if { $nsgst == $i } { 2089 # $nxt starts a new segment, so $tp ends one 2090 set endsegm 1 2091 set nsgst [lindex $segsts 0] ; set segsts [lreplace $segsts 0 0] 2092 } else { set endsegm 0 } 2093 if { $nxt != "" } { 2094 # proposed RM contribution: display chainage instead of 2095 # sum of distance from start to next; 2 of 4 2096 # this line should be uncommented: 2097 # set sd [format "%8.3f" $td] 2098 set db [ComputeDistBearFD $tp $nxt] 2099 # distance to next in user units 2100 set d [expr [lindex $db 0]*$DSCALE] 2101 # total distance(chainage) 2102 set td [expr $td+$d] 2103 # bearing to next in degrees 2104 set b [format "%4d" [lindex $db 1]] 2105 # time difference to next in seconds 2106 set dt [expr [set secs2 [lindex $nxt 5]]-$secs] 2107 # distance from start to next in user units 2108 set d0 [expr [ComputeDistFD $tp0 $nxt]*$DSCALE] 2109 # maximum distance from first to next 2110 if { $d0 > $mxd0 } { 2111 set mxd0 $d0 ; set ismxd0 [expr $i+1] 2112 } elseif { $d0 == $mxd0 } { lappend ismxd0 [expr $i+1] } 2113 # AP contribution 2114 #======= 2115 set al2 [UserAltitude [lindex $nxt 6]] 2116 # MF change: add start segment flag for $nxt 2117 lappend lll [list $td $al2 $endsegm] 2118 #======= 2119 # RM contribution: searching for rest periods 2120 if { $dt != 0 } { 2121 # compute speed from current to next 2122 set sp [expr 3600.0*$d/$dt] 2123 } else { set sp 0 } 2124 if { $dt > $limit_resttime && $sp < $limit_restspeed && \ 2125 $d < $limit_restdist } { 2126 incr trt $dt; lappend rest [list $i $sd $tt $dt] } 2127 #======= 2128 # BS contribution 2129 # with MF change to cover cumulative descent 2130 # RM change: altitude threshold 2131 # MF change: using global option 2132 if { $al != "" && $al2 != "" } { 2133 if { $al2 > $al } { 2134 # upward 2135 set cumula_temp [expr $cumula_temp+$al2-$al] 2136 if { $cumuld_temp >= $ALTHRESHOLD } { 2137 set cumuld [expr $cumuld+$cumuld_temp] 2138 } else { 2139 # discard amount 2140 set cumula [expr $cumula-$cumuld_temp] 2141 } 2142 set cumuld_temp 0 2143 } elseif { $al2 < $al } { 2144 # downward 2145 if { $cumula_temp >= $ALTHRESHOLD } { 2146 set cumula [expr $cumula+$cumula_temp] 2147 } else { 2148 # discard amount 2149 set cumuld [expr $cumuld-$cumula_temp] 2150 } 2151 set cumula_temp 0 2152 set cumuld_temp [expr $cumuld_temp+$al-$al2] 2153 } 2154 } 2155 #======= 2156 # while $lll was updated with values for $nxt, $salts was 2157 # updated with values for $tp 2158 if { $endsegm } { 2159 # speed is meaningless 2160 set sp "======" 2161 } else { 2162 if { $dt != 0 } { 2163 # compute speed from current to next 2164 set sp [expr 3600*$d/$dt] 2165 lappend speeds [list $td $sp] 2166 lappend sspeeds [list $secs $sp] 2167 if { $sp > $mxsp } { set mxsp $sp ; set imx $i } 2168 if { $sp < $mnsp } { set mnsp $sp ; set imn $i } 2169 set sp [format "%6.2f" $sp] 2170 } else { set sp "======" } 2171 set tdng [expr $tdng+$d] ; incr ttng $dt 2172 } 2173 incr tt $dt 2174 set d [format "%8.2f" $d] 2175 # proposed RM contribution: display chainage instead of 2176 # sum of distance from start to next; 3 of 4 2177 # next line should be commented out 2178 set sd [format "%8.2f" $td] 2179 set dt [FormatTime $dt] 2180 } else { 2181 set d "========" ; set dt "========" 2182 set sp "======" ; set b "====" 2183 # proposed RM contribution: display chainage instead of 2184 # sum of distance from start to next; 4 of 4 2185 # next line should be replaced by 2186 # set sd [format "%8.3f" $td] 2187 set sd "========" 2188 } 2189 foreach box $boxes \ 2190 v [list [format "%4d." $i] [lindex $tp 4] \ 2191 [lindex $tp 2] [lindex $tp 3] $al $d $sd $dt $sp $b] { 2192 $box insert end $v 2193 } 2194 incr i 2195 } 2196 # AP contribution 2197 #======= 2198 #From this point on you can call: 2199 #Hgraph $lll 2200 #======= 2201 # BS contribution 2202 set cumula [expr $cumula+$cumula_temp] 2203 #======= 2204 # MF contribution: same for descent 2205 set cumuld [expr $cumuld+$cumuld_temp] 2206 #======= 2207 set td [format "%8.2f" $td] ; set tdng [format "%8.2f" $tdng] 2208 if { $tt == 0 } { 2209 set avsp "======" 2210 set mxp "======" ; set mnsp "======" 2211 set avspmot "======" 2212 } else { 2213 set avsp [format "%6.2f" [expr 3600*$td/$tt]] 2214 set mxsp [format "%6.2f" $mxsp] ; set mnsp [format "%6.2f" $mnsp] 2215 # RM contribution: avg speed in motion 2216 set tmt [expr $tt-$trt] 2217 set avspmot [format "%6.2f" [expr 3600*$td/$tmt]] 2218 #======= 2219 } 2220 set tt [FormatTime $tt] ; set ttng [FormatTime $ttng] 2221 set trt [FormatTime $trt] ; set tmt [FormatTime $tmt] 2222 set d0 [format "%8.2f" $d0] ; set mxd0 [format "%8.2f" $mxd0] 2223 2224 frame $w.fr.fr3.frt -relief flat -borderwidth 0 2225 label $w.fr.fr3.frt.td -text "$TXT(totdst): $td $DTUNIT" 2226 label $w.fr.fr3.frt.tt -text "$TXT(tottime): $tt" 2227 2228 if { $tdng != $td || $ttng != $tt } { 2229 set gaps 1 2230 frame $w.fr.fr3.frtng -relief flat -borderwidth 0 2231 label $w.fr.fr3.frtng.td -text "$TXT(totdstng): $tdng $DTUNIT" 2232 label $w.fr.fr3.frtng.tt -text "$TXT(tottimeng): $ttng" 2233 } else { set gaps 0 } 2234 2235 frame $w.fr.fr3.frsp -relief flat -borderwidth 0 2236 label $w.fr.fr3.frsp.avg -text "$TXT(avgsp): $avsp $SPUNIT" 2237 label $w.fr.fr3.frsp.max -text "$TXT(maxsp): $mxsp (@$imx)" 2238 label $w.fr.fr3.frsp.min -text "$TXT(minsp): $mnsp (@$imn)" 2239 2240 # RM contribution: $w.fr.fr3.frrest 2241 frame $w.fr.fr3.frrest -relief flat -borderwidth 0 2242 label $w.fr.fr3.frrest.avg -text "$TXT(avgspmot): $avspmot $SPUNIT" 2243 label $w.fr.fr3.frrest.trt -text "$TXT(totresttime): $trt" 2244 2245 if { $maxalt > -1e10 } { 2246 set hasalt 1 2247 set maxalt [expr int(round($maxalt))] 2248 set minalt [expr int(round($minalt))] 2249 frame $w.fr.fr3.frmxnalt -relief flat -borderwidth 0 2250 label $w.fr.fr3.frmxnalt.mx \ 2251 -text "$TXT(maxalt): $maxalt $ALUNIT (@$imaxalt)" 2252 label $w.fr.fr3.frmxnalt.mn \ 2253 -text "$TXT(minalt): $minalt $ALUNIT (@$iminalt)" 2254 2255 # MF contribution: frame for cummulative ascent and descent 2256 # only used if there is altitude information and if the computed 2257 # values are compatible with the extreme altitude values 2258 2259 set altdiff [expr $maxalt-$minalt] 2260 if { $cumula < $altdiff || $cumuld < $altdiff } { 2261 DisplayInfo [format $MESS(badcumuls) \ 2262 $altdiff $cumula $cumuld $ALTHRESHOLD $ALUNIT] 2263 set hascumul 0 2264 } else { 2265 set hascumul 1 2266 2267 # MF change: cumulative ascent/descent valid independently of time 2268 set cumula [format "%6.0f" $cumula] 2269 set cumuld [format "%6.0f" $cumuld] 2270 2271 frame $w.fr.fr3.frcad -relief flat -borderwidth 0 2272 label $w.fr.fr3.frcad.cumuld \ 2273 -text "$TXT(alt_cumuld): $cumuld $ALUNIT" 2274 #======= 2275 # BS contribution 2276 label $w.fr.fr3.frcad.cumula \ 2277 -text "$TXT(alt_cumula): $cumula $ALUNIT" 2278 #====== 2279 # RM contribution: 2280 label $w.fr.fr3.frcad.thresh \ 2281 -text "($TXT(optALTHRESHOLD): $ALTHRESHOLD $ALUNIT)" 2282 } 2283 } else { set hasalt 0 } 2284 2285 frame $w.fr.fr3.frd0 -relief flat -borderwidth 0 2286 label $w.fr.fr3.frd0.toend -text [format $TXT(starttoend) $d0] 2287 label $w.fr.fr3.frd0.max -text "[format $TXT(startmax) $mxd0] (@$ismxd0)" 2288 2289 frame $w.fr.frsel -relief flat -borderwidth 0 2290 button $w.fr.frsel.save -text "$TXT(save) ..." \ 2291 -command "SaveFile comp TRComp $w ; \ 2292 $w.fr.frsel.save configure -state normal" 2293 button $w.fr.frsel.ok -text $TXT(ok) -command "destroy $w" 2294 # AP contribution; changed by MF 2295 #----- 2296 if { [llength $lll] < 3 } { 2297 set elevstate disabled 2298 } else { set elevstate normal } 2299 # menu used for plug-ins (see array PLGSWelcomed, plugins.tcl) 2300 set mn $w.fr.frsel.hgraph.mn 2301 menubutton $w.fr.frsel.hgraph -text $TXT(namePlot) -relief raised \ 2302 -menu $mn 2303 menu $mn -tearoff 0 2304 # menu used for plug-ins (see array PLGSWelcomed, plugins.tcl) 2305 set mn1 $mn.el 2306 $mn add cascade -label $TXT(elevation) -menu $mn1 -state $elevstate 2307 menu $mn1 -tearoff 0 2308 if { $edit } { 2309 $mn1 add command -label "$TXT(sideview)/$TXT(TRVdist)" \ 2310 -command "ManageAuxWindows TR add \[Hgraph {$lll} elevation\]" 2311 $mn1 add command -label "$TXT(sideview)/$TXT(TRVhour)" -command \ 2312 "ManageAuxWindows TR add \[Hgraph {$salts} elevation time\]" 2313 $mn1 add command -label $TXT(persptv) -command \ 2314 "ManageAuxWindows TR add \[HG3D {$tmp3D} {$tmp3D2} {$datum}\]" 2315 $mn1 add command -label $TXT(climbrate) -command \ 2316 "ManageAuxWindows TR add \[Hgraph {$salts} climbrate time\]" 2317 $mn add command -label "$TXT(speed)/$TXT(TRVdist)" \ 2318 -command "ManageAuxWindows TR add \[Hgraph {$speeds} speed\]" 2319 $mn add command -label "$TXT(speed)/$TXT(TRVhour)" \ 2320 -command "ManageAuxWindows TR add \[Hgraph {$sspeeds} speed time\]" 2321 } else { 2322 $mn1 add command -label "$TXT(sideview)/$TXT(TRVdist)" \ 2323 -command "Hgraph {$lll} elevation" 2324 $mn1 add command -label "$TXT(sideview)/$TXT(TRVhour)" \ 2325 -command "Hgraph {$salts} elevation time" 2326 $mn1 add command -label $TXT(persptv) \ 2327 -command "HG3D {$tmp3D} {$tmp3D2} {$datum}" 2328 $mn1 add command -label $TXT(climbrate) \ 2329 -command "Hgraph {$salts} climbrate time" 2330 $mn add command -label "$TXT(speed)/$TXT(TRVdist)" \ 2331 -command "Hgraph {$speeds} speed" 2332 $mn add command -label "$TXT(speed)/$TXT(TRVhour)" \ 2333 -command "Hgraph {$sspeeds} speed time" 2334 } 2335 #----- 2336 # menu used for plug-ins (see array PLGSWelcomed, plugins.tcl) 2337 set mn $w.fr.frsel.more.mn 2338 menubutton $w.fr.frsel.more -text $TXT(more) -relief raised \ 2339 -menu $mn 2340 menu $mn -tearoff 0 2341 # menu used for plug-ins (see array PLGSWelcomed, plugins.tcl) 2342 2343 pack $w.fr -side top 2344 pack $w.fr.fr1.ntitle -side left 2345 pack $w.fr.fr3.frtits.titxn $w.fr.fr3.frtits.titxd \ 2346 $w.fr.fr3.frtits.titxlat $w.fr.fr3.frtits.titxlong \ 2347 $w.fr.fr3.frtits.tital $w.fr.fr3.frtits.titxl $w.fr.fr3.frtits.tittl \ 2348 $w.fr.fr3.frtits.titdt $w.fr.fr3.frtits.titsp $w.fr.fr3.frtits.titbg \ 2349 $w.fr.fr3.frtits.fill -side left 2350 eval pack $boxes $w.fr.fr3.frbx.bscr -side left -fill y 2351 pack $w.fr.fr3.frt.td $w.fr.fr3.frt.tt -side left -padx 5 2352 if { $gaps } { 2353 pack $w.fr.fr3.frtng.td $w.fr.fr3.frtng.tt -side left -padx 5 2354 } 2355 pack $w.fr.fr3.frsp.avg $w.fr.fr3.frsp.max $w.fr.fr3.frsp.min \ 2356 -side left -padx 3 2357 2358 # RM contribution: $w.fr.fr3.frrest 2359 pack $w.fr.fr3.frrest.avg $w.fr.fr3.frrest.trt \ 2360 -side left -padx 3 2361 2362 pack $w.fr.fr3.frd0.toend $w.fr.fr3.frd0.max -side left -padx 2 2363 pack $w.fr.fr3.frtits $w.fr.fr3.frbx -side top -fill y -pady 1 2364 # BS contribution: $w.fr.fr3.frcad.cumul 2365 # MF change: using frame for cummulative ascent and descent and showing 2366 # altitude information only when available 2367 if { $hasalt } { 2368 pack $w.fr.fr3.frmxnalt.mx $w.fr.fr3.frmxnalt.mn -side left -padx 5 2369 if { $hascumul } { 2370 pack $w.fr.fr3.frcad.cumula $w.fr.fr3.frcad.cumuld \ 2371 $w.fr.fr3.frcad.thresh -side left -padx 5 2372 } 2373 pack $w.fr.fr3.frt -side top -fill y -pady 5 2374 if { $gaps } { 2375 pack $w.fr.fr3.frtng -side top -fill y -pady 5 2376 } 2377 if { $hascumul } { 2378 pack $w.fr.fr3.frsp $w.fr.fr3.frrest $w.fr.fr3.frmxnalt \ 2379 $w.fr.fr3.frcad $w.fr.fr3.frd0 -side top -fill y -pady 5 2380 } else { 2381 pack $w.fr.fr3.frsp $w.fr.fr3.frrest $w.fr.fr3.frmxnalt \ 2382 $w.fr.fr3.frd0 -side top -fill y -pady 5 2383 } 2384 } else { 2385 pack $w.fr.fr3.frt -side top -fill y -pady 5 2386 if { $gaps } { 2387 pack $w.fr.fr3.frtng -side top -fill y -pady 5 2388 } 2389 pack $w.fr.fr3.frsp $w.fr.fr3.frrest $w.fr.fr3.frd0 \ 2390 -side top -fill y -pady 5 2391 } 2392 2393 # AP contribution: hgraph button 2394 pack $w.fr.frsel.hgraph $w.fr.frsel.more $w.fr.frsel.save $w.fr.frsel.ok \ 2395 -side left -padx 5 2396 pack $w.fr.fr1 $w.fr.fr3 $w.fr.frsel -side top 2397 2398 AttachPlugIns $w 2399 2400 ResetCursor . 2401 return 2402} 2403 2404proc GMLine {index options data} { 2405 # create dialog window for editing/showing data of LN with given index 2406 # $options is a list of buttons to display; 2407 # $index is -1 if this is a new LN 2408 # an empty list means no editing; supported options are: 2409 # cancel, create, change, revert, forget 2410 # change and forget assume $index != -1 2411 # see proc GMButton for further details 2412 # if $options is empty, $index cannot be -1 as this is not a new TR 2413 # the only button is OK, and only binding: return to destroy 2414 # order of elements in $data list reflects order in $Storage(LN) 2415 # which is used below 2416 # return window path 2417 global GMEd MapLoading DPOSX DPOSY COLOUR LISTHEIGHT COMMENTWIDTH \ 2418 OBSWIDTH OBSHEIGHT DATEWIDTH TXT DATUMWIDTH 2419 2420 foreach "name obs datum pformt lps segsts width colour mbak displ" $data {} 2421 set ed 0 ; set st disabled 2422 if { $options != "" } { 2423 if { [winfo exists .gmLN] } { Raise .gmLN ; bell ; return .gmLN } 2424 set ed 1 ; set st normal 2425 set w .gmLN 2426 set GMEd(LN,Index) $index ; set GMEd(LN,Displ) $displ 2427 set GMEd(LN,Datum) $datum ; set GMEd(LN,PFrmt) $pformt 2428 set GMEd(LN,LPs) $lps ; set GMEd(LN,SgSts) $segsts 2429 set GMEd(LN,Colour) $colour ; set GMEd(LN,Width) $width 2430 set GMEd(LN,MapChg) 0 ; set GMEd(LN,MBack) $mbak 2431 # this depends on Storage(LN) 2432 set GMEd(LN,Data) $data 2433 set x $DPOSX 2434 set y $DPOSY 2435 } else { 2436 set w .gmLNsh$index 2437 if { [winfo exists $w] } { destroy $w } 2438 incr GMEd(LN,Show) 2439 set x [expr $DPOSX+50*((1+$GMEd(LN,Show)) % 5)] 2440 set y [expr $DPOSY+50*((1+$GMEd(LN,Show)) % 5)] 2441 } 2442 2443 GMToplevel $w nameLN +$x+$y {} {} {} 2444 if { ! $ed } { 2445 wm protocol $w WM_DELETE_WINDOW "destroy $w" 2446 bind $w <Key-Return> "destroy $w" 2447 } else { 2448 wm protocol $w WM_DELETE_WINDOW { GMButton LN cancel } 2449 } 2450 2451 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 2452 2453 frame $w.fr.fr1 -relief flat -borderwidth 0 2454 label $w.fr.fr1.ntitle -text "$TXT(name):" 2455 entry $w.fr.fr1.id -width $DATEWIDTH -exportselection 1 2456 ShowTEdit $w.fr.fr1.id $name $ed 2457 2458 frame $w.fr.fr2 -relief flat -borderwidth 0 2459 label $w.fr.fr2.obstit -text "$TXT(rmrk):" 2460 text $w.fr.fr2.obs -wrap word -width $OBSWIDTH -height $OBSHEIGHT \ 2461 -exportselection true 2462 $w.fr.fr2.obs insert 0.0 $obs 2463 $w.fr.fr2.obs configure -state $st 2464 TextBindings $w.fr.fr2.obs 2465 2466 frame $w.fr.frdpf -relief flat -borderwidth 0 2467 menubutton $w.fr.frdpf.dttitle -text Datum -relief raised \ 2468 -direction below -menu $w.fr.frdpf.dttitle.m -state $st 2469 menu $w.fr.frdpf.dttitle.m -tearoff 0 2470 menubutton $w.fr.frdpf.pfmt -text $TXT($pformt) -relief raised -width 8 \ 2471 -direction below -menu $w.fr.frdpf.pfmt.m -state $st 2472 menu $w.fr.frdpf.pfmt.m -tearoff 0 2473 if { $ed } { 2474 FillDatumMenu $w.fr.frdpf.dttitle.m GMLNChangeDatum 2475 label $w.fr.frdpf.datum -text $GMEd(LN,Datum) \ 2476 -textvariable GMEd(LN,Datum) -width $DATUMWIDTH 2477 $w.fr.frdpf.pfmt configure -textvariable GMEd(LN,PFrmt) 2478 FillPFormtMenu $w.fr.frdpf.pfmt.m GMLNChangePFormt 2479 } else { 2480 label $w.fr.frdpf.datum -text $datum -width $DATUMWIDTH 2481 } 2482 2483 frame $w.fr.fr3 -relief flat -borderwidth 0 2484 frame $w.fr.fr3.frbx -relief flat -borderwidth 0 2485 set boxes "" 2486 foreach b "n pos alt seg" m "5 30 7 1" { 2487 listbox $w.fr.fr3.frbx.bx$b -height 15 -width $m -relief flat \ 2488 -yscrollcommand "$w.fr.fr3.frbx.bscr set" \ 2489 -selectmode extended -exportselection false 2490 lappend boxes $w.fr.fr3.frbx.bx$b 2491 bind $w.fr.fr3.frbx.bx$b <<ListboxSelect>> \ 2492 "MultExtSelect $w.fr.fr3.frbx.bx$b {bxn bxpos bxalt bxseg}" 2493 } 2494 if { $ed } { 2495 set GMEd(LN,boxes) $boxes 2496 foreach box $boxes { 2497 bind $box <Double-1> { GMLinePoint [%W nearest %y] } 2498 } 2499 bind $w.fr.fr3.frbx.bxseg <Button-3> { 2500 GMToggleSegStart LN %W [%W nearest %y] 2501 } 2502 } 2503 scrollbar $w.fr.fr3.frbx.bscr -command [list ScrollMany $boxes] 2504 Mscroll $boxes 2505 FillLPs $w $lps $segsts 2506 2507 frame $w.fr.fr3.frbt -relief flat -borderwidth 0 2508 button $w.fr.fr3.frbt.chh -text $TXT(chophd) -state $st \ 2509 -command { GMLNChange chh } 2510 button $w.fr.fr3.frbt.cht -text $TXT(choptl) -state $st \ 2511 -command { GMLNChange cht } 2512 foreach a "incb app" { 2513 button $w.fr.fr3.frbt.$a -text $TXT($a) -state $st \ 2514 -command "ChItemsCall LN single GMLNChange $a" 2515 } 2516 button $w.fr.fr3.frbt.loop -text $TXT(loop) -state $st \ 2517 -command { GMLNChange loop } 2518 button $w.fr.fr3.frbt.del -text $TXT(del) -state $st \ 2519 -command { GMLNChange del } 2520 button $w.fr.fr3.frbt.clear -text $TXT(clear) -state $st \ 2521 -command { GMLNChange clear } 2522 2523 frame $w.fr.fr3.frbt.sep -height 6 -bg $COLOUR(dialbg) \ 2524 -relief flat -borderwidth 0 2525 set mnc $w.fr.fr3.frbt.cnv.m 2526 menubutton $w.fr.fr3.frbt.cnv -text $TXT(convert) -relief raised \ 2527 -direction right -menu $mnc 2528 menu $mnc -tearoff 0 2529 $mnc add command -label $TXT(mkTR) -command "LNToTR $w" 2530 $mnc add cascade -label $TXT(split) -menu $mnc.mns 2531 menu $mnc.mns -tearoff 0 2532 $mnc.mns add command -label $TXT(bysel) \ 2533 -command "SplitPolyLine LN sel $w $ed $index" 2534 $mnc.mns add command -label $TXT(byseg) \ 2535 -command "SplitPolyLine LN segm $w $ed $index" 2536 2537 frame $w.fr.frsel -relief flat -borderwidth 0 2538 # frame used for plug-ins (see array PLGSWelcomed, plugins.tcl) 2539 frame $w.fr.frdw 2540 set mn $w.fr.frdw.mw.m 2541 menubutton $w.fr.frdw.mw -text $TXT(width) -relief raised \ 2542 -direction below -menu $mn -state $st 2543 menu $mn -tearoff 0 2544 button $w.fr.frdw.b -text $TXT(Colour) -relief raised \ 2545 -command "ChooseColour GMEd GMEd(LN,Colour) $w.fr.frdw $w" \ 2546 -state $st 2547 label $w.fr.frdw.bc -relief groove -background $colour -width 2 2548 2549 frame $w.fr.frmb 2550 CreateMBackWidgets LN $w.fr.frmb $mbak $ed 2551 2552 if { $ed } { 2553 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 2554 -variable GMEd(LN,Displ) -onvalue 1 -offvalue 0 \ 2555 -selectcolor $COLOUR(check) 2556 foreach i "1 2 3 4 5 6 7 8" { 2557 $mn add command -label $i -command "set GMEd(LN,Width) $i" 2558 } 2559 label $w.fr.frdw.wv -width 3 -textvariable GMEd(LN,Width) 2560 if { $MapLoading != 0 } { 2561 foreach i "displayed mw b" { 2562 $w.fr.frdw.$i configure -state disabled 2563 } 2564 } 2565 set b $w.fr.frsel.b 2566 foreach e $options { 2567 button $b$e -text $TXT($e) \ 2568 -command "$b$e configure -state normal ; GMButton LN $e" 2569 pack $b$e -side left 2570 } 2571 } else { 2572 checkbutton $w.fr.frdw.displayed -text $TXT(displ) -state disabled \ 2573 -selectcolor $COLOUR(check) 2574 if { $displ } { $w.fr.frdw.displayed select } 2575 label $w.fr.frdw.wv -width 3 -text $width 2576 button $w.fr.frsel.b -text $TXT(ok) -command "destroy $w" 2577 pack $w.fr.frsel.b 2578 } 2579 2580 pack $w.fr -side top 2581 pack $w.fr.fr1.ntitle $w.fr.fr1.id -side left -padx 3 2582 pack $w.fr.fr2.obstit $w.fr.fr2.obs -side left -padx 3 2583 pack $w.fr.frdpf.dttitle $w.fr.frdpf.datum -side left -padx 3 2584 pack $w.fr.frdpf.pfmt -side left -padx 10 2585 eval pack $boxes $w.fr.fr3.frbx.bscr -side left -fill y 2586 pack $w.fr.fr3.frbt.chh $w.fr.fr3.frbt.cht $w.fr.fr3.frbt.incb \ 2587 $w.fr.fr3.frbt.app $w.fr.fr3.frbt.loop $w.fr.fr3.frbt.del \ 2588 $w.fr.fr3.frbt.clear $w.fr.fr3.frbt.sep \ 2589 $w.fr.fr3.frbt.cnv -side top -pady 2 -fill x 2590 pack $w.fr.fr3.frbx $w.fr.fr3.frbt -side left -padx 5 2591 pack $w.fr.frdw.displayed $w.fr.frdw.mw -side left -padx 3 2592 pack $w.fr.frdw.wv -side left -padx 0 2593 pack $w.fr.frdw.b -side left -padx 10 2594 pack $w.fr.frdw.bc -side left -padx 0 2595 pack $w.fr.fr1 $w.fr.fr2 $w.fr.frdpf $w.fr.fr3 $w.fr.frdw -side top -pady 5 2596 pack $w.fr.frmb -side top 2597 pack $w.fr.frsel -side top -pady 5 2598 2599 AttachPlugIns $w 2600 2601 update idletasks 2602 return $w 2603} 2604 2605proc RevertLN {} { 2606 # reset data in LN edit window to initial values 2607 # this depends on Storage(LN) 2608 global GMEd 2609 2610 set GMEd(LN,MapChg) 0 ; set data $GMEd(LN,Data) 2611 foreach box $GMEd(LN,boxes) { $box delete 0 end } 2612 .gmLN.fr.fr1.id delete 0 end 2613 .gmLN.fr.fr1.id insert 0 [lindex $data 0] 2614 .gmLN.fr.fr2.obs delete 1.0 end 2615 .gmLN.fr.fr2.obs insert 1.0 [lindex $data 1] 2616 foreach e "Datum PFrmt LPs SgSts Width Colour MBack Displ" \ 2617 v [lreplace $data 0 1] { 2618 set GMEd(LN,$e) $v 2619 } 2620 FillLPs .gmLN $GMEd(LN,LPs) $GMEd(LN,SgSts) 2621 .gmLN.fr.frdw.bc configure -background $GMEd(LN,Colour) 2622 if { $GMEd(LN,Displ) } { 2623 .gmLN.fr.frdw.displayed select 2624 } else { 2625 .gmLN.fr.frdw.displayed deselect 2626 } 2627 return 2628} 2629 2630proc GMLNCheck {} { 2631 # check validity of data in LN edit window 2632 # this depends on Storage(LN) 2633 global GMEd MESS 2634 2635 set id [.gmLN.fr.fr1.id get] 2636 if { ! [CheckString GMMessage $id] } { 2637 focus .gmLN.fr.fr1.id 2638 return nil 2639 } 2640 if { [llength $GMEd(LN,LPs)] < 2 } { 2641 GMMessage $MESS(voidLN) 2642 return nil 2643 } 2644 if { ! $GMEd(LN,MapChg) && \ 2645 ( $GMEd(LN,Width) != [lindex $GMEd(LN,Data) 6] || \ 2646 $GMEd(LN,Colour) != [lindex $GMEd(LN,Data) 7] ) } { 2647 set GMEd(LN,MapChg) 1 2648 } 2649 set r [list $id [CheckNB [.gmLN.fr.fr2.obs get 0.0 end]]] 2650 foreach e "Datum PFrmt LPs SgSts Width Colour MBack Displ" { 2651 lappend r $GMEd(LN,$e) 2652 } 2653 return $r 2654} 2655 2656proc GMLNChange {how args} { 2657 # perform edit operations on LN 2658 # $how is either one of the operations supported by GMPolyChange, or 2659 # loop add first point as last 2660 global GMEd 2661 2662 switch $how { 2663 loop { 2664 set boxes $GMEd(LN,boxes) 2665 set bxn [lindex $boxes 0] 2666 if { [set n [$bxn size]] < 2 } { return } 2667 lappend GMEd(LN,LPs) [lindex $GMEd(LN,LPs) 0] 2668 $bxn insert end [format "%4d." [incr n]] 2669 foreach box [lreplace $boxes 0 0] { 2670 $box insert end [$box get 0] 2671 } 2672 } 2673 default { 2674 GMPolyChange LN $how $args 2675 } 2676 } 2677 return 2678} 2679 2680proc GMLPChangeDatum {datum args} { 2681 # change datum of LP being edited 2682 # $args is not used but is needed as this is called-back from a menu 2683 2684 ChangeDatum $datum GMEd GMEd(LP,Datum) nil .gmLP.fr.fr1.frp normal 2685 return 2686} 2687 2688proc GMLinePoint {i} { 2689 # edit LP at position $i of listboxes in LN edit window 2690 # assume that the LN datum is kept compatible with LN position format 2691 global GMEd TXT INVTXT DPOSX DPOSY COLOUR ALUNIT 2692 2693 if { [set lp [lindex $GMEd(LN,LPs) $i]] == "" } { return } 2694 foreach "posn alt" [lindex $GMEd(LN,LPs) $i] { break } 2695 if { $posn == "" } { return } 2696 2697 set w .gmLP 2698 if { [winfo exists $w] } { Raise $w ; bell ; return } 2699 set pformt $GMEd(LN,PFrmt) 2700 set datum [set GMEd(LP,Datum) $GMEd(LN,Datum)] 2701 2702 GMToplevel $w nameLP +$DPOSX+$DPOSY .gmLN \ 2703 [list WM_DELETE_WINDOW "destroy $w"] \ 2704 {<Key-Return> {set GMEd(temp) 1 ; break}} 2705 2706 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 2707 label $w.fr.title -text $TXT(nameLP) 2708 2709 frame $w.fr.fr1 -relief flat -borderwidth 0 2710 ShowPosnDatum $w.fr.fr1 $pformt [list $posn] GMLPChangeDatum GMEd \ 2711 GMEd(LP,Datum) normal 1 nil 2712 2713 frame $w.fr.fr11 -relief flat -borderwidth 0 2714 label $w.fr.fr11.atit -text "$TXT(alt) ($ALUNIT):" 2715 entry $w.fr.fr11.alt -width 7 -exportselection 1 2716 set valt [UserAltitude $alt] 2717 ShowTEdit $w.fr.fr11.alt $valt 1 2718 2719 frame $w.fr.frb -relief flat -borderwidth 0 2720 button $w.fr.frb.ok -text $TXT(ok) -command "set GMEd(temp) 1" 2721 button $w.fr.frb.cnc -text $TXT(cancel) -command "set GMEd(temp) 0" 2722 2723 pack $w.fr.fr11.atit $w.fr.fr11.alt -side left -padx 3 2724 pack $w.fr.fr1.frp $w.fr.fr1.frd -side top -pady 3 2725 pack $w.fr.frb.ok $w.fr.frb.cnc -side left 2726 pack $w.fr.title $w.fr.fr1 $w.fr.fr11 $w.fr.frb -side top -pady 5 2727 pack $w.fr 2728 2729 update idletasks 2730 set gs [grab current] 2731 grab $w 2732 raise $w 2733 while 1 { 2734 tkwait variable GMEd(temp) 2735 if { $GMEd(temp) == 0 } { set ok 0 ; break } 2736 set p [PosnGetCheck $w.fr.fr1.frp.frp1 $GMEd(LP,Datum) GMMessage nil] 2737 if { $p == "nil" } { continue } 2738 set valt [string trim [$w.fr.fr11.alt get]] 2739 if { [set alt [AltitudeList $valt]] != "nil" } { set ok 1 ; break } 2740 GMMessage $MESS(badalt) 2741 } 2742 if { $ok } { 2743 # this depends on what proc ShowPosnDatum does! 2744 set pf $INVTXT([$w.fr.fr1.frp.pfmt cget -text]) 2745 if { $pf != $pformt || $GMEd(LP,Datum) != $datum } { 2746 # LN datum is always compatible with LN position format 2747 set p [lindex [FormatPosition [lindex $p 0] [lindex $p 1] \ 2748 $GMEd(LP,Datum) $pformt $datum] 0] 2749 } 2750 set lp [list $p $alt] 2751 set GMEd(LN,LPs) [lreplace $GMEd(LN,LPs) $i $i $lp] 2752 foreach "x boxp boxa" $GMEd(LN,boxes) { break } 2753 set selected [$boxp selection includes $i] 2754 $boxp delete $i ; $boxp insert $i [lrange $p 2 end] 2755 $boxa delete $i ; $boxa insert $i [UserAltitude $alt] 2756 if { $selected } { 2757 foreach b $GMEd(LN,boxes) { $b selection set $i } 2758 } 2759 } 2760 DestroyRGrabs $w $gs 2761 update idletasks 2762 return 2763} 2764 2765proc GMLNChangeDatum {datum args} { 2766 # change datum of LN being edited 2767 # $args not used but needed for call-back 2768 # this may fail if the current position format requires a fixed datum 2769 global GMEd MESS 2770 2771 if { $datum == [set od $GMEd(LN,Datum)] || \ 2772 ( [lindex $GMEd(LN,LPs) 200] != "" && \ 2773 ! [GMConfirm $MESS(timeconsmg)] ) } { return } 2774 SetCursor . watch 2775 if { [set pts [ChangeLPsDatum $GMEd(LN,LPs) $od $datum $GMEd(LN,PFrmt)]] \ 2776 == -1 } { 2777 ResetCursor . 2778 return 2779 } 2780 set box [lindex $GMEd(LN,boxes) 1] 2781 set sel [$box curselection] 2782 $box delete 0 end 2783 foreach lp $pts { 2784 $box insert end [lrange [lindex $lp 0] 2 end] 2785 } 2786 foreach s $sel { $box selection set $s } 2787 foreach box $GMEd(LN,boxes) { $box see 0 } 2788 set GMEd(LN,LPs) $pts 2789 set GMEd(LN,Datum) $datum 2790 ResetCursor . 2791 return 2792} 2793 2794proc ChangeLPsPFormt {lps pformt dvar dvref} { 2795 # change position format of a LN list of points 2796 # $dvar is global variable or array name containg current datum 2797 # $dvref is corresponding variable or array(element) name to use 2798 # in changing the datum if needs be 2799 global $dvar 2800 2801 set odatum [set $dvref] 2802 if { [set gdatum [BadDatumFor $pformt $odatum Ignore]] != 0 } { 2803 set $dvref $gdatum 2804 return [ChangeLPsDatum $lps $odatum $gdatum $pformt] 2805 } 2806 set l "" 2807 foreach lp $lps { 2808 foreach "latd longd" [lindex $lp 0] { break } 2809 set p [lindex [FormatPosition $latd $longd $odatum $pformt $odatum] 0] 2810 lappend l [lreplace $lp 0 0 $p] 2811 } 2812 return $l 2813} 2814 2815proc GMLNChangePFormt {pformt} { 2816 # change position format of LN being edited 2817 global GMEd TXT MESS 2818 2819 if { $pformt == $GMEd(LN,PFrmt) || \ 2820 ( [lindex $GMEd(LN,LPs) 200] != "" && \ 2821 ! [GMConfirm $MESS(timeconsmg)] ) } { return } 2822 SetCursor . watch 2823 set pts [ChangeLPsPFormt $GMEd(LN,LPs) $pformt GMEd GMEd(LN,Datum)] 2824 set box [lindex $GMEd(LN,boxes) 1] 2825 set sel [$box curselection] 2826 $box delete 0 end 2827 foreach lp $pts { 2828 $box insert end [lrange [lindex $lp 0] 2 end] 2829 } 2830 foreach s $sel { $box selection set $s } 2831 foreach box $GMEd(LN,boxes) { $box see 0 } 2832 set GMEd(LN,LPs) $pts 2833 set GMEd(LN,PFrmt) $TXT($pformt) 2834 ResetCursor . 2835 return 2836} 2837 2838proc FillLPs {w lps sgsts} { 2839 # insert LPs with segments $sgsts, in listboxes in LN edit/show 2840 # window $w 2841 2842 set i 0 ; set nxt [lindex $sgsts 0] 2843 foreach lp $lps { 2844 if { $nxt == $i } { 2845 set seg "@" 2846 set sgsts [lreplace $sgsts 0 0] 2847 set nxt [lindex $sgsts 0] 2848 } else { set seg "" } 2849 incr i 2850 $w.fr.fr3.frbx.bxn insert end [format "%4d." $i] 2851 $w.fr.fr3.frbx.bxpos insert end [lrange [lindex $lp 0] 2 end] 2852 $w.fr.fr3.frbx.bxalt insert end [UserAltitude [lindex $lp 1]] 2853 $w.fr.fr3.frbx.bxseg insert end $seg 2854 } 2855 return 2856} 2857 2858proc LNToTR {w} { 2859 # make a TR from the LN in window $w 2860 global GMEd LNLPoints LNDatum LNPFrmt LNSegStarts EdWindow TXT MESS 2861 2862 set tpfsa "alt latd longd latDMS longDMS" 2863 set tps "" 2864 if { $w == ".gmLN" } { 2865 if { [set lps $GMEd(LN,LPs)] == "" } { 2866 GMMessage $MESS(voidLN) 2867 return 2868 } 2869 set datum $GMEd(LN,Datum) ; set pformt $GMEd(LN,PFrmt) 2870 set sgsts $GMEd(LN,SgSts) 2871 } else { 2872 set ix [IndexNamed LN [$w.fr.fr1.id get]] 2873 set lps $LNLPoints($ix) ; set datum $LNDatum($ix) 2874 set pformt $LNPFrmt($ix) ; set sgsts $LNSegStarts($ix) 2875 } 2876 foreach lp $lps { 2877 foreach "p alt" $lp { break } 2878 if { $pformt != "DMS" } { 2879 set p [FormatLatLong [lindex $p 0] [lindex $p 1] DMS] 2880 } 2881 set p [lrange $p 0 3] 2882 lappend tps [FormData TP $tpfsa [linsert $p 0 $alt]] 2883 } 2884 if { $tps == "" } { bell ; return } 2885 if { [winfo exists $EdWindow(TR)] } { 2886 set name [NewName TR] 2887 set data [FormData TR "Name Datum TPoints SegStarts" \ 2888 [list $name $datum $tps $sgsts]] 2889 CreateItem TR $data 2890 GMMessage [format $MESS(convres) $TXT(TR) $name] 2891 } else { 2892 set opts "create revert cancel" 2893 GMTrack -1 $opts [FormData TR "Datum TPoints SegStarts" \ 2894 [list $datum $tps $sgsts]] 2895 } 2896 return 2897} 2898 2899proc GMLap {index options data} { 2900 # create dialog window for editing/showing data of LAP with given index 2901 # $options is a list of buttons to display; 2902 # $index is never -1, as LAPs cannot be created 2903 # an empty list means no editing; supported options are: 2904 # cancel, change, revert, forget 2905 # change and forget assume $index != -1, always true here 2906 # see proc GMButton for further details 2907 # if $options is empty, $index cannot be -1 as this is not a new LAP 2908 # the only button is OK, and only binding: return to destroy 2909 # the only things that can be changed in a LAP are the name, the 2910 # remark, the position format and the datum 2911 # order of elements in $data list reflects order in $Storage(LAP) 2912 # which is used below 2913 # return window path 2914 global GMEd DPOSX DPOSY COLOUR LISTHEIGHT COMMENTWIDTH \ 2915 OBSWIDTH OBSHEIGHT DATEWIDTH TXT SUBDSCALE DTUNIT SPUNIT \ 2916 ChangedLAPPos1 ChangedLAPPos2 2917 2918 foreach \ 2919 "name obs start dur dist begpos endpos cals trix pformt datum displ" \ 2920 $data {} 2921 set ed 0 ; set st disabled 2922 if { $options != "" } { 2923 if { [winfo exists .gmLAP] } { Raise .gmLAP ; bell ; return .gmLAP } 2924 set ed 1 ; set st normal 2925 set w .gmLAP 2926 set GMEd(LAP,Index) $index 2927 set GMEd(LAP,Datum) $datum ; set GMEd(LAP,PFrmt) $pformt 2928 # for uniformity, meaningless 2929 set GMEd(LAP,MapChg) 0 ; set GMEd(LAP,Displ) $displ 2930 # this depends on Storage(LAP) 2931 set GMEd(LAP,Data) $data 2932 set ChangedLAPPos1 $begpos ; set ChangedLAPPos2 $endpos 2933 set x $DPOSX 2934 set y $DPOSY 2935 } else { 2936 set w .gmLAPsh$index 2937 if { [winfo exists $w] } { destroy $w } 2938 incr GMEd(LAP,Show) 2939 set x [expr $DPOSX+50*((1+$GMEd(LAP,Show)) % 5)] 2940 set y [expr $DPOSY+50*((1+$GMEd(LAP,Show)) % 5)] 2941 } 2942 2943 if { $start != "" && $dur != "" } { 2944 foreach "startdate startsecs" $start { break } 2945 set dsecs [TimeToSecs $dur] 2946 set enddate [DateFromSecs [expr $startsecs+round($dsecs)]] 2947 if { $dist != "" } { 2948 set dist [expr $dist*$SUBDSCALE] 2949 set avgspeed [format "%.2f $SPUNIT" [expr 3600.0*$dist/$dsecs]] 2950 set dist [format "%.3f $DTUNIT" $dist] 2951 } else { set avgspeed "" } 2952 } else { 2953 foreach v "startdate enddate avgspeed" { set $v "" } 2954 } 2955 2956 GMToplevel $w nameLAP +$x+$y {} {} {} 2957 if { ! $ed } { 2958 wm protocol $w WM_DELETE_WINDOW "destroy $w" 2959 bind $w <Key-Return> "destroy $w" 2960 } else { 2961 wm protocol $w WM_DELETE_WINDOW { GMButton LAP cancel } 2962 } 2963 2964 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 2965 2966 frame $w.fr.fr1 -relief flat -borderwidth 0 2967 label $w.fr.fr1.id -text "$TXT(name): $name" 2968 2969 frame $w.fr.fr2 -relief flat -borderwidth 0 2970 label $w.fr.fr2.obstit -text "$TXT(rmrk):" 2971 text $w.fr.fr2.obs -wrap word -width $OBSWIDTH -height $OBSHEIGHT \ 2972 -exportselection true 2973 $w.fr.fr2.obs insert 0.0 $obs 2974 $w.fr.fr2.obs configure -state $st 2975 TextBindings $w.fr.fr2.obs 2976 2977 set frtm $w.fr.frtm 2978 frame $frtm -relief flat -borderwidth 0 2979 label $frtm.strt -text "$TXT(start): $startdate" 2980 label $frtm.dur -text "$TXT(duration): $dur" 2981 label $frtm.end -text "$TXT(stop): $enddate" 2982 2983 set frdi $w.fr.frdi 2984 frame $frdi -relief flat -borderwidth 0 2985 label $frdi.dst -text "$TXT(distance): $dist" 2986 label $frdi.spd -text "$TXT(avgsp): $avgspeed" 2987 label $frdi.cls -text "$TXT(calrs): $cals" 2988 2989 if { $ed } { 2990 ShowPosnDatum $w.fr $pformt [list $begpos $endpos] GMLAPChangeDatum \ 2991 GMEd GMEd(LAP,Datum) disabled 1 =ChangedLAPPos 2992 $w.fr.frp.pfmt configure -state normal 2993 $w.fr.frd.dttitle configure -state normal 2994 } else { 2995 ShowPosnDatum $w.fr $pformt [list $begpos $endpos] "" "" $datum $st \ 2996 0 nil 2997 } 2998 2999 set frtr $w.fr.frtr 3000 frame $frtr -relief flat -borderwidth 0 3001 label $frtr.tit -text "$TXT(nameTR):" 3002 if { $trix < 253 && [set trixix [IndexNamed TR $trix]] != -1 } { 3003 set trst normal 3004 } else { set trst disabled ; set trixix -1 } 3005 button $frtr.tr -text $trix -command "OpenItem TR $trixix" -state $trst 3006 button $frtr.disp -text $TXT(displ) -command "GMLAPDisplayTR $trixix" \ 3007 -state $trst 3008 3009 frame $w.fr.frsel -relief flat -borderwidth 0 3010 if { $ed } { 3011 set b $w.fr.frsel.b 3012 foreach e $options { 3013 button $b$e -text $TXT($e) \ 3014 -command "$b$e configure -state normal ; GMButton LAP $e" 3015 pack $b$e -side left 3016 } 3017 } else { 3018 button $w.fr.frsel.b -text $TXT(ok) -command "destroy $w" 3019 pack $w.fr.frsel.b 3020 } 3021 3022 pack $w.fr -side top 3023 pack $w.fr.fr1.id -side left -padx 3 3024 pack $w.fr.fr2.obstit $w.fr.fr2.obs -side left -padx 3 3025 set r -1 3026 foreach x "strt dur end" { 3027 grid $frtm.$x -row [incr r] -column 0 -sticky w 3028 } 3029 set r -1 3030 foreach x "dst spd cls" { 3031 grid $frdi.$x -row [incr r] -column 0 -sticky w 3032 } 3033 pack $frtr.tit $frtr.tr -side left -padx 0 3034 pack $frtr.disp -side left -padx 5 3035 3036 grid $w.fr.fr1 -row 0 -column 0 -columnspan 2 3037 grid $w.fr.fr2 -row 1 -column 0 -columnspan 2 -pady 5 3038 grid $w.fr.frtm -row 2 -column 0 -pady 5 3039 grid $w.fr.frdi -row 2 -column 1 -pady 5 -padx 10 3040 grid $w.fr.frp -row 3 -column 0 -columnspan 2 -pady 5 3041 grid $w.fr.frd -row 4 -column 0 -columnspan 2 -pady 5 3042 grid $w.fr.frtr -row 5 -column 0 -columnspan 2 -pady 5 3043 grid $w.fr.frsel -row 6 -column 0 -columnspan 2 -pady 5 3044 3045 update idletasks 3046 return $w 3047} 3048 3049proc GMLAPCheck {} { 3050 # check validity of data in LAP edit window 3051 # this depends on Storage(LAP) 3052 # return "nil" on error 3053 global GMEd INVTXT ChangedLAPPos1 ChangedLAPPos2 3054 3055 set nb [CheckNB [.gmLAP.fr.fr2.obs get 0.0 end]] 3056 set data $GMEd(LAP,Data) 3057 set r [lreplace $data 1 1 $nb] 3058 set r [lreplace $r 5 6 $ChangedLAPPos1 $ChangedLAPPos2] 3059 return [lreplace $r 9 10 $INVTXT([.gmLAP.fr.frp.pfmt cget -text]) \ 3060 $GMEd(LAP,Datum)] 3061} 3062 3063proc RevertLAP {} { 3064 # reset data in LAP edit window to initial values 3065 # this depends on Storage(LAP) 3066 global GMEd INVTXT POSTYPE 3067 3068 set data $GMEd(LAP,Data) 3069 .gmLAP.fr.fr2.obs delete 1.0 end 3070 .gmLAP.fr.fr2.obs insert 1.0 [lindex $data 1] 3071 set pft $POSTYPE($INVTXT([.gmLAP.fr.frp.pfmt cget -text])) 3072 set opf [lindex $data 9] ; set t $POSTYPE($opf) 3073 set p1 [lindex $data 5] ; set p2 [lindex $data 6] 3074 if { $pft == $t } { 3075 RevertPos .gmLAP.fr.frp.frp1 $opf $t $p1 3076 RevertPos .gmLAP.fr.frp.frp2 $opf $t $p2 3077 } else { 3078 RedrawPos .gmLAP.fr.frp.frp1 $opf $p1 ChangedPosn1 disabled 3079 RedrawPos .gmLAP.fr.frp.frp2 $opf $p2 ChangedPosn2 disabled 3080 } 3081 set GMEd(LAP,PFormt) $opf 3082 set GMEd(LAP,Datum) [lindex $data 10] 3083 return 3084} 3085 3086proc GMLAPChangeDatum {datum args} { 3087 # change datum of LAP being edited 3088 # $args is not used but is needed as this is called-back from a menu 3089 3090 ChangeDatum $datum GMEd GMEd(LAP,Datum) =ChangedLAPPos .gmLAP.fr.frp normal 3091 return 3092} 3093 3094proc GMLAPDisplayTR {ix} { 3095 # display existing TR associated to LAP 3096 # $ix is a valid TR index 3097 global TRDispl 3098 3099 if { ! $TRDispl($ix) } { PutMap TR $ix } 3100 return 3101} 3102 3103proc GMGroup {index options data} { 3104 # create dialog window for editing/showing data of GR with given index 3105 # $index is -1 if this is a new GR 3106 # $options is a list of buttons to display; 3107 # an empty list means no editing; supported options are: 3108 # cancel, create, change, revert, forget 3109 # change and forget assume $index != -1 3110 # see proc GMButton for further details 3111 # if $options is empty, $index cannot be -1 as this is not a new GR 3112 # the only button is OK, and only binding: return to destroy 3113 # otherwise a button "Forget GR&Contents" is always created 3114 # order of elements in $data list reflects order in $Storage(GR) 3115 # which is used below 3116 # return window path 3117 global GMEd MapLoading DPOSX DPOSY COLOUR LISTHEIGHT COMMENTWIDTH \ 3118 OBSWIDTH OBSHEIGHT TXT TYPES SUPPORTLAPS 3119 3120 set gtypes $TYPES 3121 if { $SUPPORTLAPS } { lappend gtypes LAP } 3122 foreach "name obs conts displ" $data {} 3123 set ed 0 ; set st disabled 3124 if { $options != "" } { 3125 if { [winfo exists .gmGR] } { Raise .gmGR ; bell ; return .gmGR } 3126 set ed 1 ; set st normal 3127 set w .gmGR 3128 set GMEd(GR,Index) $index ; set GMEd(GR,Displ) $displ 3129 set GMEd(GR,MapChg) 0 3130 set GMEd(GR,types) $gtypes 3131 # this depends on Storage(GR) 3132 set GMEd(GR,Data) $data 3133 set x $DPOSX 3134 set y $DPOSY 3135 } else { 3136 set w .gmGRsh$index 3137 if { [winfo exists $w] } { destroy $w } 3138 incr GMEd(GR,Show) 3139 set x [expr $DPOSX+50*(1+$GMEd(GR,Show) % 5)] 3140 set y [expr $DPOSY+50*(1+$GMEd(GR,Show) % 5)] 3141 } 3142 3143 toplevel $w 3144 wm title $w "$TXT(group)/GPS Manager" 3145 wm geometry $w +$x+$y 3146 if { ! $ed } { 3147 wm protocol $w WM_DELETE_WINDOW "destroy $w" 3148 bind $w <Key-Return> "destroy $w" 3149 } else { 3150 wm protocol $w WM_DELETE_WINDOW { GMButton GR cancel } 3151 } 3152 3153 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 3154 3155 frame $w.fr.fr1 -relief flat -borderwidth 0 3156 label $w.fr.fr1.ntitle -text "$TXT(name):" 3157 entry $w.fr.fr1.id -width $COMMENTWIDTH -exportselection 1 3158 ShowTEdit $w.fr.fr1.id $name $ed 3159 3160 frame $w.fr.fr2 -relief flat -borderwidth 0 3161 label $w.fr.fr2.obstit -text "$TXT(rmrk):" 3162 text $w.fr.fr2.obs -wrap word -width $OBSWIDTH -height $OBSHEIGHT \ 3163 -exportselection true 3164 $w.fr.fr2.obs insert 0.0 $obs 3165 $w.fr.fr2.obs configure -state $st 3166 TextBindings .gmGR.fr.fr2.obs 3167 3168 frame $w.fr.fr3 -relief flat -borderwidth 0 3169 frame $w.fr.fr3.frbx -relief flat -borderwidth 0 3170 foreach b "bxn bxw box" m "4 4 $COMMENTWIDTH" { 3171 listbox $w.fr.fr3.frbx.$b -height 15 -width $m -relief flat \ 3172 -yscrollcommand "$w.fr.fr3.frbx.bscr set" \ 3173 -selectmode extended -exportselection false 3174 bind $w.fr.fr3.frbx.$b <Double-1> \ 3175 "GRActItem $w.fr.fr3.frbx.$b %y open" 3176 bind $w.fr.fr3.frbx.$b <Button-3> \ 3177 "GRActItem $w.fr.fr3.frbx.$b %y toggle" 3178 bind $w.fr.fr3.frbx.$b <<ListboxSelect>> \ 3179 "MultExtSelect $w.fr.fr3.frbx.$b {bxn bxw box}" 3180 } 3181 # BSB contribution: wheelmouse scrolling 3182 set boxes [list $w.fr.fr3.frbx.box $w.fr.fr3.frbx.bxw $w.fr.fr3.frbx.bxn] 3183 scrollbar $w.fr.fr3.frbx.bscr -command [list ScrollMany $boxes] 3184 Mscroll $boxes 3185 3186 set i 1 3187 foreach p $conts { 3188 set wh [lindex $p 0] 3189 foreach e [lindex $p 1] { 3190 $w.fr.fr3.frbx.box insert end $e 3191 if { [IndexNamed $wh $e] == -1 } { 3192 $w.fr.fr3.frbx.box itemconfigure end \ 3193 -foreground $COLOUR(ballfg) 3194 } 3195 $w.fr.fr3.frbx.bxw insert end $TXT($wh) 3196 $w.fr.fr3.frbx.bxn insert end [format "%3d." $i] 3197 incr i 3198 } 3199 } 3200 3201 frame $w.fr.fr3.frbt -relief flat -borderwidth 0 3202 label $w.fr.fr3.frbt.title -text $TXT(element) 3203 foreach wh $gtypes { 3204 button $w.fr.fr3.frbt.ins$wh -relief raised \ 3205 -text "$TXT(insert) $TXT(name$wh)" -state $st \ 3206 -command "GMGRChange ins$wh ; \ 3207 $w.fr.fr3.frbt.ins$wh configure -state normal" 3208 } 3209 foreach a "del repl" { 3210 button $w.fr.fr3.frbt.$a -text $TXT($a) -state $st \ 3211 -command "GMGRChange $a" 3212 } 3213 frame $w.fr.fr3.frbt.sep -height 6 -bg $COLOUR(dialbg) \ 3214 -relief flat -borderwidth 0 3215 button $w.fr.fr3.frbt.join -text $TXT(joinGR) -state $st \ 3216 -command "ChItemsCall GR single GMGRChange join" 3217 menu $w.fr.fr3.frbt.join.m -tearoff 0 3218 button $w.fr.fr3.frbt.clear -text $TXT(clear) -state $st \ 3219 -command { GMGRChange clr } 3220 3221 set uwpsm $w.fr.fr3.frbt.uwps.m 3222 menubutton $w.fr.fr3.frbt.uwps -text $TXT(usewps) -relief raised \ 3223 -direction right -menu $uwpsm 3224 menu $uwpsm -tearoff 0 3225 $uwpsm add command -label $TXT(mkavgWP) \ 3226 -command "GMGRtoWP $w" 3227 3228 $uwpsm add cascade -label $TXT(chgname) -menu $uwpsm.ren 3229 menu $uwpsm.ren 3230 menu $uwpsm.ren.m -postcommand \ 3231 [list FillDefsMenu renamethod $uwpsm.ren.m [list GMGRRenameWPs $w]] 3232 $uwpsm.ren add cascade -label $TXT(use) -menu $uwpsm.ren.m 3233 $uwpsm.ren add command -label $TXT(define) \ 3234 -command "GMGRRenameWPs $w \[Define renamethod\]" 3235 3236 # JHT contribution: Change group waypoint symbol (menu item) 3237 $uwpsm add cascade -label $TXT(changegroupsymbol) \ 3238 -menu $uwpsm.symbol 3239 menu $uwpsm.symbol -tearoff 0 3240 FillSymbolsMenu $uwpsm.symbol ChangeGroupSymbol 3241 #--- 3242 $uwpsm add cascade -label $TXT(chgpfrmt) \ 3243 -menu $uwpsm.mpf 3244 menu $uwpsm.mpf -tearoff 0 3245 FillPFormtMenu $uwpsm.mpf GMGRChangeWPPFormt {} $w 3246 $uwpsm add cascade -label $TXT(chgdatum) \ 3247 -menu $uwpsm.mdat 3248 menu $uwpsm.mdat -tearoff 0 3249 FillDatumMenu $uwpsm.mdat GMGRChangeWPDatum 3250 $uwpsm add command -label $TXT(mkclusters) \ 3251 -command "MakeClusters $w" 3252 3253 frame $w.fr.frsel -relief flat -borderwidth 0 3254 # frame used for plug-ins (see array PLGSWelcomed, plugins.tcl) 3255 frame $w.fr.frdw 3256 if { $ed } { 3257 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 3258 -variable GMEd(GR,Displ) -onvalue 1 -offvalue 0 \ 3259 -selectcolor $COLOUR(check) 3260 if { $MapLoading != 0 } { 3261 $w.fr.frds.displayed configure -state disabled 3262 } 3263 set b $w.fr.frsel.b 3264 foreach e $options { 3265 button $b$e -text $TXT($e) \ 3266 -command "$b$e configure -state normal ; GMButton GR $e" 3267 pack $b$e -side left 3268 } 3269 button ${b}fgc -text $TXT(forgetGRcs) -command GRForgetConts 3270 pack ${b}fgc -side left -before $b$e 3271 } else { 3272 checkbutton $w.fr.frdw.displayed -text $TXT(displ) \ 3273 -state disabled -selectcolor $COLOUR(check) 3274 if { $displ } { $w.fr.frdw.displayed select } 3275 button $w.fr.frsel.bok -text $TXT(ok) -command "destroy $w" 3276 pack $w.fr.frsel.bok -side left 3277 } 3278 3279 pack $w.fr -side top 3280 pack $w.fr.fr1.ntitle $w.fr.fr1.id -side left -padx 3 3281 pack $w.fr.fr2.obstit $w.fr.fr2.obs -side left -padx 3 3282 set f $w.fr.fr3.frbx 3283 pack $f.bxn $f.bxw $f.box $f.bscr -side left -fill y 3284 set f $w.fr.fr3.frbt 3285 pack $f.title -side top -pady 2 -fill x 3286 foreach wh $gtypes { 3287 pack $f.ins$wh -side top -pady 2 -fill x 3288 } 3289 pack $f.del $f.repl $f.sep $f.join $f.clear $w.fr.fr3.frbt.uwps \ 3290 -side top -pady 2 -fill x 3291 pack $w.fr.fr3.frbx $w.fr.fr3.frbt -side left -padx 5 3292 pack $w.fr.frdw.displayed 3293 pack $w.fr.fr1 $w.fr.fr2 $w.fr.fr3 \ 3294 $w.fr.frdw $w.fr.frsel -side top -pady 5 3295 3296 AttachPlugIns $w 3297 3298 update idletasks 3299 return $w 3300} 3301 3302proc GRActItem {box y act} { 3303 # action on GR item 3304 # $box is the listbox causing action 3305 # $act in {open, toggle} 3306 global INVTXT COLOUR 3307 3308 set p [winfo parent $box] ; set ixl [$box nearest $y] 3309 set n [$p.box get $ixl] 3310 set wh $INVTXT([$p.bxw get $ixl]) 3311 if { $n != "" } { 3312 if { [set ix [IndexNamed $wh $n]] != -1 } { 3313 set cl fg 3314 switch $act { 3315 open { OpenItem $wh $ix } 3316 toggle { ToggleDisplayNamed $wh $n } 3317 } 3318 } else { set cl ballfg } 3319 $p.box itemconfigure $ixl -foreground $COLOUR($cl) 3320 } 3321 return 3322} 3323 3324proc RevertGR {} { 3325 # reset data in GR edit window to initial values 3326 # this depends on Storage(GR) 3327 global GMEd TXT 3328 3329 set data $GMEd(GR,Data) 3330 .gmGR.fr.fr1.id delete 0 end 3331 .gmGR.fr.fr1.id insert 0 [lindex $GMEd(GR,Data) 0] 3332 .gmGR.fr.fr2.obs delete 0.0 end 3333 .gmGR.fr.fr2.obs insert 0.0 [lindex $data 1] 3334 .gmGR.fr.fr3.frbx.box delete 0 end 3335 .gmGR.fr.fr3.frbx.bxw delete 0 end 3336 .gmGR.fr.fr3.frbx.bxn delete 0 end 3337 set i 1 3338 foreach p [lindex $data 2] { 3339 set wh [lindex $p 0] 3340 foreach e [lindex $p 1] { 3341 .gmGR.fr.fr3.frbx.box insert end $e 3342 .gmGR.fr.fr3.frbx.bxw insert end $TXT($wh) 3343 .gmGR.fr.fr3.frbx.bxn insert end [format "%3d." $i] 3344 incr i 3345 } 3346 } 3347 if { [set GMEd(GR,Displ) [lindex $data 3]] } { 3348 .gmGR.fr.frdw.displayed select 3349 } else { 3350 .gmGR.fr.frdw.displayed deselect 3351 } 3352 return 3353} 3354 3355proc NotWellFounded {gr1 gr2} { 3356 global GRConts 3357 3358 if { $gr1 == $gr2 } { return 1 } 3359 if { [set ix [IndexNamed GR $gr2]] != -1 } { 3360 foreach p $GRConts($ix) { 3361 if { [lindex $p 0] == "GR" } { 3362 foreach g [lindex $p 1] { 3363 if { [NotWellFounded $gr1 $g] } { return 1 } 3364 } 3365 } 3366 } 3367 } 3368 return 0 3369} 3370 3371proc GMGRCheck {} { 3372 # check validity of data in GR edit window 3373 # this depends on Storage(GR) 3374 global GMEd MESS INVTXT TYPES 3375 3376 set id [.gmGR.fr.fr1.id get] 3377 if {! [CheckString GMMessage $id] } { 3378 focus .gmGR.fr.fr1.id 3379 return nil 3380 } 3381 if { [.gmGR.fr.fr3.frbx.box size] == 0 } { 3382 GMMessage $MESS(voidGR) 3383 return nil 3384 } 3385 set types $TYPES ; lappend types LAP 3386 foreach wh $types { set es($wh) "" } 3387 foreach twh [.gmGR.fr.fr3.frbx.bxw get 0 end] \ 3388 e [.gmGR.fr.fr3.frbx.box get 0 end] { 3389 lappend es($INVTXT($twh)) $e 3390 } 3391 if { $GMEd(GR,Index) != -1 && $id == [lindex $GMEd(GR,Data) 0] } { 3392 foreach g $es(GR) { 3393 if { [NotWellFounded $id $g] } { 3394 GMMessage "$MESS(initselfGR) $g" 3395 return nil 3396 } 3397 } 3398 } 3399 set cs "" 3400 foreach wh $types { 3401 if { $es($wh) != "" } { 3402 lappend cs [list $wh $es($wh)] 3403 } 3404 } 3405 return [list $id [CheckNB [.gmGR.fr.fr2.obs get 0.0 end]] $cs \ 3406 $GMEd(GR,Displ)] 3407} 3408 3409proc GRInsert {wh list} { 3410 # insert elements in group being edited 3411 # $wh is type of elements whose names are in $list 3412 # GR well-foundedness will be checked when creating/changing 3413 global TXT INVTXT 3414 3415 if { $list == "" || ! [winfo exists .gmGR] } { return } 3416 set n [.gmGR.fr.fr3.frbx.box size] 3417 for { set i 0 } { $i < $n } { incr i } { 3418 if { $INVTXT([.gmGR.fr.fr3.frbx.bxw get $i]) == $wh } { 3419 break 3420 } 3421 } 3422 set f $i 3423 while { $i<$n && $INVTXT([.gmGR.fr.fr3.frbx.bxw get $i]) == $wh } { 3424 incr i 3425 } 3426 set l $i 3427 foreach name $list { 3428 set ok 1 3429 for { set k $f } { $k < $l } { incr k } { 3430 if { [.gmGR.fr.fr3.frbx.box get $k] == $name } { 3431 bell ; set ok 0 3432 } 3433 } 3434 if { $ok } { 3435 foreach b "bxn box bxw" k "end $i $i" \ 3436 m [list [format "%3d." [expr $n+1]] $name $TXT($wh)] { 3437 .gmGR.fr.fr3.frbx.$b insert $k $m 3438 .gmGR.fr.fr3.frbx.$b selection clear 0 end 3439 } 3440 incr i ; incr n 3441 } 3442 } 3443 return 3444} 3445 3446proc GRForgetConts {} { 3447 # forget a group being edited and all its contents 3448 global GMEd INVTXT MESS 3449 3450 if { ! [GMConfirm $MESS(frgetGRcs)] || \ 3451 ! [winfo exists .gmGR] } { return } 3452 set id [.gmGR.fr.fr1.id get] 3453 if { [.gmGR.fr.fr3.frbx.box size] != 0 } { 3454 foreach wh $GMEd(GR,types) { set es_$wh "" } 3455 foreach twh [.gmGR.fr.fr3.frbx.bxw get 0 end] \ 3456 e [.gmGR.fr.fr3.frbx.box get 0 end] { 3457 lappend es_$INVTXT($twh) $e 3458 } 3459 if { $GMEd(GR,Index) != -1 && $id == [lindex $GMEd(GR,Data) 0] } { 3460 foreach g $es_GR { 3461 if { [NotWellFounded $id $g] } { 3462 GMMessage "$MESS(initselfGR) $g" 3463 return 3464 } 3465 } 3466 } 3467 foreach g $es_GR { 3468 foreach p [GRGetElements $g] { 3469 set wh [lindex $p 0] 3470 set es_$wh [concat [lindex $p 1] [set es_$wh]] 3471 } 3472 } 3473 foreach wh $GMEd(GR,types) { 3474 if { [set l [set es_$wh]] != "" } { 3475 set l [lsort $l] ; set prev "" 3476 while { $l != "" } { 3477 set n [lindex $l 0] ; set l [lreplace $l 0 0] 3478 if { $n != $prev } { 3479 set prev $n 3480 if { [set ix [IndexNamed $wh $n]] != -1 && \ 3481 [Forget $wh $ix] } { 3482 CloseItemWindows $wh $ix 3483 } 3484 } 3485 } 3486 } 3487 } 3488 } 3489 destroy .gmGR 3490 if { $GMEd(GR,Index) != -1 } { 3491 Forget GR $GMEd(GR,Index) 3492 } 3493 return 3494} 3495 3496proc GMGRChange {how args} { 3497 # perform edit operations on GR 3498 # $how is one of 3499 # ins$wh insert item of type $wh (in {WP, RT, TR, GR, LAP?}) 3500 # del delete all selected items 3501 # repl replace first selected item by another one of same type 3502 # join join (set union) other GR 3503 # clr set to void 3504 # $args is the name of the new item for $how in {join} 3505 # Note that GMGRMapChg is not affected: changes in a mapped GR will not 3506 # affect mapping of its old or new elements 3507 global GRConts Number INVTXT 3508 3509 set sel [.gmGR.fr.fr3.frbx.box curselection] 3510 switch -glob $how { 3511 ins* { 3512 regsub ins $how "" wh 3513 if { $Number($wh) > 0 } { 3514 GRInsert $wh [Apply [ChooseItems $wh] NameOf $wh] 3515 } 3516 } 3517 repl { 3518 # GR well-foundedness will be checked when creating/changing 3519 if { [set sel [lindex $sel 0]] == "" } { return } 3520 set wh $INVTXT([.gmGR.fr.fr3.frbx.bxw get $sel]) 3521 if { [set ix [ChooseItems $wh single]] == "" } { return } 3522 set new [NameOf $wh $ix] 3523 foreach e [.gmGR.fr.fr3.frbx.box get 0 end] \ 3524 ewh [.gmGR.fr.fr3.frbx.bxw get 0 end] { 3525 if { $wh == $INVTXT($ewh) && $new == $e } { 3526 bell 3527 return 3528 } 3529 } 3530 .gmGR.fr.fr3.frbx.box insert $sel $new 3531 .gmGR.fr.fr3.frbx.box delete [expr $sel+1] 3532 .gmGR.fr.fr3.frbx.box selection set $sel 3533 } 3534 del { 3535 if { $sel == "" } { return } 3536 foreach s [lsort -integer -decreasing $sel] { 3537 .gmGR.fr.fr3.frbx.box delete $s 3538 .gmGR.fr.fr3.frbx.bxw delete $s 3539 .gmGR.fr.fr3.frbx.bxn delete end 3540 } 3541 .gmGR.fr.fr3.frbx.bxw selection clear 0 end 3542 .gmGR.fr.fr3.frbx.bxn selection clear 0 end 3543 } 3544 join { 3545 foreach p $GRConts([IndexNamed GR [lindex $args 0]]) { 3546 GRInsert [lindex $p 0] [lindex $p 1] 3547 } 3548 } 3549 clr { 3550 .gmGR.fr.fr3.frbx.box delete 0 end 3551 .gmGR.fr.fr3.frbx.bxw delete 0 end 3552 .gmGR.fr.fr3.frbx.bxn delete 0 end 3553 } 3554 } 3555 return 3556} 3557 3558proc GRGetElements {gr} { 3559 # collect all elements in GR $gr, recursively 3560 # assume GR is not being edited and that all GRs are well-founded 3561 # return list of pairs with type and list names of elements 3562 global GRConts TYPES SUPPORTLAPS 3563 3564 set gtypes $TYPES 3565 if { $SUPPORTLAPS } { lappend gtypes LAP } 3566 if { [set ix [IndexNamed GR $gr]] == -1 } { return "" } 3567 foreach wh $gtypes { set es_$wh "" } 3568 set grs "" 3569 foreach p $GRConts($ix) { 3570 set wh [lindex $p 0] 3571 set es_$wh [lindex $p 1] 3572 if { $wh == "GR" } { set grs [set es_$wh] } 3573 } 3574 foreach g $grs { 3575 foreach p [GRGetElements $g] { 3576 set wh [lindex $p 0] 3577 set es_$wh [concat [lindex $p 1] [set es_$wh]] 3578 } 3579 } 3580 set ps "" 3581 foreach wh $gtypes { 3582 if { [set es_$wh] != "" } { lappend ps [list $wh [set es_$wh]] } 3583 } 3584 return $ps 3585} 3586 3587proc GMGRCollectWPs {window} { 3588 # collect all WPs in GR shown in $window, recursively 3589 # return "void", "error" (a message is issued), or list of indices of WPs 3590 global TYPES INVTXT GMEd GMember MESS 3591 3592 set id [$window.fr.fr1.id get] 3593 if { $window == ".gmGR" } { 3594 if { [.gmGR.fr.fr3.frbx.box size] == 0 } { return void } 3595 set gtypes $TYPES ; lappend gtypes LAP 3596 foreach wh $gtypes { set es($wh) "" } 3597 foreach twh [.gmGR.fr.fr3.frbx.bxw get 0 end] \ 3598 e [.gmGR.fr.fr3.frbx.box get 0 end] { 3599 lappend es($INVTXT($twh)) $e 3600 } 3601 if { $GMEd(GR,Index) != -1 && $id == [lindex $GMEd(GR,Data) 0] } { 3602 foreach g $es(GR) { 3603 if { [NotWellFounded $id $g] } { 3604 GMMessage "$MESS(initselfGR) $g" 3605 return "error" 3606 } 3607 } 3608 } 3609 catch {unset GMember} 3610 foreach wp $es(WP) { 3611 set GMember([IndexNamed WP $wp]) 1 3612 } 3613 set grixs "" 3614 foreach gr $es(GR) { 3615 lappend grixs [IndexNamed GR $gr] 3616 } 3617 if { $grixs != "" } { GRsElsCollect $grixs 1 WP } 3618 set ixs [array names GMember] 3619 catch {unset GMember} 3620 } else { 3621 set grix [IndexNamed GR $id] 3622 set ixs [GRsElements $grix 1 WP] 3623 } 3624 return $ixs 3625} 3626 3627proc GMGRCollectWPNames {window} { 3628 # collect all WP names in GR shown in $window (not recursively) 3629 # return list of names possibly empty 3630 global TXT INVTXT 3631 3632 set names {} 3633 foreach twh [$window.fr.fr3.frbx.bxw get 0 end] \ 3634 name [$window.fr.fr3.frbx.box get 0 end] { 3635 if { $INVTXT($twh) == "WP" } { 3636 lappend names $name 3637 } 3638 } 3639 return $names 3640} 3641 3642# JHT contribution: Change group waypoint symbol (gang edit) 3643proc ChangeGroupSymbol {newsymbol window} { 3644 # change the symbol of all WPs in GR shown in $window 3645 global MESS EdWindow WPSymbol WPDispl 3646 3647 regexp {^(\.[^.]+)\.} $window match window 3648 switch [set ixs [GMGRCollectWPs $window]] { 3649 void { 3650 GMMessage $MESS(voidGR) ; return 3651 } 3652 error { 3653 return 3654 } 3655 } 3656 if { $ixs == "" } { bell ; return } 3657 foreach ix $ixs { 3658 if { $WPSymbol($ix) != $newsymbol } { 3659 set WPSymbol($ix) $newsymbol 3660 UpdateItemWindows WP $ix 3661 if { $WPDispl($ix) } { 3662 ChangeMapWPSymbol $ix $newsymbol 3663 } 3664 } 3665 } 3666 return 3667} 3668 3669proc GMGRChangeWPPFormt {pformt window} { 3670 # change the position format of all WPs in GR shown in $window 3671 # this may cause the datum of some WPs to be changed 3672 # nothing is done on WPs for which $pformt is invalid 3673 global MESS EdWindow WPPosn WPDatum WPPFrmt 3674 3675 switch [set ixs [GMGRCollectWPs $window]] { 3676 void { 3677 GMMessage $MESS(voidGR) ; return 3678 } 3679 error { 3680 return 3681 } 3682 } 3683 if { $ixs == "" } { bell ; return } 3684 foreach ix $ixs { 3685 if { [set of $WPPFrmt($ix)] != $pformt } { 3686 foreach "la lo" $WPPosn($ix) { break } 3687 foreach "p pfmt datum" \ 3688 [FormatPosition $la $lo $WPDatum($ix) $pformt ""] { break } 3689 if { $pfmt != $of && [lindex $p 2] != "--" } { 3690 set WPPosn($ix) $p ; set WPPFrmt($ix) $pfmt 3691 set WPDatum($ix) $datum 3692 UpdateItemWindows WP $ix 3693 } 3694 } 3695 } 3696 return 3697} 3698 3699proc GMGRChangeWPDatum {datum menu} { 3700 # change the datum of all WPs in GR shown in top-level window with $menu 3701 # fails silently for each WP whose position format is a grid requiring 3702 # a different datum 3703 global MESS EdWindow WPPosn WPDatum WPPFrmt 3704 3705 regexp {^(\.[^.]+)\.} $menu match window 3706 switch [set ixs [GMGRCollectWPs $window]] { 3707 void { 3708 GMMessage $MESS(voidGR) ; return 3709 } 3710 error { 3711 return 3712 } 3713 } 3714 if { $ixs == "" } { bell ; return } 3715 foreach ix $ixs { 3716 if { [set od $WPDatum($ix)] != $datum } { 3717 set pfmt $WPPFrmt($ix) 3718 if { [BadDatumFor $pfmt $datum Ignore] != 0 } { 3719 continue 3720 } 3721 set p $WPPosn($ix) 3722 set WPPosn($ix) [lindex [FormatPosition [lindex $p 0] \ 3723 [lindex $p 1] $od $pfmt $datum] 0] 3724 set WPDatum($ix) $datum 3725 UpdateItemWindows WP $ix 3726 } 3727 } 3728 return 3729} 3730 3731proc GMToggleSegStart {wh w ix} { 3732 # toggle segment start flag at index $ix in listbox $w of edit window 3733 # $wh in {TR, LN} 3734 global GMEd 3735 3736 if { $ix <= 0 || $ix >= [$w size] } { return } 3737 if { [$w get $ix] == "" } { 3738 set seg "@" 3739 set GMEd($wh,SgSts) [lsort -integer -increasing \ 3740 [linsert $GMEd($wh,SgSts) 0 $ix]] 3741 } else { 3742 set seg "" 3743 if { [set k [lsearch -exact $GMEd($wh,SgSts) $ix]] == -1 } { return } 3744 set GMEd($wh,SgSts) [lreplace $GMEd($wh,SgSts) $k $k] 3745 } 3746 set selected [$w selection includes $ix] 3747 $w delete $ix ; $w insert $ix $seg 3748 if { $selected } { $w selection set $ix } 3749 set GMEd($wh,MapChg) 1 3750 return 3751} 3752 3753proc ChopPolyline {wh whpt ix1 ixn} { 3754 # delete all points in polyline in range $ix1 to $ixn (indices from 0) 3755 # and may extend to the end 3756 # $wh in {TR, LN} 3757 # $whpt in {TP, LP} depending on $wh 3758 # adjust segments and keep selections 3759 global GMEd 3760 3761 set boxes $GMEd($wh,boxes) 3762 set bxn [lindex $boxes 0] 3763 set sel [$bxn curselection] 3764 set n [$bxn size] 3765 if { $ixn == "end" } { 3766 set ixn [expr $n-1] 3767 } 3768 # MB contribution 3769 if { $ix1 == "end" } { 3770 set ix1 [expr $n-1] 3771 } 3772 #--- 3773 set dn [expr $ixn-$ix1+1] 3774 if { $ix1 == $ixn } { 3775 set fd end 3776 } else { 3777 set fd [expr $n-$dn] 3778 } 3779 foreach box [lreplace $boxes 0 0] { 3780 $box delete $ix1 $ixn 3781 $box see $ix1 3782 } 3783 set ixnn [expr $ixn+1] 3784 if { $ix1 == 0 } { 3785 # make sure new first point is not marked as starting a segment 3786 set bxseg [lindex $boxes end] 3787 $bxseg delete 0 ; $bxseg insert 0 "" 3788 if { [lsearch -exact $sel $ixnn] != -1 } { $bxseg selection set 0 } 3789 } 3790 $bxn selection clear $ix1 $ixn 3791 $bxn delete $fd end 3792 $bxn see $ix1 3793 foreach sl $sel { 3794 if { $sl > $ixn } { $bxn selection set [expr $sl-$dn] } 3795 } 3796 if { [set GMEd($wh,${whpt}s) [lreplace $GMEd($wh,${whpt}s) $ix1 $ixn]] \ 3797 == "" } { 3798 set GMEd($wh,SgSts) "" 3799 } else { 3800 set sgs "" ; incr ixn 3801 foreach sp $GMEd($wh,SgSts) { 3802 if { $sp < $ix1 } { 3803 lappend sgs $sp 3804 } elseif { $sp > $ixn && $sp > $dn } { 3805 lappend sgs [expr $sp-$dn] 3806 } 3807 } 3808 set GMEd($wh,SgSts) $sgs 3809 } 3810 return 3811} 3812 3813proc SplitPolyLine {wh how w ed ix} { 3814 # split a polyline into similar items 3815 # $wh in {RT, TR, LN} 3816 # $how in {sel, segm}: split using selected points or segment starters 3817 # $w window with poolyline to split 3818 # $ed set if $w is edit window 3819 # $ix index of item to split (may be -1 if $ed) 3820 # create a group with the new items 3821 # there is a local variable Datum not to be confused with the global one! 3822 global GMEd RTIdNumber RTStages RTWidth RTColour RTMBack TRName TRDatum \ 3823 TRTPoints TRSegStarts TRWidth TRColour TRMBack LNName LNDatum LNPFrmt \ 3824 LNLPoints LNSegStarts LNWidth LNColour LNMBack GRName MESS TXT 3825 3826 set newixs "" 3827 if { $wh == "RT" } { 3828 # $how must be "sel" 3829 set box $w.fr.fr3.fr31.frbx.box 3830 if { [set sel [$box curselection]] == "" || \ 3831 [set wpns [$box get 0 end]] == "" } { bell ; return } 3832 if { $ed } { 3833 set Stages [GMRTStages $w.fr.fr3.fr31.frbx] 3834 foreach t "Width Colour MBack" { 3835 set $t $GMEd(RT,$t) 3836 } 3837 set orgname [$w.fr.fr1.id get] 3838 } else { 3839 foreach t "IdNumber Stages Width Colour MBack" { 3840 set $t [set RT[set t]($ix)] 3841 } 3842 set orgname $IdNumber 3843 } 3844 set fs "IdNumber WPoints Stages Width Colour MBack" 3845 foreach p [MakeSplit [list $wpns $Stages] $sel] { 3846 foreach "wps sts" $p {} 3847 if { [llength $wps] > 1 } { 3848 set id [NewName RT] 3849 set data [FormData RT $fs \ 3850 [list $id $wps $sts $Width $Colour $MBack]] 3851 CreateItem RT $data 3852 SetWPRoute $id $wps 3853 lappend newits $id 3854 } 3855 } 3856 } else { 3857 # TR or LN 3858 set pre [string index $wh 0] 3859 set fs "Name Datum ${pre}Points Width Colour MBack" 3860 if { $wh == "LN" } { 3861 set line 1 3862 lappend fs PFrmt 3863 } else { set line 0 } 3864 if { $ed } { 3865 set ptsref "${pre}Ps" 3866 foreach t "Datum $ptsref SgSts Width Colour MBack" { 3867 set $t $GMEd($wh,$t) 3868 } 3869 if { $line } { set PFrmt $GMEd($wh,PFrmt) } 3870 set SegStarts $SgSts 3871 set orgname [$w.fr.fr1.id get] 3872 } else { 3873 set ptsref "${pre}Points" 3874 foreach t "Name Datum $ptsref SegStarts Width Colour MBack" { 3875 set $t [set $wh[set t]($ix)] 3876 } 3877 if { $line } { set PFrmt $LNPFrmt($ix) } 3878 set orgname $Name 3879 } 3880 if { [set pts [set $ptsref]] == "" } { bell ; return } 3881 if { $how == "sel" } { 3882 set box $w.fr.fr3.frbx.bxn 3883 set sel [$box curselection] 3884 set segs 1 3885 lappend fs SegStarts 3886 set del 0 3887 set sgstnxt [lindex $SegStarts 0] 3888 set SegStarts [lreplace $SegStarts 0 0] 3889 } else { 3890 set sel $SegStarts 3891 set segs 0 3892 } 3893 if { $sel == "" } { bell ; return } 3894 3895 foreach xps [MakeSplit [list $pts] $sel] { 3896 set xps [lindex $xps 0] 3897 if { [set nxps [llength $xps]] > 1 } { 3898 set name [NewName $wh] 3899 set dt [list $name $Datum $xps $Width $Colour $MBack] 3900 if { $line } { lappend dt $PFrmt } 3901 if { $segs } { 3902 set xsegs "" 3903 while { [set ns [expr $sgstnxt-$del]] < $nxps } { 3904 if { $ns > 0 } { lappend xsegs $ns } 3905 if { [set sgstnxt [lindex $SegStarts 0]] == "" } { 3906 break 3907 } 3908 set SegStarts [lreplace $SegStarts 0 0] 3909 } 3910 lappend dt $xsegs 3911 incr del $nxps 3912 } 3913 set data [FormData $wh $fs $dt] 3914 CreateItem $wh $data 3915 lappend newits $name 3916 if { $segs && $sgstnxt == "" } { 3917 set fs [Delete $fs SegStarts] 3918 set segs 0 3919 } 3920 } elseif { $segs && $nxps == 1 } { 3921 if { $sgstnxt-$del == 0 } { 3922 if { [set sgstnxt [lindex $SegStarts 0]] == "" } { 3923 set fs [Delete $fs SegStarts] 3924 set segs 0 3925 } else { set SegStarts [lreplace $SegStarts 0 0] } 3926 } 3927 incr del 3928 } 3929 } 3930 } 3931 if { $newits != "" } { 3932 set obs [format $MESS(obssplit) $wh $orgname] 3933 set grix [CreateGRFor split $obs [list [list $wh $newits]]] 3934 GMMessage [format $MESS(convres) $TXT(GR) $GRName($grix)] 3935 } 3936 return 3937} 3938 3939proc GMPolyChange {wh how args} { 3940 # perform edit operations on polyline 3941 # $wh in {TR, LN} 3942 # $how is one of 3943 # chh chop head: delete all points from the beginning to first 3944 # selected or only the first one 3945 # cht chop tail: delete all points from the last selected to end 3946 # or only the last one 3947 # incb include a similar polyline at the beginning 3948 # app append a polyline (to end, of course) 3949 # loop add first point to end 3950 # del delete all selected points 3951 # clear delete all points 3952 # $args has the name of the other polyline when $how is in {incb, app} 3953 global TRTPoints TRSegStarts TRDatum LNLPoints LNSegStarts LNDatum \ 3954 LNPFrmt GMEd EdWindow 3955 3956 set whpt $GMEd($wh,ptname) 3957 set GMEd($wh,MapChg) 1 3958 set boxes $GMEd($wh,boxes) 3959 set bxn [lindex $boxes 0] 3960 set sel [lsort -integer -increasing [$bxn curselection]] 3961 set sel0 [lindex $sel 0] ; set sell [lindex $sel end] 3962 switch $how { 3963 chh { 3964 if { [$bxn size] == 0 } { return } 3965 if { $sel == "" } { set sel0 0 } 3966 ChopPolyline $wh $whpt 0 $sel0 3967 } 3968 cht { 3969 if { [$bxn size] == 0 } { return } 3970 if { $sel == "" } { set sell end } 3971 ChopPolyline $wh $whpt $sell end 3972 } 3973 incb { 3974 set name [lindex [lindex $args 0] 0] 3975 if { [set ix [IndexNamed $wh $name]] != -1 } { 3976 set pts [set ${wh}${whpt}oints($ix)] 3977 set sgs [set ${wh}SegStarts($ix)] 3978 set datum [set ${wh}Datum($ix)] 3979 foreach box $boxes { $box selection clear 0 end } 3980 set dboxes [lreplace $boxes 0 0] 3981 set npts [$bxn size] ; set ins 0 3982 switch $wh { 3983 TR { 3984 if { $GMEd($wh,Datum) != $datum } { 3985 set pts [ChangeTPsDatum $pts $dat $GMEd($wh,Datum)] 3986 } 3987 if { $npts == 0 } { 3988 FillTPs $EdWindow($wh) $pts $sgs 3989 set GMEd($wh,${whpt}s) $pts 3990 set GMEd($wh,SgSts) $sgs 3991 return 3992 } 3993 if { [set d [GMTRNewDate $pts $GMEd(TR,TPs)]] == -1 } { 3994 return 3995 } 3996 set d [expr [lindex $d 1]- \ 3997 [lindex [lindex $GMEd(TR,TPs) 0] 5]] 3998 foreach tp $pts { 3999 incr npts 4000 $bxn insert end [format "%4d." $npts] 4001 foreach box $dboxes \ 4002 v [list [lindex $tp 4] \ 4003 [lindex $tp 2] [lindex $tp 3] \ 4004 [UserAltitude [lindex $tp 6]] \ 4005 [lindex $tp 7] \ 4006 ""] { 4007 $box insert $ins $v 4008 } 4009 incr ins 4010 } 4011 set l $pts 4012 foreach tp $GMEd(TR,TPs) { 4013 set ns [expr [lindex $tp 5]+$d] 4014 set nd [DateFromSecs $ns] 4015 lappend l [lreplace $tp 4 5 $nd $ns] 4016 .gmTR.fr.fr3.frbx.bxd delete $ins 4017 .gmTR.fr.fr3.frbx.bxd insert $ins $nd 4018 incr ins 4019 } 4020 set pts $l 4021 } 4022 LN { 4023 if { $GMEd($wh,Datum) != $datum } { 4024 set pts [ChangeLPsDatum $pts $datum \ 4025 $GMEd($wh,Datum) $GMEd(LN,PFrmt)] 4026 } elseif { $LNPFrmt($ix) != $GMEd(LN,PFrmt) } { 4027 set GMEd(temp) $GMEd($wh,Datum) 4028 set pts [ChangeLPsPFormt $pts $GMEd(LN,PFrmt) \ 4029 GMEd GMEd(temp)] 4030 } 4031 if { $npts == 0 } { 4032 FillLPs $EdWindow($wh) $pts $sgs 4033 set GMEd($wh,${whpt}s) $pts 4034 set GMEd($wh,SgSts) $sgs 4035 return 4036 } 4037 foreach lp $pts { 4038 incr npts 4039 $bxn insert end [format "%4d." $npts] 4040 foreach box $dboxes \ 4041 v [list [lrange [lindex $lp 0] 2 end] \ 4042 [UserAltitude [lindex $lp 1]] \ 4043 ""] { 4044 $box insert $ins $v 4045 } 4046 incr ins 4047 } 4048 set pts [concat $pts $GMEd($wh,${whpt}s)] 4049 } 4050 } 4051 set GMEd($wh,${whpt}s) $pts 4052 set usgs "" 4053 foreach sp $GMEd($wh,SgSts) { 4054 lappend usgs [expr $sp+$ins] 4055 } 4056 set GMEd($wh,SgSts) [concat $sgs $usgs] 4057 set bxseg [lindex $boxes end] 4058 foreach sp $sgs { 4059 $bxseg delete $sp 4060 $bxseg insert $sp "@" 4061 } 4062 } 4063 } 4064 app { 4065 set name [lindex [lindex $args 0] 0] 4066 if { [set ix [IndexNamed $wh $name]] != -1 } { 4067 set pts [set ${wh}${whpt}oints($ix)] 4068 set sgs [set ${wh}SegStarts($ix)] 4069 set datum [set ${wh}Datum($ix)] 4070 foreach box $boxes { $box selection clear 0 end } 4071 set dboxes [lreplace $boxes 0 0] 4072 set ins [set npts [$bxn size]] 4073 switch $wh { 4074 TR { 4075 if { $GMEd($wh,Datum) != $datum } { 4076 set pts [ChangeTPsDatum $pts $dat $GMEd($wh,Datum)] 4077 } 4078 if { $npts == 0 } { 4079 FillTPs $EdWindow($wh) $pts $sgs 4080 set GMEd($wh,${whpt}s) $pts 4081 set GMEd($wh,SgSts) $sgs 4082 return 4083 } 4084 if { [set d [GMTRNewDate $GMEd(TR,TPs) $pts]] == -1 } { 4085 return 4086 } 4087 set d [expr [lindex $d 1]- \ 4088 [lindex [lindex $pts 0] 5]] 4089 4090 set l $GMEd(TR,TPs) 4091 foreach tp $pts { 4092 incr ins 4093 set ns [expr [lindex $tp 5]+$d] 4094 set nd [DateFromSecs $ns] 4095 lappend l [lreplace $tp 4 5 $nd $ns] 4096 foreach box $boxes \ 4097 v [list [format "%4d." $ins] \ 4098 $nd \ 4099 [lindex $tp 2] [lindex $tp 3] \ 4100 [UserAltitude [lindex $tp 6]] \ 4101 [lindex $tp 7] \ 4102 ""] { 4103 $box insert end $v 4104 } 4105 } 4106 set GMEd(TR,TPs) $l 4107 } 4108 LN { 4109 if { $GMEd($wh,Datum) != $datum } { 4110 set pts [ChangeLPsDatum $pts $datum \ 4111 $GMEd($wh,Datum) $GMEd(LN,PFrmt)] 4112 } elseif { $LNPFrmt($ix) != $GMEd(LN,PFrmt) } { 4113 set GMEd(temp) $GMEd($wh,Datum) 4114 set pts [ChangeLPsPFormt $pts $GMEd(LN,PFrmt) \ 4115 GMEd GMEd(temp)] 4116 } 4117 if { $npts == 0 } { 4118 FillLPs $EdWindow($wh) $pts $sgs 4119 set GMEd($wh,${whpt}s) $pts 4120 set GMEd($wh,SgSts) $sgs 4121 return 4122 } 4123 foreach lp $pts { 4124 incr ins 4125 foreach box $boxes \ 4126 v [list [format "%4d." $ins] \ 4127 [lrange [lindex $lp 0] 2 end] \ 4128 [UserAltitude [lindex $lp 1]] \ 4129 ""] { 4130 $box insert end $v 4131 } 4132 } 4133 set GMEd(LN,LPs) [concat $GMEd(LN,LPs) $pts] 4134 } 4135 } 4136 set bxseg [lindex $boxes end] 4137 foreach sp $sgs { 4138 lappend GMEd($wh,SgSts) [set i [expr $sp+$npts]] 4139 $bxseg delete $i 4140 $bxseg insert $i "@" 4141 } 4142 } 4143 } 4144 del { 4145 # MB contribution 4146 if { [$bxn size] == 0 } { return } 4147 if { $sel == "" } { set sel 0 } 4148 # MF change: $sel is now a list 4149 foreach sl [lsort -integer -decreasing $sel] { 4150 ChopPolyline $wh $whpt $sl $sl 4151 } 4152 } 4153 clear { 4154 if { [$bxn size] == 0 } { return } 4155 ChopPolyline $wh $whpt 0 end 4156 } 4157 } 4158 return 4159} 4160 4161proc GMButton {wh button} { 4162 # callback to button when editing item of type $wh (in $TYPES or "LAP") 4163 # $button in {cancel, create, change, revert, forget} 4164 global Storage EdWindow WPRoute RTIdNumber RTWPoints \ 4165 GRConts GMEd MESS TXT MapMakingRT DataIndex 4166 4167 set w $EdWindow($wh) 4168 set ids [lindex $Storage($wh) 0] 4169 global $ids 4170 switch $button { 4171 cancel { 4172 destroy $w 4173 if { $MapMakingRT && $wh == "RT" } { 4174 MapCancelRT dontask dontclose 4175 } 4176 } 4177 create { 4178 if { $MapMakingRT && $wh == "RT" } { 4179 MapFinishRTLastWP 4180 } 4181 set data [GM${wh}Check] 4182 if { $data != "nil" } { 4183 if { ! [CheckArrayElement $ids [lindex $data 0]] } { 4184 # new name 4185 set ix [CreateItem $wh $data] 4186 if { $wh == "RT" } { 4187 SetWPRoute [lindex $data 0] [lindex $data 3] 4188 } 4189 if { $GMEd($wh,Displ) } { PutMap $wh $ix } 4190 destroy $w 4191 } else { 4192 GMMessage $MESS(idinuse) 4193 focus $w.fr.fr1.id 4194 return 4195 } 4196 } 4197 } 4198 change { 4199 # $GMEd($wh,Index) assumed > -1 4200 if { $MapMakingRT && $wh == "RT" } { 4201 MapFinishRTLastWP 4202 } 4203 set data [GM${wh}Check] 4204 if { $data != "nil" } { 4205 set ix $GMEd($wh,Index) 4206 set oldname [set [set ids]($ix)] 4207 set newname [lindex $data 0] 4208 set diffname [string compare $oldname $newname] 4209 set mapped [lindex $GMEd($wh,Data) end] 4210 set tomap $GMEd($wh,Displ) 4211 if { $diffname } { 4212 if { [CheckArrayElement $ids $newname] } { 4213 GMMessage $MESS(idinuse) 4214 focus $w.fr.fr1.id 4215 return 4216 } 4217 } 4218 if { $wh == "RT" } { 4219 set oldwps $GMEd(RT,WPoints) 4220 set rtwps [lindex $data 3] 4221 set newwps [Subtract $rtwps $oldwps] 4222 set keptwps [Subtract $rtwps $newwps] 4223 set delwps [Subtract $oldwps $keptwps] 4224 UnsetWPRoute $oldname $delwps 4225 if { $diffname } { 4226 RenameWPRoute $oldname $newname $keptwps 4227 SetWPRoute $newname $newwps 4228 } else { 4229 SetWPRoute $oldname $newwps 4230 } 4231 } 4232 if { $mapped } { 4233 if { $tomap } { 4234 SetItem $wh $ix $data 4235 if { $GMEd($wh,MapChg) } { 4236 MoveOnMap $wh $ix $oldname $diffname $newname 4237 } 4238 } elseif { [UnMap $wh $ix] } { 4239 SetItem $wh $ix $data 4240 } else { 4241 GMMessage [format $MESS(cantunmap) $TXT(name$wh)] 4242 return 4243 } 4244 } else { 4245 SetItem $wh $ix $data 4246 if { $tomap } { PutMap $wh $ix } 4247 } 4248 if { $diffname } { 4249 ListDelete $wh $ix ; ListAdd $wh $ix 4250 if { $wh == "WP" } { 4251 foreach rt $WPRoute($ix) { 4252 set ixrt [IndexNamed RT $rt] 4253 set i [lsearch -exact $RTWPoints($ixrt) $oldname] 4254 set RTWPoints($ixrt) \ 4255 [lreplace $RTWPoints($ixrt) $i $i $newname] 4256 } 4257 } 4258 foreach grix [array names GRConts] { 4259 set i 0 4260 foreach p $GRConts($grix) { 4261 if { [lindex $p 0] == $wh } { 4262 set es [lindex $p 1] 4263 if { [lsearch -exact $es $newname] == -1 \ 4264 && [set j [lsearch -exact $es $oldname]] \ 4265 != -1 } { 4266 set GRConts($grix) [lreplace \ 4267 $GRConts($grix) $i $i \ 4268 [list $wh [lreplace $es $j $j \ 4269 $newname]]] 4270 UpdateItemWindows GR $grix 4271 } 4272 break 4273 } 4274 incr i 4275 } 4276 } 4277 } 4278 if { $wh == "WP" } { 4279 if { $GMEd(WP,MapChg) } { 4280 ChangeWPInRTWindows $oldname $newname 1 4281 } elseif { $diffname } { 4282 ChangeWPInRTWindows $oldname $newname 0 4283 } 4284 } 4285 destroy $w 4286 } 4287 } 4288 revert { 4289 if { [GMConfirm $MESS(askrevert)] } { 4290 Revert$wh 4291 } 4292 } 4293 forget { 4294 # $GMEd($wh,Index) assumed > -1 4295 if { [GMConfirm [format $MESS(askforget) $TXT(name$wh)]] && \ 4296 [Forget $wh $GMEd($wh,Index)] } { destroy $w } 4297 } 4298 } 4299 return 4300} 4301 4302# track utilities 4303 4304proc GMTRChangeDatum {datum args} { 4305 # change datum of TR being edited 4306 # $args is not used but is needed as this is called-back from a menu 4307 global GMEd MESS 4308 4309 if { $GMEd(TR,Datum) == $datum || \ 4310 ( [lindex $GMEd(TR,TPs) 200] != "" && \ 4311 ! [GMConfirm $MESS(timeconsmg)] ) } { return } 4312 SetCursor . watch 4313 set GMEd(TR,TPs) [ChangeTPsDatum $GMEd(TR,TPs) $GMEd(TR,Datum) $datum] 4314 set sel [.gmTR.fr.fr3.frbx.bxn curselection] 4315 foreach n "n d lat long" { 4316 .gmTR.fr.fr3.frbx.bx$n delete 0 end 4317 } 4318 FillTPs .gmTR $GMEd(TR,TPs) $GMEd(TR,SgSts) 4319 foreach sl $sel { 4320 foreach n "n d lat long" { 4321 .gmTR.fr.fr3.frbx.bx$n selection set $sl 4322 } 4323 } 4324 set GMEd(TR,Datum) $datum 4325 ResetCursor . 4326 return 4327} 4328 4329proc FillTPs {w tps sgsts} { 4330 # insert TPs with segments $sgsts, in listboxes in TR edit/show window $w 4331 4332 set i 0 ; set nxt [lindex $sgsts 0] 4333 foreach tp $tps { 4334 if { $nxt == $i } { 4335 set seg "@" 4336 set sgsts [lreplace $sgsts 0 0] 4337 set nxt [lindex $sgsts 0] 4338 } else { set seg "" } 4339 incr i 4340 $w.fr.fr3.frbx.bxn insert end [format "%4d." $i] 4341 $w.fr.fr3.frbx.bxd insert end [lindex $tp 4] 4342 $w.fr.fr3.frbx.bxlat insert end [lindex $tp 2] 4343 $w.fr.fr3.frbx.bxlong insert end [lindex $tp 3] 4344 $w.fr.fr3.frbx.bxalt insert end [UserAltitude [lindex $tp 6]] 4345 $w.fr.fr3.frbx.bxdep insert end [lindex $tp 7] 4346 $w.fr.fr3.frbx.bxseg insert end $seg 4347 } 4348 return 4349} 4350 4351proc MarkPoint {wh w ix} { 4352 # use a position at index $ix in listbox of window $w to create 4353 # a new WP 4354 # $wh in {TR, PVT} 4355 # ==TR: use TP with given index in TR edit/show window 4356 # ==PVT: use point in real-time track log window (Garmin) 4357 global GMEd TRTPoints CREATIONDATE PVTPosns 4358 4359 switch $wh { 4360 TR { 4361 set dat [$w.fr.frd.datum cget -text] 4362 if { $w == ".gmTR" } { 4363 set p [lindex $GMEd(TR,TPs) $ix] 4364 } else { 4365 set ixt [IndexNamed TR [$w.fr.fr1.id get]] 4366 set p [lindex $TRTPoints($ixt) $ix] 4367 } 4368 if { $p == "" } { return } 4369 set alt [lindex $p 6] 4370 } 4371 PVT { 4372 if { [set p [lindex $PVTPosns $ix]] == "" } { return } 4373 set dat "WGS 84" 4374 set alt [$w.fri.frtbx.bxalt get $ix] 4375 } 4376 } 4377 set opts "create revert cancel" 4378 if { $CREATIONDATE } { 4379 GMWPoint -1 $opts [FormData WP "PFrmt Posn Datum Alt Date" \ 4380 [list DMS $p $dat $alt [Now]]] 4381 } else { 4382 GMWPoint -1 $opts [FormData WP "Commt PFrmt Posn Datum Alt" \ 4383 [list [DateCommt [Now]] DMS $p $dat $alt]] 4384 } 4385 return 4386} 4387 4388### varia 4389 4390proc ShowPosnDatum {w pformt posns dproc dvar dvref st ed chgvorp} { 4391 # show position format menu, position and datum under parent window $w 4392 # $pformt is position format 4393 # $posns is a list of position representations 4394 # $dproc is proc to be called when changing datum (if editing is allowed) 4395 # $dvar is name of global variable or array with datum if editing, 4396 # or empty string if not editing 4397 # $dvref is the reference to the datum variable or array(element) to 4398 # be set if editing, or the datum name if not 4399 # $st is state of editable widgets 4400 # $ed is 1 if edition is allowed 4401 # $chgvorp is either "nil" or: 4402 # - if there is a single position, the name of global variable to 4403 # set to 1 if the user types in any entry and that contains the 4404 # current position otherwise; see procs ChangePFormt and 4405 # PosnGetCheckEmpty 4406 # - else, "=PREFIX" describing global variables used in the same 4407 # way for each position; each name has the prefix followed by the 4408 # number from 1 of the position 4409 # frames $w.frp and $w.frd are created that should be packed by the caller 4410 # there will be frames $w.frp.frp1, $w.frp.frp2, ... with the widgets for 4411 # each position 4412 # widgets created here are used elsewhere 4413 global TXT DATUMWIDTH 4414 4415 frame $w.frp -relief flat -borderwidth 0 4416 # path to this menubutton used elsewhere 4417 menubutton $w.frp.pfmt -text $TXT($pformt) -relief raised -width 8 \ 4418 -direction below -menu $w.frp.pfmt.m -state $st 4419 menu $w.frp.pfmt.m -tearoff 0 4420 if { $ed } { 4421 FillPFormtMenu $w.frp.pfmt.m ChangePFormt {} $dvar $dvref $w.frp \ 4422 $chgvorp $st 4423 } 4424 pack $w.frp.pfmt -side left -padx 3 4425 FillPos $w.frp $pformt $posns $st $chgvorp 4426 4427 frame $w.frd -relief flat -borderwidth 0 4428 menubutton $w.frd.dttitle -text Datum -relief raised \ 4429 -direction below -menu $w.frd.dttitle.m -state $st 4430 menu $w.frd.dttitle.m -tearoff 0 4431 if { $ed } { 4432 global $dvar 4433 4434 FillDatumMenu $w.frd.dttitle.m $dproc 4435 label $w.frd.datum -text [set $dvref] -textvariable $dvref \ 4436 -width $DATUMWIDTH 4437 } else { 4438 label $w.frd.datum -text $dvref \ 4439 -width $DATUMWIDTH 4440 } 4441 pack $w.frd.dttitle $w.frd.datum -side left -padx 3 4442 return 4443} 4444 4445## opening and updating edit/show windows 4446 4447proc OpenItem {wh index} { 4448 # edit or display item with given index; $wh in $TYPES or "LAP" 4449 global EdWindow Proc GMEd MESS TXT 4450 4451 if { $index == -1 } { GMMessage $MESS(notlisted) ; return "" } 4452 set w $EdWindow($wh) 4453 if { [winfo exists $w] } { 4454 if { $GMEd($wh,Index) == $index } { 4455 Raise $w ; bell 4456 return "" 4457 } else { set w [$Proc($wh) $index "" [ItemData $wh $index]] } 4458 } elseif { $wh != "LAP" } { 4459 set w [$Proc($wh) $index "change revert create forget cancel" \ 4460 [ItemData $wh $index]] 4461 } else { 4462 # LAPs cannot be created 4463 set w [$Proc($wh) $index "change revert forget cancel" \ 4464 [ItemData $wh $index]] 4465 } 4466 return $w 4467} 4468 4469proc OpenSelItems {wh} { 4470 # select and open items of given type 4471 # $wh in $TYPES 4472 4473 foreach ix [ChooseItems $wh] { OpenItem $wh $ix } 4474 return 4475} 4476 4477proc UpdateItemWindows {wh ix} { 4478 # redraw edit/show windows for item of type $wh and index $ix 4479 global EdWindow Proc GMEd CMDLINE 4480 4481 if { $CMDLINE } { return } 4482 set w $EdWindow($wh) 4483 if { [winfo exists $w] && $GMEd($wh,Index) == $ix } { 4484 destroy $w 4485 if { $wh == "LAP" } { 4486 set opts "change revert forget cancel" 4487 } else { set opts "change revert create forget cancel" } 4488 $Proc($wh) $ix $opts [ItemData $wh $ix] 4489 } 4490 if { [winfo exists .gm${wh}sh$ix] } { 4491 $Proc($wh) $ix "" [ItemData $wh $ix] 4492 } 4493 return 4494} 4495 4496proc UpdateWPsInWindows {wh ixs oldnames newnames} { 4497 # update edit/show windows for items of type $wh in {RT, GR} after 4498 # a renaming of WPs and corresponding changes in the data-base 4499 # $ixs is list of indices of the items in show windows 4500 # a WP name in a RT may occur several times 4501 # update edit window if the item there was changed or is not yet defined 4502 global EdWindow GMEd RTWPoints GRConts 4503 4504 if { [winfo exists [set w $EdWindow($wh)]] } { 4505 if { [set ix $GMEd($wh,Index)] == -1 || \ 4506 [lsearch -exact $ixs $ix] != -1 } { 4507 if { $wh == "RT" } { 4508 # this depends on Storage(RT) 4509 set dwps [lindex $GMEd(RT,Data) 3] 4510 set frbx .gmRT.fr.fr3.fr31.frbx 4511 set wwps [$frbx.box get 0 end] 4512 } else { 4513 # this depends on Storage(GR) 4514 set cs [lindex $GMEd(GR,Data) 2] 4515 foreach {ics dwps} [GRWPNames $cs] {} 4516 set wwps [GMGRCollectWPNames $w] 4517 } 4518 if { $dwps != {} } { 4519 foreach {chg dwps} \ 4520 [ListReplace $dwps $oldnames $newnames] {} 4521 if { $chg } { 4522 if { $wh == "RT" } { 4523 set GMEd(RT,Data) [lreplace $GMEd(RT,Data) 3 3 $dwps] 4524 } else { 4525 set dwps [lsort -dictionary $dwps] 4526 set cs [lreplace $cs $ics $ics [list WP $dwps]] 4527 set GMEd(GR,Data) [lreplace $GMEd(GR,Data) 2 2 $cs] 4528 } 4529 } 4530 } 4531 if { $wwps != {} } { 4532 foreach {chg wwps} \ 4533 [ListReplace $wwps $oldnames $newnames] {} 4534 if { $chg } { ReplaceWPsInWindow $wh $w $wwps } 4535 } 4536 } 4537 } 4538 # update show windows 4539 foreach ix $ixs { 4540 set w .gm${wh}sh$ix 4541 if { [winfo exists $w] } { 4542 if { $wh == "RT" } { 4543 set newwps $RTWPoints($ix) 4544 } else { 4545 set newwps [lindex [GRWPNames $GRConts($ix)] 1] 4546 } 4547 ReplaceWPsInWindow $wh $w $newwps 4548 } 4549 } 4550 return 4551} 4552 4553proc ReplaceWPsInWindow {wh w names} { 4554 # replace all WPs in edit/show window of item of type $wh in {RT, GR} 4555 # by the given ones 4556 # do nothing if $names is empty 4557 global TXT 4558 4559 if { $names == {} || ! [winfo exists $w] } { return } 4560 if { $wh == "RT" } { 4561 set frbx $w.fr.fr3.fr31.frbx 4562 $frbx.box delete 0 end 4563 foreach name $names { 4564 $frbx.box insert end $name 4565 } 4566 foreach b "xn xd xb xda xsc xsl" { 4567 $frbx.b$b selection clear 0 end 4568 } 4569 return 4570 } 4571 # GR 4572 set wptxt $TXT(WP) 4573 set frbx $w.fr.fr3.frbx 4574 foreach b {bxn bxw box} { $frbx.$b selection clear 0 end } 4575 # clear old WPs 4576 set is [lsort -integer -decreasing \ 4577 [lsearch -exact -all [$frbx.bxw get 0 end] $wptxt]] 4578 foreach i $is { 4579 $frbx.bxn delete end end 4580 $frbx.bxw delete $i $i 4581 $frbx.box delete $i $i 4582 } 4583 # insert new 4584 set n [$frbx.box size] 4585 foreach name [lsort -dictionary -decreasing $names] { 4586 $frbx.bxn insert end [format "%3d." [incr n]] 4587 $frbx.bxw insert 0 $wptxt 4588 $frbx.box insert 0 $name 4589 } 4590 return 4591} 4592 4593proc CloseItemWindows {wh ix} { 4594 # close edit/show windows for item of type $wh and index $ix that has 4595 # been forgotten 4596 global EdWindow Proc GMEd 4597 4598 set w $EdWindow($wh) 4599 if { [winfo exists $w] && $GMEd($wh,Index) == $ix } { 4600 destroy $w 4601 } 4602 if { [winfo exists .gm${wh}sh$ix] } { 4603 destroy .gm${wh}sh$ix 4604 } 4605 return 4606} 4607 4608proc SetDisplShowWindow {wh ix sel} { 4609 # set display check-button in show window according to $sel 4610 # for item of type $wh and index $ix 4611 # $sel in {select, deselect} 4612 4613 if { [winfo exists .gm${wh}sh$ix] } { 4614 set w .gm${wh}sh$ix 4615 $w.fr.frdw.displayed configure -state normal 4616 $w.fr.frdw.displayed $sel 4617 $w.fr.frdw.displayed configure -state disabled 4618 } 4619 return 4620} 4621 4622### displaying hidden information 4623 4624proc ShowHiddenData {wh hidden} { 4625 # display hidden information for an item of type $wh (in {WP, TR}) 4626 # assume there is a proc HiddenData with arguments $wh and $hidden 4627 # that returns list of pairs with name of field and its value (in 4628 # a suitable form for displaying) 4629 global TXT DPOSX DPOSY COLOUR 4630 4631 if { [set fvs [HiddenData $wh $hidden]] == "" } { bell ; return } 4632 set w .shidden 4633 if { [winfo exists $w] } { destroy $w } 4634 4635 GMToplevel $w hiddendata +$DPOSX+$DPOSY . \ 4636 [list WM_DELETE_WINDOW "destroy $w"] \ 4637 [list <Key-Return> "destroy $w"] 4638 4639 frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg) 4640 label $w.fr.tit -text $TXT(hiddendata) 4641 4642 frame $w.fr.fri -relief flat -borderwidth 0 4643 set r 0 4644 foreach p $fvs { 4645 foreach x $p c "0 1" { 4646 label $w.fr.fri.x${r}_$c -text $x -anchor w \ 4647 -width [expr 2+[string length $x]] 4648 grid $w.fr.fri.x${r}_$c -row $r -column $c -sticky w 4649 } 4650 incr r 4651 } 4652 button $w.fr.ok -text $TXT(ok) -command "destroy $w" 4653 4654 foreach x "tit fri ok" { grid $w.fr.$x -pady 5 } 4655 grid $w.fr 4656 update idletasks 4657 return 4658} 4659 4660### creating WP at given distante and bearing from another one 4661 4662proc CreateWPAtDistBear {ix} { 4663 # create WP at given distante (in user-selected unit) and bearing from 4664 # WP with index $ix 4665 # fail if the WP edit window exists for a different WP 4666 global EdWindow GMEd WPatdist WPatbear WPPosn WPDatum WPPFrmt TXT MESS \ 4667 INVTXT CREATIONDATE DTUNIT DSCALE 4668 4669 if { [winfo exists $EdWindow(WP)] } { 4670 if { $GMEd(WP,Index) != $ix } { bell ; return } 4671 # valid coordinates? 4672 set p [PosnGetCheck .gmWP.fr.frp.frp1 $GMEd(WP,Datum) GMMessage \ 4673 ChangedPosn] 4674 if { $p == "nil" } { return } 4675 set pformt $INVTXT([.gmWP.fr.frp.pfmt cget -text]) 4676 set datum $GMEd(WP,Datum) 4677 set ed 1 4678 } else { 4679 set p $WPPosn($ix) ; set datum $WPDatum($ix) 4680 set pformt $WPPFrmt($ix) 4681 set ed 0 4682 } 4683 # get distance and bearing 4684 while 1 { 4685 if { ! [GMChooseParams $TXT(newWPatdb) "WPatdist WPatbear" \ 4686 [list "=$TXT(distance) ($DTUNIT)" "=$TXT(azimuth)"]] } { 4687 return 4688 } 4689 if { [CheckFloat GMMessage $WPatdist] && \ 4690 [CheckNumber GMMessage $WPatbear] } { 4691 if { $WPatbear >= 360 } { 4692 GMMessage $MESS(badangle) 4693 continue 4694 } 4695 break 4696 } 4697 } 4698 foreach "lat long" [CoordsAtDistBear $p [expr $WPatdist/$DSCALE] \ 4699 $WPatbear $datum] {} 4700 foreach "p pformt datum" \ 4701 [FormatPosition $lat $long $datum $pformt ""] { break } 4702 if { $ed } { destroy $EdWindow(WP) } 4703 set opts "create revert cancel" 4704 if { $CREATIONDATE } { 4705 GMWPoint -1 $opts [FormData WP "PFrmt Posn Datum Date" \ 4706 [list $pformt $p $datum [Now]]] 4707 } else { 4708 GMWPoint -1 $opts [FormData WP "Commt PFrmt Posn Datum" \ 4709 [list [DateCommt [Now]] $pformt $p $datum]] 4710 } 4711 return 4712} 4713 4714### utilities for dealing with map backgrounds in item edit/show windows 4715 4716proc CreateMBackWidgets {wh fr mbak ed} { 4717 # create widgets for showing/editing map background associated to item 4718 # $wh in {WP, RT, TR, LN} 4719 # $fr frame to be populated 4720 # $mbak current map background name 4721 # $ed flag set if editing is enabled 4722 global TXT COMMENTWIDTH 4723 4724 label $fr.tit -text "$TXT(mbaktoload):" -width 25 4725 if { $ed } { 4726 menubutton $fr.mb -textvariable GMEd($wh,MBack) -menu $fr.mb.m \ 4727 -width $COMMENTWIDTH -relief raised 4728 menu $fr.mb.m -postcommand [list FillDefsMenu backgrnd $fr.mb.m \ 4729 [list ChangeMBack $wh] "($TXT(none))" "---"] 4730 } else { 4731 menubutton $fr.mb -text $mbak -state disabled -width $COMMENTWIDTH \ 4732 -relief raised 4733 } 4734 pack $fr.tit $fr.mb -side left 4735 return 4736} 4737 4738proc ChangeMBack {wh mbak args} { 4739 # called after a new map background was selected for item 4740 # $args not used (but needed because of callback) 4741 global TXT GMEd 4742 4743 if { $mbak == "($TXT(none))" } { set mbak "" } 4744 set GMEd($wh,MBack) $mbak 4745 return 4746} 4747 4748### managing auxiliary windows that are made inconsistent by edit operations 4749 4750proc ManageAuxWindows {wh op args} { 4751 # keep track of and operate on auxiliary windows 4752 # $wh in {RT, TR} 4753 # $op is one of 4754 # add: $args is a list with a list of windows to be managed 4755 # close_all: destroy all managed windows 4756 # the global GMEd($wh,windows) is used and should be initialised to {} 4757 # before any call to this procedure 4758 # proc CloseWindows (util.tcl) is called to destroy managed windows 4759 global GMEd 4760 4761 switch $op { 4762 add { 4763 foreach w [lindex $args 0] { lappend GMEd($wh,windows) $w } 4764 } 4765 close_all { 4766 CloseWindows $GMEd($wh,windows) 4767 set GMEd($wh,windows) {} 4768 } 4769 } 4770 return 4771}