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: know.tcl 22# Last change: 6 October 2013 23# 24# Includes contributions by Brian Baulch (baulchb_AT_onthenet.com.au) 25# marked "BSB contribution" 26# 27 28proc NewItem {wh} { 29 # open window for defining a new item 30 # $wh in $TYPES 31 global CREATIONDATE Proc DataDefault 32 33 set opts {create revert cancel} 34 switch $wh { 35 WP { 36 if { $CREATIONDATE } { 37 GMWPoint -1 $opts [FormData WP Date [list [Now]]] 38 } else { 39 GMWPoint -1 $opts [FormData WP Commt [list [DateCommt [Now]]]] 40 } 41 } 42 default { 43 $Proc($wh) -1 $opts $DataDefault($wh) 44 } 45 } 46 return 47} 48 49proc CreateItem {wh data} { 50 # create a new item of given type and with given data 51 # return index of new item 52 global Index Number WPRoute 53 54 set ix $Index($wh) 55 incr Index($wh) ; incr Number($wh) ; incr Number(Data) 56 SetItem $wh $ix $data ; ListAdd $wh $ix 57 if { $Number(Data) == 1 } { ChangeOnState datastate normal } 58 if { $wh == "WP" } { set WPRoute($ix) "" } 59 return $ix 60} 61 62proc CreateGRFor {iname obs lp} { 63 # create a GR 64 # $iname is index of TXT to use as prefix for GR name, or is a literal 65 # prefix if given as =PREFIX, or has the form @NAME for a 66 # literal name (if in use, the existing GR will be replaced) 67 # $obs is GR remark 68 # $lp is GR contents 69 # return index of new GR 70 global TXT GRDispl 71 72 if { [regsub {^@} $iname "" grname] } { 73 set ix [IndexNamed GR $grname] 74 set data [FormData GR "Name Obs Conts" [list $grname $obs $lp]] 75 if { $ix != -1 } { 76 if { $GRDispl($ix) } { UnMapGR $ix } 77 SetItem GR $ix $data 78 UpdateItemWindows GR $ix 79 } else { set ix [CreateItem GR $data] } 80 return $ix 81 } 82 if { ! [regsub {^=} $iname "" pre] } { set pre $TXT($iname) } 83 set n 0 84 while 1 { 85 set grname [format "$pre %d" $n] 86 if { [IndexNamed GR $grname] == -1 } { 87 set data [FormData GR "Name Obs Conts" [list $grname $obs $lp]] 88 return [CreateItem GR $data] 89 break 90 } 91 incr n 92 } 93 # not used 94 return 95} 96 97proc ItemData {wh index} { 98 # find data for item with given index 99 # $wh in $TYPES or LAP 100 # return list of values in the order given by $Storage($wh) 101 # see GMStart (setup.tcl) for the description of data arrays 102 global Storage 103 104 set l "" 105 foreach s $Storage($wh) { 106 global $s 107 108 set l [lappend l [set [set s]($index)]] 109 } 110 return $l 111} 112 113proc FormData {wh names vals} { 114 # create a data list for an item of type $wh (in $TYPES, or LAP, TP, LP) 115 # $names is a list of data array names without the prefix $wh 116 # $vals is a list of values aligned with $names 117 # return list of values in the order given by $DataIndex($wh) 118 # (if $wh in $TYPES or LAP that is the order of $Storage($wh)) using 119 # default values for those not given in $vals 120 # see GMStart (setup.tcl) for the description of data arrays 121 global DataDefault DataIndex 122 123 set l $DataDefault($wh) 124 foreach n $names v $vals { 125 set i $DataIndex(${wh}$n) 126 set l [lreplace $l $i $i $v] 127 } 128 return $l 129} 130 131proc SetItem {wh index data} { 132 # set data for item with given index 133 # $wh in $TYPES or LAP 134 # see GMStart (setup.tcl) for description of data arrays 135 global Storage IndexOf 136 137 set ids [lindex $Storage($wh) 0] 138 global $ids 139 140 set name [lindex $data 0] 141 if { ! [catch {set oldname [set [set ids]($index)]}] && \ 142 $oldname != $name } { 143 unset IndexOf($wh,$oldname) 144 } 145 set IndexOf($wh,$name) $index 146 foreach val $data field $Storage($wh) { 147 global $field 148 149 set [set field]($index) $val 150 } 151 return 152} 153 154proc UnsetItem {wh index} { 155 # destroy data for item with given index 156 # $wh in $TYPES or LAP 157 # see GMStart (setup.tcl) for description of data arrays 158 global Storage IndexOf 159 160 set ids [lindex $Storage($wh) 0] 161 global $ids 162 163 unset IndexOf($wh,[set [set ids]($index)]) 164 foreach field $Storage($wh) { 165 global $field 166 167 unset [set field]($index) 168 } 169 return 170} 171 172proc UnsetSeveral {wh ixs} { 173 # destroy data for items with given indices 174 # $wh in $TYPES or LAP 175 # see GMStart (setup.tcl) for description of data arrays 176 global Storage IndexOf 177 178 set ids [lindex $Storage($wh) 0] 179 global $ids 180 181 foreach ix $ixs { 182 unset IndexOf($wh,[set [set ids]($ix)]) 183 } 184 foreach field $Storage($wh) { 185 global $field 186 187 foreach ix $ixs { 188 unset [set field]($ix) 189 } 190 } 191 return 192} 193 194proc UnsetAll {wh} { 195 # destroy data for all items with given type 196 # $wh in $TYPES or LAP 197 # see GMStart (setup.tcl) for description of data arrays 198 global Storage IndexOf 199 200 array unset IndexOf $wh,* 201 foreach arr $Storage($wh) { 202 global $arr 203 204 unset $arr 205 } 206 return 207} 208 209proc Forget {wh ix} { 210 # forget an item with given index; $wh in $TYPES or LAP 211 global ${wh}Displ RTIdNumber RTWPoints Number MESS TXT 212 # BSB contribution 213 global MYGPS WPName WPNum UnusedICInx UnusedWPInx 214 215 if { [set ${wh}Displ($ix)] && $wh != "LAP" && ! [UnMap $wh $ix] && \ 216 $wh != "GR" } { 217 GMMessage [format $MESS(cantfgt) $TXT(name$wh)] 218 return 0 219 } 220 switch $wh { 221 WP { 222 # BSB contribution 223 if { $MYGPS == "Lowrance" } { 224 if { [string match "ICON*" $WPName($ix)] } { 225 lappend UnusedICInx $WPNum($ix) 226 } else { 227 lappend UnusedWPInx $WPNum($ix) 228 } 229 } 230 } 231 RT { 232 UnsetWPRoute $RTIdNumber($ix) $RTWPoints($ix) 233 } 234 } 235 ListDelete $wh $ix ; UnsetItem $wh $ix 236 incr Number($wh) -1 ; incr Number(Data) -1 237 if { $Number(Data) == 0 } { ChangeOnState datastate disabled } 238 return 1 239} 240 241proc ForgetSeveral {wh ixs} { 242 # forget several items with given indices; $wh in $TYPES or LAP 243 # $ixs has the same order of $ListInds($wh) although with some 244 # elements missing 245 # proc based on proc Forget 246 global ${wh}Displ RTIdNumber RTWPoints Number MESS TXT \ 247 MYGPS WPName WPNum UnusedICInx UnusedWPInx 248 249 if { $wh == "GR" || $wh == "LAP" } { 250 set fs $ixs ; set cf [expr -[llength $ixs]] 251 } else { 252 set fs "" ; set cf 0; set nf 0 253 foreach ix $ixs { 254 if { [set ${wh}Displ($ix)] && ! [UnMap $wh $ix] } { 255 set nf 1 256 continue 257 } 258 switch $wh { 259 WP { 260 if { $MYGPS == "Lowrance" } { 261 if { [string match "ICON*" $WPName($ix)] } { 262 lappend UnusedICInx $WPNum($ix) 263 } else { 264 lappend UnusedWPInx $WPNum($ix) 265 } 266 } 267 } 268 RT { 269 UnsetWPRoute $RTIdNumber($ix) $RTWPoints($ix) 270 } 271 } 272 lappend fs $ix 273 incr cf -1 274 } 275 if { $nf } { GMMessage [format $MESS(cantfgt) $TXT(name$wh)] } 276 } 277 incr Number($wh) $cf ; incr Number(Data) $cf 278 if { $Number($wh) == 0 } { 279 if { $Number(Data) == 0 } { ChangeOnState datastate disabled } 280 ChangeOnStateList $wh disabled 281 UnsetAll $wh ; ListDeleteAll $wh 282 } else { 283 UnsetSeveral $wh $fs ; ListDeleteSeveral $wh $fs 284 } 285 return 286} 287 288proc AllIndicesForType {wh types} { 289 # return list of pairs with type and list of indices for all items 290 # of either all $types if $wh==Data, or for type $wh 291 # in the former case, the order of the list is that imposed by $types 292 # and this may be important when writing to files in a format that 293 # imposes a specific order in the data 294 global Storage Number 295 296 if { $wh != "Data" } { 297 set ids [lindex $Storage($wh) 0] 298 global $ids 299 set ixs [array names $ids] 300 return [list [list $wh $ixs]] 301 } 302 set lp "" 303 foreach wh $types { 304 if { $Number($wh) > 0 } { 305 set ids [lindex $Storage($wh) 0] 306 global $ids 307 set ixs [array names $ids] 308 lappend lp [list $wh $ixs] 309 } 310 } 311 return $lp 312} 313 314proc IndexNamed {wh name} { 315 # find index for item with given name; $wh in $TYPES or LAP 316 global IndexOf 317 318 if { [catch {set ix $IndexOf($wh,$name)}] } { 319 return -1 320 } 321 return $ix 322} 323 324proc NameOf {wh ix} { 325 # return name of item with given index; $wh in $TYPES or LAP 326 global Storage 327 328 set ids [lindex $Storage($wh) 0] 329 global $ids 330 return [set [set ids]($ix)] 331} 332 333proc NewName {wh args} { 334 # return an unused valid name for an item of type $wh in $TYPES 335 # $args may be the previous name if $wh==WP 336 # that may be used as prefix of new name if formed of acceptable chars 337 # in other cases use numbers from 0 with prefix "${wh}-" unless $wh==RT 338 global NAMELENGTH MAXROUTES ACCEPTALLCHARS RECNAMECHARS 339 340 set pre ${wh}- ; set k 0 341 switch $wh { 342 WP { 343 set oldname [lindex $args 0] 344 if { $oldname != "" && \ 345 ($ACCEPTALLCHARS || [CheckName Ignore $oldname]) } { 346 set pre [string range $oldname 0 [expr $NAMELENGTH-3]] 347 } 348 if { [set d [expr $NAMELENGTH-[string length $pre]]] > 9 } { 349 set d 9 350 } 351 set max [expr int(pow(10,$d))-1] 352 while 1 { 353 # will loop forever if more than 100000 are generated... 354 set n "${pre}[format %0${d}d $k]" 355 if { [IndexNamed WP $n] == -1 } { return $n } 356 if { $k == $max } { 357 incr d ; set k 0 358 if { [set pre [string range $pre 0 end-1]] == "" } { 359 return [NewName WP ZY-] 360 } 361 } else { incr k } 362 } 363 } 364 RT { 365 while 1 { 366 if { [IndexNamed RT [incr k]] == -1 } { return $k } 367 } 368 } 369 default { 370 while 1 { 371 set name ${pre}[format %06d [incr k]] 372 if { [IndexNamed $wh $name] == -1 } { return $name } 373 } 374 } 375 } 376 # not used 377 return 378} 379 380proc SetWPRoute {rt wps} { 381 # insert (in order) RT name $rt in list of RTs of each known WP 382 # whose name belongs to $wps 383 global WPRoute 384 385 foreach wp $wps { 386 if { [set ix [IndexNamed WP $wp]] != -1 } { 387 if { [lsearch -exact $WPRoute($ix) $rt] == -1 } { 388 lappend WPRoute($ix) $rt 389 set WPRoute($ix) [lsort $WPRoute($ix)] 390 } 391 } 392 } 393 return 394} 395 396proc UnsetWPRoute {rt wps} { 397 # delete RT name $rt in list of RTs of each given WP 398 # that is defined 399 global WPRoute 400 401 foreach wp $wps { 402 set ix [IndexNamed WP $wp] 403 if { $ix != -1 } { 404 set wi [lsearch -exact $WPRoute($ix) $rt] 405 if { $wi != -1 } { 406 set WPRoute($ix) [lreplace $WPRoute($ix) $wi $wi] 407 } 408 } 409 } 410 return 411} 412 413proc RenameWPRoute {oldname newname wps} { 414 # change RT name in list of RTs of each given WP 415 # that is defined or add new name if old not found 416 global WPRoute 417 418 foreach wp $wps { 419 set ix [IndexNamed WP $wp] 420 if { $ix != -1 } { 421 set wi [lsearch -exact $WPRoute($ix) $oldname] 422 if { $wi != -1 } { 423 set WPRoute($ix) [lreplace $WPRoute($ix) $wi $wi \ 424 $newname] 425 } else { lappend $WPRoute($ix) $newname } 426 set WPRoute($ix) [lsort $WPRoute($ix)] 427 } 428 } 429 return 430} 431 432proc DateCommt {date} { 433 # create comment from date 434 global COMMENTLENGTH NOLOWERCASE 435 436 regsub -all {:|\.} $date "" date 437 if { [string length $date] > $COMMENTLENGTH } { 438 set date [string range "$date" 0 [expr $COMMENTLENGTH-1]] 439 } 440 if { $NOLOWERCASE } { 441 return [string toupper "$date"] 442 } 443 return $date 444} 445 446## operations on groups 447 448proc GRsElements {ixs rec wh} { 449 # find elements of type $wh (in $TYPES or LAP) in groups with 450 # given indices; if $wh==GR the initial GRs are included in the result; 451 # undefined elements are not included 452 # $rec is 1 if search is recursive 453 # return list of indices 454 global GMember 455 456 catch { unset GMember } 457 if { $wh == "GR" } { 458 foreach ix $ixs { set GMember($ix) 1 } 459 } 460 GRsElsCollect $ixs $rec $wh 461 set l [array names GMember] 462 catch { unset GMember } 463 return $l 464} 465 466proc GRsElsCollect {ixs rec wh} { 467 # mark defined elements of type $wh (in $TYPES or LAP) in groups with 468 # given indices 469 # $rec is 1 if search is recursive 470 # marked elements with index $i will have GMember($i) set 471 global GRConts GMember 472 473 foreach ix $ixs { 474 foreach p $GRConts($ix) { 475 if { [lindex $p 0] == $wh } { 476 foreach e [lindex $p 1] { 477 if { [set eix [IndexNamed $wh $e]] != -1 } { 478 set GMember($eix) 1 479 } 480 } 481 if { ! $rec } { break } 482 } 483 if { $rec && [lindex $p 0] == "GR" } { 484 set rixs [Apply [lindex $p 1] IndexNamed GR] 485 while { [set i [lsearch -exact $rixs -1]] != -1 } { 486 set rixs [lreplace $rixs $i $i] 487 } 488 GRsElsCollect $rixs 1 $wh 489 } 490 } 491 } 492 return 493} 494 495proc GRWPNames {conts} { 496 # find names of WPs in given GR contents 497 # return pair with index of WP-pair entry in $conts, followed by list 498 # of names, on failure the index is meaningless and the list is empty 499 500 set names {} ; set ics 0 501 foreach p $conts { 502 if { [lindex $p 0] == "WP" } { 503 set names [lindex $p 1] 504 break 505 } 506 incr ics 507 } 508 return [list $ics $names] 509} 510 511## renaming items 512 513proc InitWPRenaming {} { 514 # this proc must be called before any input operation! 515 # initialize variables before an input operation (get, load, import) 516 # for use with procs AskForName and ReplaceWPName 517 # returns 0 if another renaming operation is under way 518 global ReplNames MESS 519 520 if { $ReplNames(busy) } { 521 GMMessage $MESS(busytrylater) 522 return 0 523 } 524 array set ReplNames {busy 1 old {} new {} wps {} grs {} how ask} 525 return 1 526} 527 528proc EndWPRenaming {} { 529 # this proc must be called after any input operation that stored data! 530 # build a group with renamed WPs as well as GRs in which they occur 531 # after an input operation (get, load, import) 532 global ReplNames 533 534 if { $ReplNames(old) != {} || $ReplNames(wps) != {} } { 535 set nwps $ReplNames(new) 536 foreach m $ReplNames(wps) { lappend nwps [lindex $m 1] } 537 set lp [list [list WP [lsort -dictionary $nwps]]] 538 if { $ReplNames(grs) != {} } { 539 set ns {} 540 foreach n $ReplNames(grs) { 541 if { [lsearch -exact $ns $n] == -1 && \ 542 [IndexNamed GR $n] != -1 } { 543 lappend ns $n 544 } 545 } 546 lappend lp [list GR [lsort -dictionary $ns]] 547 } 548 CreateGRFor renres "" $lp 549 } 550 set ReplNames(busy) 0 551 return 552} 553 554proc GetReplNameInGR {name id} { 555 # get replacement for a WP name appearing in a GR 556 # $id is the GR name 557 # return $name if there is no replacement, otherwise the one that 558 # was done last 559 global ReplNames 560 561 set chg 0 562 if { [set ix [lsearch -exact $ReplNames(old) $name]] != -1 } { 563 set name [lindex $ReplNames(new) $ix] ; incr chg 564 } 565 foreach t $ReplNames(wps) { 566 if { [lindex $t 0] == $name } { 567 set name [lindex $t 1] ; incr chg 568 break 569 } 570 } 571 if { $chg && [lindex $ReplNames(grs) 0] != $id } { 572 set ReplNames(grs) [linsert $ReplNames(grs) 0 $id] 573 } 574 return $name 575} 576 577proc AskForName {name} { 578 # obtain a replacement for a WP $name which is not valid by one of 579 # - checking if it was already replaced 580 # - letting the user write the new name 581 # - applying a renaming method selected by the user 582 # - generating an automatic replacement 583 # proc InitWPRenaming must be called before the first call to this proc 584 # and proc EndWPRenaming must be called after the renaming operation 585 # is finished 586 # create modal dialog for displaying message 587 # buttons: OK, Cancel 588 # binding: return to accept 589 # return empty string on cancel 590 global MYGPS RECNAMECHARS NAMELENGTH GMResAsk COLOUR EPOSX EPOSY MESS TXT \ 591 ReplNames CMDLINE 592 593 if { [set ix [lsearch -exact $ReplNames(old) $name]] != -1 } { 594 return [lindex $ReplNames(new) $ix] 595 } 596 if { $ReplNames(how) == "methall" } { 597 set nn [RenameMethApplyTo $name $ReplNames(method) Ignore] 598 lappend ReplNames(old) $name 599 lappend ReplNames(new) $nn 600 return $nn 601 } 602 if { $ReplNames(how) == "genall" || $CMDLINE } { 603 set nn [NewName WP $name] 604 lappend ReplNames(old) $name 605 lappend ReplNames(new) $nn 606 return $nn 607 } 608 GMToplevel .askname change +$EPOSX+$EPOSY . \ 609 {WM_DELETE_WINDOW {set GMResAsk cnc}} \ 610 [list <Key-Return> {set GMResAsk ok}] 611 612 frame .askname.fr -relief flat -borderwidth 5 -bg $COLOUR(confbg) 613 label .askname.fr.title -text "!!!" -relief sunken 614 message .askname.fr.text -aspect 1000 \ 615 -text [format $MESS(replname) $name $NAMELENGTH \ 616 $RECNAMECHARS($MYGPS,mess)] 617 entry .askname.fr.name -width $NAMELENGTH 618 TextBindings .askname.fr.name 619 620 set fbs .askname.fr.bs 621 frame $fbs -relief flat -borderwidth 0 622 button $fbs.ok -text $TXT(ok) -command { set GMResAsk ok } 623 foreach x {gen meth} t {generate renamethod} { 624 menubutton $fbs.$x -text $TXT($t) -relief raised -menu $fbs.$x.m 625 menu $fbs.$x.m 626 } 627 $fbs.gen.m add command -label $TXT(forthisWP) \ 628 -command { set ReplNames(how) ask ; set GMResAsk gen } 629 $fbs.gen.m add command -label $TXT(forall) \ 630 -command { set ReplNames(how) genall ; set GMResAsk gen } 631 # 2 menus are needed as not all platforms support cascade commands 632 foreach x {ask methall} t {forthisWP forall} { 633 set mx $fbs.meth.m.$x 634 $fbs.meth.m add cascade -label $TXT($t) -menu $mx 635 menu $mx 636 menu $mx.m -postcommand \ 637 [list FillDefsMenu renamethod $mx.m [list AskForNameMethod $x]] 638 $mx add cascade -label $TXT(use) -menu $mx.m 639 $mx add command -label $TXT(define) \ 640 -command [list AskForNameMethod define-$x {}] 641 } 642 button $fbs.cancel -text $TXT(cancel) \ 643 -command { set GMResAsk cnc } 644 pack $fbs.ok $fbs.gen $fbs.meth $fbs.cancel -side left -pady 5 645 pack .askname.fr.title .askname.fr.text .askname.fr.name $fbs \ 646 -side top -pady 5 647 pack .askname.fr -side top 648 update idletasks 649 set gs [grab current] 650 grab .askname 651 RaiseWindow .askname 652 while 1 { 653 tkwait variable GMResAsk 654 switch $GMResAsk { 655 "" { } 656 ok { 657 set res [string trim [.askname.fr.name get]] 658 if { [CheckName Ignore $res] } { 659 if { [lsearch -exact $ReplNames(new) $res] != -1 || \ 660 [IndexNamed WP $res] != -1 } { 661 GMMessage $MESS(idinuse) ; continue 662 } 663 break 664 } 665 bell 666 } 667 gen { 668 set res [NewName WP $name] 669 break 670 } 671 meth { 672 if { $ReplNames(method) == "" } { 673 set ReplNames(how) ask 674 continue 675 } 676 set res [RenameMethApplyTo $name $ReplNames(method) Ignore] 677 break 678 } 679 cnc { 680 set res "" ; break 681 } 682 } 683 } 684 if { $res != "" } { 685 lappend ReplNames(old) $name 686 lappend ReplNames(new) $res 687 } 688 DestroyRGrabs .askname $gs 689 update idletasks 690 return $res 691} 692 693proc AskForNameMethod {how method args} { 694 # a WP renaming method is to be applied 695 # $how in {ask, methall, define-ask, define-methall} indicates 696 # whether the choice is for this or all WPs and if the method is to 697 # be defined 698 # $method is the name of renaming method to use or empty meaning, 699 # unless the method is to be defined, that operation is to be cancelled 700 # $args not in use but is needed because of proc FillMenu 701 # this proc only changes the global variables that force 702 # proc AskForName to do the intended actions 703 global ReplNames GMResAsk 704 705 if { [regsub {^define-} $how "" how] } { 706 set method [Define renamethod] 707 } 708 set ReplNames(how) $how ; set ReplNames(method) $method 709 # must be the last one 710 set GMResAsk meth 711 return 712} 713 714proc SamePosnDat {posndat1 posndat2} { 715 # check whether two positions are the same 716 # $posndat_ is a list with lat, long (in DDD) and datum 717 718 foreach "lat1 long1 dat1" $posndat1 { break } 719 foreach "lat2 long2 dat2" $posndat2 { break } 720 if { $posndat1 != $posndat2 } { 721 foreach "lat2 long2" [ToDatum $lat2 $long2 $dat2 $dat1] { break } 722 } 723 return [expr $lat1 == $lat2 && $long1 == $long2] 724} 725 726proc ReplaceWPName {name posndat} { 727 # return a replacement name for a WP being read in 728 # $name is the name to be replaced 729 # $posndat is list with lat, long and datum defining the WP 730 # position (possibly not in the WP datum) 731 # use record of previous replacements 732 # $ReplNames(wps), a list of triples with old name, new name and 733 # position+datum (as $posndat) 734 # this list must be initialized when starting a reading operation (get, 735 # load, import) (see proc InitWPRenaming), and is kept as a stack 736 # with the last replacement done as its head 737 global ReplNames 738 739 foreach t $ReplNames(wps) { 740 if { [lindex $t 0] == $name && [SamePosnDat $posndat [lindex $t 2]] } { 741 return [lindex $t 1] 742 } 743 } 744 set n [NewName WP $name] 745 set ReplNames(wps) [linsert $ReplNames(wps) 0 [list $name $n $posndat]] 746 return $n 747} 748 749proc SamePosn {ix data} { 750 # check whether the WP with given index has the same position as the 751 # WP with given data even if the datums used are different 752 # return either 1, or list with lat, long (in DDD), and datum 753 # for the position of 2nd WP (but in the datum of 1st) 754 global WPPosn WPDatum DataIndex 755 756 set ip $DataIndex(WPPosn) 757 set id $DataIndex(WPDatum) 758 set p [lindex $data $ip] ; set d [lindex $data $id] 759 if { $WPDatum($ix) != $d } { 760 set p [ToDatum [lindex $p 0] [lindex $p 1] $d $WPDatum($ix)] 761 } 762 if { [ComputeDist $p $WPPosn($ix) $WPDatum($ix)] < 0.003 } { return 1 } 763 return [list [lindex $p 0] [lindex $p 1] $WPDatum($ix)] 764} 765 766proc AddToNB {nb txt} { 767 # add $txt to remark $nb 768 769 if { $nb != "" } { 770 return "$nb\n$txt" 771 } 772 return $txt 773} 774 775proc AddOldNameToObs {wh data name} { 776 # add old name to remark field of item of type $wh 777 global TXT DataIndex 778 779 set in $DataIndex(${wh}Obs) 780 set nb [lindex $data $in] 781 return [lreplace $data $in $in [AddToNB $nb "$TXT(oname): $name"]] 782} 783 784proc WPChangeNames {methname args} { 785 # change names of items of type $wh (not LAP) 786 # $methname is the name of renaming method to use or empty for cancel 787 # $args not in use but is needed because of proc FillMenu 788 # select the items then rename them 789 global MESS TXT NAMELENGTH RENMETHS 790 791 if { $methname == "" || \ 792 [set ixs [ChooseItems WP many]] == "" } { return } 793 RenameInternalWPs $methname [Apply $ixs NameOf WP] 794 return 795} 796 797proc GMGRRenameWPs {w methname args} { 798 # change names of selected WPs in group window $w 799 # $methname is the name of renaming method to use or empty for cancel 800 # $args not in use but is needed because of proc FillMenu 801 # by construction WP names in a GR are all different 802 global TXT NAMELENGTH 803 804 if { $methname == "" } { return } 805 if { [set names [GMGRCollectWPNames $w]] != {} && \ 806 [set names [GMChooseFrom many "$TXT(select) $TXT(nameWP)" \ 807 $NAMELENGTH $names $names]] != {} } { 808 RenameInternalWPs $methname $names 809 } 810 return 811} 812 813proc RenameInternalWPs {methname names} { 814 # apply a renaming method to WPs in the data-base or referred to 815 # in a GR 816 # $names is a list of the WP names 817 # $methname is method name 818 # start/end a renaming operation by calling procs InitWPRenaming 819 # and EndWPRenaming, ensuring no other renaming takes place 820 # use proc CheckName to verify the result of the method and 821 # if the result is not acceptable use proc NewName to get a 822 # suitable one 823 # update data-base, map, and edit/show windows 824 global WPName WPRoute WPObs WPDispl RTWPoints GRConts IndexOf \ 825 ReplNames TXT 826 827 set descmethod [lindex [GetDefFields renamethod $methname method] 0] 828 if { $names == {} || \ 829 [set method [lindex $descmethod 1]] == {} || \ 830 [InitWPRenaming] == 0 } { 831 return 832 } 833 set replold {} ; set replnew {} 834 foreach name $names { 835 if { [set nname [RenameMethApply $method $name \ 836 $replnew Ignore]] == "" || \ 837 ! [CheckName Ignore $nname] } { 838 set nname [NewName WP $name] 839 } 840 lappend replold $name 841 lappend replnew $nname 842 if { [set ix [IndexNamed WP $name]] != -1 } { 843 # update the data-base 844 unset IndexOf(WP,$name) 845 set IndexOf(WP,$nname) $ix 846 set WPName($ix) $nname 847 set WPObs($ix) [AddToNB $WPObs($ix) "$TXT(oname): $name"] 848 849 # update the items list and edit/show window 850 ListDelete WP $ix ; ListAdd WP $ix 851 UpdateItemWindows WP $ix 852 853 # update map 854 if { $WPDispl($ix) } { 855 MoveOnMap WP $ix $name 1 $nname 856 } 857 } 858 } 859 # update RTs containing renamed WPs 860 set rtixs {} 861 foreach ixrt [array names RTWPoints] { 862 foreach "chg RTWPoints($ixrt)" \ 863 [ListReplace $RTWPoints($ixrt) $replold $replnew] {} 864 if { $chg } { lappend rtixs $ixrt } 865 } 866 UpdateWPsInWindows RT $rtixs $replold $replnew 867 868 # update GRs containing renamed WPs 869 set grixs {} 870 foreach grix [array names GRConts] { 871 foreach {ics gwps} [GRWPNames $GRConts($grix)] {} 872 if { $gwps != {} } { 873 foreach {chg gwps} [ListReplace $gwps $replold $replnew] {} 874 if { $chg } { 875 set gwps [lsort -dictionary $gwps] 876 set GRConts($grix) [lreplace $GRConts($grix) $ics $ics \ 877 [list WP $gwps]] 878 lappend grixs $grix 879 } 880 } 881 } 882 UpdateWPsInWindows GR $grixs $replold $replnew 883 884 set ReplNames(old) $replold 885 set ReplNames(new) $replnew 886 EndWPRenaming 887 return 888} 889 890proc RenameMethApplyTo {name methname errproc} { 891 # apply a renaming method to WP with given $name 892 # $methname is method name 893 # to be used in the context of a renaming operation started by 894 # calling proc InitWPRenaming and ended by calling proc EndWPRenaming 895 # use proc CheckName to verify the result of the method and 896 # if the result is not acceptable use proc NewName to get a 897 # suitable one 898 # return the new name 899 global ReplNames 900 901 set descmethod [lindex [GetDefFields renamethod $methname method] 0] 902 if { [set method [lindex $descmethod 1]] == {} || \ 903 [set nname [RenameMethApply $method $name \ 904 $ReplNames(new) $errproc]] == "" || \ 905 ! [CheckName $errproc $nname] } { 906 return [NewName WP $name] 907 } 908 return $nname 909} 910 911## storing data items just read in 912 913proc StoreWP {ix name data todispl} { 914 # store WP data just read in 915 # $todispl is true if the WP should be mapped 916 # can only be called after a call to InitWPRenaming (use of ReplaceWPName) 917 # return name of stored WP 918 global WPRoute WPDispl EQNAMEDATA 919 920 if { $ix != -1 } { 921 if { $EQNAMEDATA == "ovwrt" || [set pd [SamePosn $ix $data]] == 1 } { 922 set olddispl $WPDispl($ix) 923 SetItem WP $ix $data 924 if { $todispl || $olddispl } { 925 set WPDispl($ix) 1 926 MoveOnMap WP $ix $name 0 $name 927 } 928 UpdateItemWindows WP $ix 929 return $name 930 } 931 # replace name 932 set data [AddOldNameToObs WP $data $name] 933 set name [ReplaceWPName $name $pd] 934 set data [lreplace $data 0 0 $name] 935 } 936 set ix [CreateItem WP $data] 937 if { $todispl } { PutMap WP $ix } 938 return $name 939} 940 941proc StoreRT {ix id data wps todispl} { 942 # store RT data just read in 943 # $todispl is true if the RT should be mapped 944 global RTWPoints RTDispl 945 946 if { $ix != -1 } { 947 if { $RTDispl($ix) } { 948 UnMapRT $ix 949 set todispl 1 950 } 951 UnsetWPRoute $id $RTWPoints($ix) 952 SetItem RT $ix $data 953 set RTDispl($ix) $todispl 954 UpdateItemWindows RT $ix 955 } else { 956 set ix [CreateItem RT $data] 957 } 958 if { $todispl } { PutMap RT $ix } 959 SetWPRoute $id $wps 960 return 961} 962 963proc StoreTR {ix id data todispl} { 964 # store TR data just read in 965 # $todispl is true if the TR should be mapped 966 global TRDispl 967 968 if { $ix != -1 } { 969 if { $TRDispl($ix) } { 970 UnMapTR $ix 971 set todispl 1 972 } 973 SetItem TR $ix $data 974 set TRDispl($ix) $todispl 975 UpdateItemWindows TR $ix 976 } else { 977 set ix [CreateItem TR $data] 978 } 979 if { $todispl } { PutMap TR $ix } 980 return 981} 982 983proc StoreLN {ix id data todispl} { 984 # store TR data just read in 985 # $todispl is true if the LN should be mapped 986 global LNDispl 987 988 if { $ix != -1 } { 989 if { $LNDispl($ix) } { 990 UnMapLN $ix 991 set todispl 1 992 } 993 SetItem LN $ix $data 994 set LNDispl($ix) $todispl 995 UpdateItemWindows LN $ix 996 } else { 997 set ix [CreateItem LN $data] 998 } 999 if { $todispl } { PutMap LN $ix } 1000 return 1001} 1002 1003proc StoreLAP {ix name data} { 1004 # store LAP data just read in assumed to be a new lap 1005 1006 if { $ix != -1 } { 1007 SetItem LAP $ix $data 1008 UpdateItemWindows LAP $ix 1009 } else { set ix [CreateItem LAP $data] } 1010 return $ix 1011} 1012 1013proc StoreGR {ix id data todispl} { 1014 # store GR data just read in 1015 # $todispl is true if the GR should be mapped 1016 global GRDispl 1017 1018 if { $ix != -1 } { 1019 if { $GRDispl($ix) } { 1020 UnMapGR $ix 1021 set todispl 1 1022 } 1023 SetItem GR $ix $data 1024 set GRDispl($ix) $todispl 1025 UpdateItemWindows GR $ix 1026 } else { 1027 set ix [CreateItem GR $data] 1028 } 1029 if { $todispl } { PutMap GR $ix } 1030 return 1031} 1032