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: files_foreign.tcl 22# Last change: 6 October 2013 23# 24# See below for guidelines on how to add support for new foreign formats 25# 26# Includes contributions by 27# - Brian Baulch (baulchb _AT_ onthenet.com.au) marked "BSB contribution" 28# - Matt Martin (matt.martin _AT_ ieee.org) marked "MGM contribution" 29# - Miguel Filgueiras (to code by others) marked "MF contribution" 30# - Valere Robin (valere.robin _AT_ wanadoo.fr) marked "VR contribution" 31# - Alessandro Palmas (alpalmas _AT_ tin.it) marked "AP contribution" 32# - Paul Scorer (p.scorer _AT_ leedsmet.ac.uk) marked "PS contribution" 33# 34# and changes by 35# - Mariusz Dabrowski (mgd4 _AT_ poczta.onet.pl) marked "MD changes" 36# 37# Includes an adaptation of a Perl script by Niki Hammler, http://www.nobaq.net 38# that converts exported FUGAWI data to DDD GPSman data 39# 40 41#### guidelines on how to add support for new foreign formats 42# 43# - choose a name for the new format: start with a capital letter, 44# keep the name short as it will be used in menus, and check that 45# it is not already in use 46# 47# - each file format must be described in the FILEFORMAT array that is 48# defined in metadata.tcl; see the comment there that documents the 49# entries in the array and prepare a description of the new format 50# 51# - find out an existing format similar to the new format, in particular 52# having the same "filetype" and the same "mode" and use its implementation 53# as a model (the GPSMan format is implemented in files.tcl, and part of 54# this code is used in the support for GPStrans; it is a good idea to 55# choose the implementation of other formats as models) 56# 57# - for importation a procedure Import_$FMT must be written whose arguments 58# are 59# - if the "filemode" is "unique" (only a possible items type): file 60# channel to read from, and reading mode that is either "normal" 61# or "inGR" (importing elements in a group; disregard if dealing 62# with groups is not supported) 63# - otherwise: the file channel, a list of types to import or 64# "Data", and the reading mode ("normal" or "inGR") 65# 66# - for exportation a procedure Export_$FMT must be written whose arguments 67# are 68# - if the "filemode" is "data": the file channel to write to and 69# a list of pairs with type and indices of the items to export 70# - otherwise: the file channel, the type and the list of indices 71# 72# - care must be taken to avoid clashes with existing global variables; it 73# is suggested that an array with name FF_$FMT (with $FMT the name 74# of the new format) is used for storing all global information needed 75# for its implementation 76 77##### utility 78 79proc NextLine {n file} { 80 # read next $n-th (>=1) non empty line 81 # return trimmed line or "" if end of file found 82 global MESS 83 84 set k 0 85 while 1 { 86 if { [eof $file] } { 87 GMMessage $MESS(badfile) 88 return "" 89 } 90 gets $file line ; set line [string trim $line] 91 if { $line != "" && [incr k] == $n } { return $line } 92 } 93 # not used 94 return 95} 96 97##### reading/writing binary files 98 99## binary coding of files: 100# little- and big-endian integral numbers 101# int, int_big: 16 bits; long, long_big: 32 bits 102# fixed-length strings: as sequence of bytes with given length 103# variable-length strings: length as int (little-endian), then the 104# sequence of bytes 105# floats and doubles: IEEE little-endian 106# booleans as ints 107# arrays of multiples: e.g., array@3=double,long is an array of pairs 108# whose length is given by element at index 3 (from 0) on the data list 109# (index < index of array); element type cannot be array! a list of lists 110# is used as the internal representation of the array 111 112array set BinConv { 113 byte c byte,l 1 114 int s int,l 2 115 bool s bool,l 2 116 int_big S int_big,l 2 117 long i long,l 4 118 long_big I long_big,l 4 119} 120 121proc ReadBinData {file types} { 122 # adapted from proc UnPackData (garmin.tcl) 123 # read binary data and convert to list of elements conforming to the 124 # types in the list $types 125 # accepted types: byte, int, int_big, long, long_big, float, double, 126 # charray=*, varstring, unused=*, bool, array@*=* 127 # bool is the same as int 128 # delete leading and trailing spaces of strings and char arrays 129 # return list of values read in 130 global tcl_platform ReadBinError BinConv 131 132 set vals "" 133 foreach t $types { 134 switch -glob $t { 135 byte { 136 set n 1 137 binary scan [read $file $n] "c" x 138 set x [expr ($x+0x100)%0x100] 139 } 140 bool - int - int_big - long - 141 long_big { 142 set n $BinConv($t,l) 143 binary scan [read $file $n] $BinConv($t) x 144 } 145 float { 146 # this only works with machines following the 147 # IEEE standard floating point representation 148 set n 4 149 set bs [read $file $n] 150 if { $tcl_platform(byteOrder) == "littleEndian" } { 151 binary scan $bs "f" x 152 } else { 153 set id "" 154 foreach k "3 2 1 0" { 155 append id [string index $bs $k] 156 } 157 binary scan $id "f" x 158 } 159 } 160 double { 161 # this only works with machines following the 162 # IEEE standard floating point representation 163 set n 8 164 set bs [read $file $n] 165 if { $tcl_platform(byteOrder) == "littleEndian" } { 166 binary scan $bs "d" x 167 } else { 168 set id "" 169 foreach k "7 6 5 4 3 2 1 0" { 170 append id [string index $bs $k] 171 } 172 binary scan $id "d" x 173 } 174 } 175 varstring { 176 if { [set lg [ReadBinData $file int]] < 0 } { 177 set ReadBinError 1 178 return $vals 179 } 180 set x [read $file $lg] 181 set n [expr 2+$lg] 182 set x [string trim $x " "] 183 } 184 charray=* { 185 regsub charray= $t "" n 186 set x [read $file $n] 187 set x [string trim $x " "] 188 } 189 array*@* { 190 if { ! [regexp {array@([0-9]+)=(.+)$} $t m ix lst] || \ 191 [set lg [lindex $vals $ix]] < 0 || \ 192 ! [regexp {^[0-9]+$} $lg] } { 193 set ReadBinError 1 194 return $vals 195 } 196 set x "" ; set sts [split $lst ","] 197 while { $lg } { 198 incr lg -1 199 lappend x [ReadBinData $file $sts] 200 if { $ReadBinError } { return [lappend vals $x] } 201 } 202 } 203 unused=* { 204 regsub unused= $t "" n 205 read $file $n 206 set x UNUSED 207 } 208 default { 209 set ReadBinError 1 210 return $vals 211 } 212 } 213 lappend vals $x 214 } 215 return $vals 216} 217 218proc WriteBinData {file types vals} { 219 # adapted from proc DataToStr (garmin.tcl) 220 # write binary data the result of converting from list of elements 221 # conforming to the types in $types 222 # accepted types: byte, int, int_big, long, long_big, float, double, 223 # charray=*, varstring, unused=*, bool, array@*=* 224 # bool is the same as int 225 # return 0 on error 226 global tcl_platform BinConv 227 228 foreach t $types v $vals { 229 switch -glob $t { 230 byte - bool - int - int_big - long - 231 long_big { 232 puts -nonewline $file [binary format $BinConv($t) $v] 233 } 234 float { 235 # this only works with machines following the 236 # IEEE standard floating point representation 237 set s [binary format "f" $v] 238 if { $tcl_platform(byteOrder) != "littleEndian" } { 239 set l [split "$s" ""] 240 set s "" 241 foreach k "3 2 1 0" { 242 append s [lindex $l $k] 243 } 244 } 245 puts -nonewline $file $s 246 } 247 double { 248 # this only works with machines following the 249 # IEEE standard floating point representation 250 set s [binary format "d" $v] 251 if { $tcl_platform(byteOrder) != "littleEndian" } { 252 set l [split "$s" ""] 253 set s "" 254 foreach k "7 6 5 4 3 2 1 0" { 255 append s [lindex $l $k] 256 } 257 } 258 puts -nonewline $file $s 259 } 260 varstring { 261 WriteBinData $file int [string length $v] 262 puts -nonewline $file [binary format "a*" $v] 263 } 264 charray=* { 265 regsub charray= $t "" n 266 puts -nonewline $file [binary format "A$n" $v] 267 } 268 array*@* { 269 if { ! [regexp {array@([0-9]+)=(.+)$} $t m ix lst] || \ 270 [set lg [lindex $vals $ix]] < 0 || \ 271 ! [regexp {^[0-9]+$} $lg] } { 272 BUG "error in specification to WriteBinData: $t $lg" 273 return 0 274 } 275 set sts [split $lst ","] 276 while { $lg } { 277 incr lg -1 278 if { ! [WriteBinData $file $sts [lindex $v 0]] } { 279 return 0 280 } 281 set v [lreplace $v 0 0] 282 } 283 } 284 unused=* { 285 regsub unused= $t "" n 286 puts -nonewline $file [binary format "x$n"] 287 } 288 default { 289 BUG "unimplemented data type when converting to binary: $t" 290 return 0 291 } 292 } 293 } 294 flush $file 295 return 1 296} 297 298##### exporting 299 300### geo-referencing files 301 302## Tiff World File format 303 304proc ExportTFW {affps} { 305 # export coordinates tranformation parameters to TFW file 306 # $affps is list with a parameter name followed by its value, as 307 # in the map transformation data array for the affine case, 308 # cf. proc AffineParams (maptransf.tcl) 309 global TXT 310 311 if { [set file [GMOpenFile $TXT(exportto) tfwfile w]] == ".." } { 312 return 313 } 314 array set dt $affps 315 foreach m {a c b d e f} { 316 puts $file $dt($m) 317 } 318 close $file 319 return 320} 321 322### exporting data 323 324proc ExportFile {how fmt what} { 325 # write data to file in foreign format 326 # $fmt such that "out" is in $FILEFORMAT($fmt,mode) except GPSMan 327 # $how==all: all items if $what==Data, otherwise items of type $what 328 # $how==select: items of type $what chosen from list 329 # possible types must be described by $FILEFORMAT($fmt,types) or the 330 # the second element of the pair $FILEFORMAT($fmt,io_types) and 331 # if $FILEFORMAT($fmt,filetype)!="data" there is a single type 332 # return 0 on success, 1 on failure 333 334 return [ExportFileTo "" $how $fmt $what] 335} 336 337proc ExportFileTo {file how fmt what} { 338 # if $file!="stdout" it will be closed at the end 339 global SFilePFrmt SFileDatum Storage TXT FILEFORMAT 340 341 switch $how { 342 all { 343 # the order of the list is that imposed by $FILEFORMAT($fmt,types) 344 # or the second element of the pair $FILEFORMAT($fmt,io_types); 345 # this may be important when writing to files in a format that 346 # imposes a specific order in the data 347 if { [catch {set ts $FILEFORMAT($fmt,types)}] } { 348 set ts [lindex $FILEFORMAT($fmt,io_types) 1] 349 } 350 set lp [AllIndicesForType $what $ts] 351 } 352 select { 353 if { [set ixs [ChooseItems $what]] == "" } { return 1 } 354 set lp [list [list $what $ixs]] 355 } 356 } 357 if { $FILEFORMAT($fmt,filetype) != "data" } { 358 set ixs [lindex [lindex $lp 0] 1] 359 set ft type 360 } else { set ft data } 361 if { $fmt == "Shapefile" } { 362 # single type 363 return [ExportShapefileTo $file $what $ixs] 364 } 365 if { $file == "" && \ 366 [set file [GMOpenFile $TXT(exportto) $what w]] == ".." } { 367 return 1 368 } 369 set sid [SlowOpWindow $TXT(export)] 370 if { $ft == "data" } { 371 Export_$fmt $file $lp 372 } else { Export_$fmt $file $what $ixs } 373 foreach v "PFrmt PFType Datum" { catch {unset SFile$v($file)} } 374 if { $file != "stdout" } { close $file } 375 SlowOpFinish $sid "" 376 return 0 377} 378 379proc ExportGREls {how fmt args} { 380 # write data on elements of group to file in foreign format 381 # $fmt such that "out" is in $FILEFORMAT($fmt,mode) except GPSMan, and 382 # $FILEFORMAT($fmt,GREls) is defined 383 # $how==all: from all groups, but types are selected 384 # $how==select: groups and types are selected by the user 385 # $args not used but in call-back 386 # possible types must be described by $FILEFORMAT($fmt,types) or 387 # the second element of the pair $FILEFORMAT($fmt,io_types) and 388 # if $FILEFORMAT($fmt,filetype)!="data" there is a single type 389 global GRName SFilePFrmt SFileDatum MESS TXT FILEFORMAT 390 391 if { [catch {set types $FILEFORMAT($fmt,types)}] } { 392 set types [lindex $FILEFORMAT($fmt,io_types) 1] 393 } 394 lappend types GR 395 switch $how { 396 all { 397 set ixs [array names GRName] 398 } 399 select { 400 if { [set ixs [ChooseItems GR]] == "" } { return } 401 } 402 } 403 set ts "" 404 foreach k $types { lappend ts $TXT(name$k) } 405 if { $FILEFORMAT($fmt,filetype) == "data" } { 406 set ft data 407 } else { set ft type } 408 while 1 { 409 # select types of items to export keeping the order in $types 410 set whs [GMChooseFrom many $MESS(putwhat) 6 $ts $types] 411 if { [set i [lsearch -exact $whs GR]] != -1 } { 412 set whs [lreplace $whs $i $i] 413 set rec 1 414 } else { set rec 0 } 415 if { [set n [llength $whs]] == 0 } { return } 416 if { $n > 1 && $ft == "type" } { 417 GMMessage $MESS(exportonly1) 418 } else { 419 break 420 } 421 } 422 set lp "" ; set none 1 423 foreach wh $whs { 424 if { [set eixs [GRsElements $ixs $rec $wh]] != "" } { set none 0 } 425 lappend lp [list $wh $eixs] 426 } 427 if { $none } { return } 428 if { $fmt == "Shapefile" } { 429 # single type 430 ExportShapefileTo "" $whs $eixs 431 return 432 } 433 set f [GMOpenFile $TXT(exportto) GR w] 434 if { $f != ".." } { 435 set sid [SlowOpWindow $TXT(export)] 436 if { $ft == "data" } { 437 Export_$fmt $f $lp 438 } else { Export_$fmt $f $whs $eixs } 439 catch { 440 unset SFilePFrmt($f) ; unset SFileDatum($f) 441 } 442 close $f 443 SlowOpFinish $sid "" 444 } 445 return 446} 447 448## GPStrans format 449 450proc Export_GPStrans {file what ixs} { 451 452 ExportGPStransHeader $file 453 ExportGPStrans$what $file $ixs 1 454 return 455} 456 457proc ExportGPStransHeader {file} { 458 # write header to file in GPStrans format, using $pformt for positions 459 global TimeOffset Datum SFilePFrmt SFileDatum 460 461 set dix [DatumRefId $Datum] 462 if { ! [regexp {^[0-9]+$} $dix] } { 463 # datum not defined in GPStrans 464 set datum "WGS 84" 465 set dix [DatumRefId $datum] 466 } else { set datum $Datum } 467 set h [format {Format: DDD UTC Offset: %6.2f hrs Datum[%3d]: %s} \ 468 $TimeOffset $dix $datum] 469 puts $file $h 470 set SFileDatum($file) $datum 471 # following values assumed below 472 set SFilePFrmt($file) DDD 473 return 474} 475 476proc ExportGPStransWP {file ixs tofile} { 477 # write WPs with indices in list $ixs either to file in GPStrans format, 478 # or to auxiliary file for putting data into receiver 479 global WPName WPCommt WPPosn WPDatum WPDate 480 global CREATIONDATE SFileDatum 481 482 set d [Today MMDDYYYY] 483 foreach i $ixs { 484 if { [SlowOpAborted] } { return } 485 if { $i != -1 } { 486 if { $CREATIONDATE } { 487 set d $WPDate($i) 488 } 489 set latd [lindex $WPPosn($i) 0] ; set longd [lindex $WPPosn($i) 1] 490 if { $WPDatum($i) != $SFileDatum($file) } { 491 set p [ToDatum $latd $longd $WPDatum($i) $SFileDatum($file)] 492 set latd [lindex $p 0] ; set longd [lindex $p 1] 493 } 494 if { $tofile } { 495 set m [format "W\t%s\t%40s\t%20s\t%03.7f\t%04.7f" \ 496 $WPName($i) $WPCommt($i) $d $latd $longd] 497 } else { 498 set m [format "W\t%s\t%40s\t%20s\t%03.7f\t%04.7f" \ 499 $WPName($i) [JustfLeft 40 $WPCommt($i)] $d $latd $longd] 500 } 501 puts $file $m 502 } 503 } 504 return 505} 506 507proc ExportGPStransRT {file ixs tofile} { 508 # write RTs with indices in list $ixs either to file in GPStrans format, 509 # or to auxiliary file for putting data into receiver 510 global RTIdNumber RTCommt RTWPoints MAXROUTES MESS 511 512 set badids 0 513 foreach i $ixs { 514 if { [SlowOpAborted] } { return } 515 if { ! [CheckNumber Ignore $RTIdNumber($i)] } { 516 incr badids 517 } else { 518 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 519 if { [Undefined $wps] } { 520 GMMessage [format $MESS(undefWP) $RTIdNumber($i)] 521 } elseif { !$tofile && $RTIdNumber($i)>$MAXROUTES } { 522 GMMessage [format $MESS(bigRT) $RTIdNumber($i)] 523 } else { 524 puts $file [format "R\t%d\t%40s" $RTIdNumber($i) \ 525 [JustfLeft 40 $RTCommt($i)]] 526 ExportGPStransWP $file $wps $tofile 527 } 528 } 529 } 530 if { $badids > 0 } { GMMessage [format $MESS(cantsaveRTid) $badids] } 531 return 532} 533 534proc ExportGPStransTR {file ixs tofile} { 535 # write TRs with indices in list $ixs either to file in GPStrans format, 536 # or to auxiliary file for putting data into receiver 537 global TRTPoints TRDatum SFileDatum 538 539 foreach i $ixs { 540 if { [SlowOpAborted] } { return } 541 if { $TRDatum($i) != $SFileDatum($file) } { 542 set tps [ChangeTPsDatum $TRTPoints($i) $TRDatum($i) \ 543 $SFileDatum($file)] 544 } else { set tps $TRTPoints($i) } 545 foreach tp $tps { 546 if { [SlowOpAborted] } { return } 547 puts $file [format "T\t%s\t%lf\t%lf" [lindex $tp 4] \ 548 [lindex $tp 0] [lindex $tp 1]] 549 } 550 puts $file "" 551 } 552 return 553} 554 555proc WriteXMLTag { type value } { 556 regsub -all {&} $value {\&} value 557 regsub -all {>} $value {\>} value 558 regsub -all {<} $value {\<} value 559 regsub -all {"} $value {\"} value 560 # ": a quote to avoid wrong colours in Emacs... 561 regsub -all {\'} $value {\'} value 562 return "<$type>$value</$type>\n" 563} 564 565## GPX format 566## Contributed by Valere Robin (valere.robin _AT_ wanadoo.fr) 567 568# MF change: using system encoding 569proc GPX_Encoding {tcl_enc} { 570 # convert a Tcl encoding name to the GPX one 571 # if the prefix is iso[0-9] it is converted to iso-[0-9], otherwise do 572 # nothing 573 574 regsub {^iso([0-9])} $tcl_enc {iso-\1} tcl_enc 575 return $tcl_enc 576} 577#---- 578set GPX_Header "<?xml version=\"1.0\" encoding=[GPX_Encoding \"$SYSENC\"] standalone=\"yes\"?> 579<gpx 580 version=\"1.0\" 581 creator=\"GPSMan\" 582 xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" 583 xmlns=\"http://www.topografix.com/GPX/1/0\" 584 xmlns:topografix=\"http://www.topografix.com/GPX/Private/TopoGrafix/0/2\" 585 xsi:schemaLocation=\"http://www.topografix.com/GPX/1/0 http://www.topografix.com/GPX/1/0/gpx.xsd http://www.topografix.com/GPX/Private/TopoGrafix/0/2 http://www.topografix.com/GPX/Private/TopoGrafix/0/2/topografix.xsd\"> 586 <author>an author</author> 587 <email>an_email _AT_ somewhere</email> 588 <url>an_url</url> 589 <urlname>a_url_name</urlname>" 590 591proc Export_GPX {file typesixs} { 592 # MF contribution: code by VR moved out from general export procs 593 594 ExportGPXHeader $file 595 foreach p $typesixs { 596 ExportGPX[lindex $p 0] $file [lindex $p 1] 1 597 } 598 ExportGPXTrailer $file 599 return 600} 601 602proc ExportGPXHeader {file} { 603 # write header to file in GPX format, using $pformt for positions 604 global GPX_Header SFilePFrmt SFileDatum 605 606 puts $file $GPX_Header 607 puts $file "<time>[TodayUTC ISO8601 ]</time>" 608 set SFileDatum($file) "WGS 84" 609 set SFilePFrmt($file) DDD 610 return 611} 612 613proc ExportGPXTrailer {file} { 614 puts $file "</gpx>" 615} 616 617proc ExportGPXWP {file ixs tofile } { 618 # write WPs with indices in list $ixs either to file in GPX format, 619 # or to auxiliary file for putting data into receiver 620 # type can be "wpt" or "rtept" 621 ExportGPXPT $file $ixs $tofile wpt 622} 623 624proc ExportGPXData {file ixs tofile } { 625 # write WPs with indices in list $ixs either to file in GPX format, 626 # or to auxiliary file for putting data into receiver 627 # type can be "wpt" or "rtept" 628 ExportGPXWP $file $ixs $tofile 629 ExportGPXRT $file $ixs $tofile 630 ExportGPXTR $file $ixs $tofile 631} 632 633proc ExportGPXPT {file ixs tofile type} { 634 # write WPs with indices in list $ixs either to file in GPX format, 635 # or to auxiliary file for putting data into receiver 636 # type can be "wpt" or "rtept" 637 global WPName WPCommt WPPosn WPDatum WPDate WPObs WPSymbol WPAlt 638 global SFileDatum 639 640 foreach i $ixs { 641 if { [SlowOpAborted] } { return } 642 if { $i != -1 } { 643 set latd [lindex $WPPosn($i) 0] ; set longd [lindex $WPPosn($i) 1] 644 if { $WPDatum($i) != $SFileDatum($file) } { 645 # MF change: calling ToDatum instead of ConvertDatum 646 set p [ToDatum $latd $longd $WPDatum($i) $SFileDatum($file)] 647 set latd [lindex $p 0] ; set longd [lindex $p 1] 648 } 649 puts $file [format "<$type lat=\"%03.7f\" lon=\"%04.7f\">" \ 650 $latd $longd ] 651 # MF contribution: elevation field 652 # altitude in metres 653 if { [set alt [lindex $WPAlt($i) 0]] != "" } { 654 puts $file " <ele>$alt</ele>" 655 } 656 #--- 657 puts $file [ WriteXMLTag "name" $WPName($i) ] 658 # puts $file [format " <name>%s</name>" $WPName($i) $WPObs($i)] 659 set date $WPDate($i) 660 if { $date != "" } { 661 set datesecs [lindex [CheckConvDate $date ] 1] 662 set dints [ DateIntsFromSecs $datesecs ] 663 set utcdints [ eval LocalTimeAndUTC $dints "local"] 664 set time [eval FormatDate "ISO8601" $utcdints] 665 puts $file " <time>$time</time>" 666 } 667 if { $WPSymbol($i) != "" } { 668 puts $file [format " <symbol>%s</symbol>\n" $WPSymbol($i) ] 669 } 670 if { $WPCommt($i) != "" } { 671 puts $file [ WriteXMLTag "cmt" $WPCommt($i) ] 672 } 673 if { $WPObs($i) != "" } { 674 puts $file [ WriteXMLTag "desc" $WPObs($i) ] 675 } 676 puts $file "</$type>\n" 677 } 678 } 679 return 680} 681 682proc ExportGPXRT {file ixs tofile} { 683 # write RTs with indices in list $ixs either to file in GPX format, 684 # or to auxiliary file for putting data into receiver 685 global RTIdNumber RTCommt RTObs RTWPoints MAXROUTES MESS 686 687 set badids 0 688 foreach i $ixs { 689 if { [SlowOpAborted] } { return } 690 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 691 if { [Undefined $wps] } { 692 GMMessage [format $MESS(undefWP) $RTIdNumber($i)] 693 } elseif { !$tofile && $RTIdNumber($i)>$MAXROUTES } { 694 GMMessage [format $MESS(bigRT) $RTIdNumber($i)] 695 } else { 696 puts $file "<rte>" 697 puts $file [ WriteXMLTag "name" $RTIdNumber($i) ] 698 if { $RTCommt($i) != "" } { 699 puts $file [ WriteXMLTag "desc" $RTCommt($i) ] 700 } 701 if { $RTObs($i) != "" } { 702 puts $file [ WriteXMLTag "cmt" $RTObs($i) ] 703 } 704 ExportGPXPT $file $wps $tofile rtept 705 puts $file "</rte>" 706 } 707 } 708 if { $badids > 0 } { GMMessage [format $MESS(cantsaveRTid) $badids] } 709 return 710} 711 712proc ExportGPXTR {file ixs tofile} { 713 # write TRs with indices in list $ixs either to file in GPX format, 714 # or to auxiliary file for putting data into receiver 715 global TRTPoints TRObs TRDatum SFileDatum DataIndex TRName TRSegStarts 716 717 set idt $DataIndex(TPdate) 718 set ial $DataIndex(TPalt) ; set idp $DataIndex(TPdepth) 719 set ids $DataIndex(TPsecs) 720 721 foreach i $ixs { 722 puts $file "<trk>" 723 puts $file [ WriteXMLTag "name" $TRName($i) ] 724 if { $TRObs($i) != "" } { 725 puts $file [ WriteXMLTag "desc" $TRObs($i) ] 726 } 727 puts $file " <trkseg>\n" 728 if { [SlowOpAborted] } { return } 729 # MF change: using proc ChangeTPsDatum 730 if { $TRDatum($i) != $SFileDatum($file) } { 731 set tps [ChangeTPsDatum $TRTPoints($i) $TRDatum($i) \ 732 $SFileDatum($file)] 733 } else { set tps $TRTPoints($i) } 734 # MF contribution: segment starters 735 set ssts $TRSegStarts($i) 736 set tpn 0 ; set nsst [lindex $ssts 0] 737 #-- 738 foreach tp $tps { 739 if { [SlowOpAborted] } { return } 740 # MF contribution: segment starters 741 if { $nsst == $tpn } { 742 puts $file "</trkseg><trkseg>\n" 743 set ssts [lreplace $ssts 0 0] 744 set nsst [lindex $ssts 0] 745 } 746 incr tpn 747 #-- 748 set latd [lindex $tp 0] ; set longd [lindex $tp 1] 749 set alt [lindex $tp $ial ] 750 set secs [lindex $tp $ids ] 751 puts $file "<trkpt lat=\"$latd\" lon=\"$longd\">" 752 set dints [ DateIntsFromSecs $secs ] 753 set utcdints [ eval LocalTimeAndUTC $dints "local"] 754 set time [eval FormatDate "ISO8601" $utcdints] 755 puts $file " <ele>$alt</ele>\n <time>$time</time>\n</trkpt>" 756 } 757 puts $file "</trkseg></trk>" 758 } 759 return 760} 761 762 763## KML format 764## Contributed by Valere Robin (valere . robin _at_ wanadoo.fr) 765 766# MF change: using system encoding 767set KML_Header "<?xml version=\"1.0\" encoding=\"$SYSENC\"?> 768<kml xmlns=\"http://earth.google.com/kml/2.2\"> 769<Document> 770 <name>GPSMan Export</name> 771 <open>1</open> 772 <description><!\[CDATA\[This document was exported from <a href=\"http://sourceforge.net/projects/gpsman\">GPSMan</a>.\]\]></description> 773 <Style id=\"RedLine\"> 774 <LineStyle> 775 <color>7f0000ff</color> 776 <width>4</width> 777 </LineStyle> 778 </Style> 779 <Style id=\"YellowLine\"> 780 <LineStyle> 781 <color>ff00ffff</color> 782 <width>2</width> 783 </LineStyle> 784 </Style> 785 <Style id=\"NormalPoint\"> 786 <IconStyle> 787 <color>ffff00ff</color> 788 <scale>0.7</scale> 789 <Icon> 790 <href>http://maps.google.com/mapfiles/kml/shapes/shaded_dot.png</href> 791 </Icon> 792 </IconStyle> 793 </Style> 794 <Style id=\"HighlightedPoint\"> 795 <IconStyle> 796 <color>ff7f00ff</color> 797 <scale>0.9</scale> 798 <Icon> 799 <href>http://maps.google.com/mapfiles/kml/shapes/shaded_dot.png</href> 800 </Icon> 801 </IconStyle> 802 </Style> 803 <StyleMap id=\"WayPoint\"> 804 <Pair> 805 <key>normal</key> 806 <styleUrl>#NormalPoint</styleUrl> 807 </Pair> 808 <Pair> 809 <key>highlight</key> 810 <styleUrl>#HighlightedPoint</styleUrl> 811 </Pair> 812 </StyleMap> 813" 814 815proc Export_KML {file typesixs} { 816 ExportKMLHeader $file 817 foreach p $typesixs { 818 ExportKML[lindex $p 0] $file [lindex $p 1] 1 819 } 820 ExportKMLTrailer $file 821 return 822} 823 824proc ExportKMLHeader {file} { 825 # write header to file in KML format 826 global KML_Header SFilePFrmt SFileDatum 827 828 puts $file $KML_Header 829 puts $file "<time>[TodayUTC ISO8601 ]</time>" 830 set SFileDatum($file) "WGS 84" 831 set SFilePFrmt($file) DDD 832 return 833} 834 835proc ExportKMLTrailer {file} { 836 puts $file "</Document></kml>" 837} 838 839proc ExportKMLWP {file ixs tofile } { 840 # write WPs with indices in list $ixs either to file in KML format, 841 puts $file "<Folder><name>Waypoints</name>" 842 ExportKMLPT $file $ixs $tofile wpt 843 puts $file "</Folder>" 844} 845 846proc ExportKMLData {file ixs tofile } { 847 # write WPs with indices in list $ixs either to file in KML format, 848 ExportKMLWP $file $ixs $tofile 849 ExportKMLRT $file $ixs $tofile 850 ExportKMLTR $file $ixs $tofile 851} 852 853proc ExportKMLPT {file ixs tofile type} { 854 # write WPs with indices in list $ixs either to file in KML format, 855 # type can be "wpt" or "rtept" 856 global WPName WPCommt WPPosn WPDatum WPDate WPObs WPSymbol WPAlt 857 global SFileDatum 858 859 foreach i $ixs { 860 if { [SlowOpAborted] } { return } 861 if { $i != -1 } { 862 set latd [lindex $WPPosn($i) 0] ; set longd [lindex $WPPosn($i) 1] 863 if { $WPDatum($i) != $SFileDatum($file) } { 864 # MF change: calling ToDatum instead of ConvertDatum 865 set p [ToDatum $latd $longd $WPDatum($i) $SFileDatum($file)] 866 set latd [lindex $p 0] ; set longd [lindex $p 1] 867 } 868 if { [set alt [lindex $WPAlt($i) 0]] != "" } { 869 } else { 870 set alt 0 871 } 872 set ptdesc [format "<Placemark> <Point><coordinates>%03.7f,%04.7f,%04.7f</coordinates></Point>" \ 873 $longd $latd $alt] 874 append ptdesc [ WriteXMLTag "name" $WPName($i) ] 875 set date $WPDate($i) 876 set comment "" 877 if { $date != "" } { 878 set datesecs [lindex [CheckConvDate $date ] 1] 879 set dints [ DateIntsFromSecs $datesecs ] 880 set utcdints [ eval LocalTimeAndUTC $dints "local"] 881 set time [eval FormatDate "ISO8601" $utcdints] 882 #append comment "<!\[CDATA\[<b>time:</b>$time<br>\]\]>" 883 } 884 if { $WPSymbol($i) != "" } { 885 #puts $file [format " <symbol>%s</symbol>\n" $WPSymbol($i) ] 886 } 887 if { $WPCommt($i) != "" } { 888 #puts $file [ WriteXMLTag "cmt" $WPCommt($i) ] 889 append comment "$WPCommt($i)" 890 } 891 if { $WPObs($i) != "" } { 892 #puts $file [ WriteXMLTag "desc" $WPObs($i) ] 893 append comment "$WPObs($i)" 894 } 895 append ptdesc "<description>$comment</description>" 896 append ptdesc "<styleUrl>#WayPoint</styleUrl>" 897 append ptdesc "</Placemark>" 898 if { $type == "wpt" } { 899 puts $file $ptdesc 900 } elseif { $type == "rtept" } { 901 puts $file "$longd,$latd,$alt" 902 } 903 } 904 } 905 906 return 907} 908 909proc ExportKMLRT {file ixs tofile} { 910 # write RTs with indices in list $ixs either to file in KML format, 911 global RTIdNumber RTCommt RTObs RTWPoints MAXROUTES MESS 912 913 set badids 0 914 puts $file "<Folder><name>Routes</name><visibility>1</visibility>" 915 puts $file "<open>0</open>" 916 set RTcoordinates "" 917 foreach i $ixs { 918 if { [SlowOpAborted] } { return } 919 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 920 if { [Undefined $wps] } { 921 GMMessage [format $MESS(undefWP) $RTIdNumber($i)] 922 } elseif { !$tofile && $RTIdNumber($i)>$MAXROUTES } { 923 GMMessage [format $MESS(bigRT) $RTIdNumber($i)] 924 } else { 925 puts $file "<Placemark>" 926 puts $file [ WriteXMLTag "name" $RTIdNumber($i) ] 927 puts $file "<open>0</open>" 928 set comment "" 929 if { $RTCommt($i) != "" } { 930 append comment "$RTCommt($i)" 931 } 932 if { $RTObs($i) != "" } { 933 append comment " - $RTObs($i)" 934 } 935 puts $file [ WriteXMLTag "description" $comment ] 936 puts $file "<styleUrl>#YellowLine</styleUrl><LineString>" 937 puts $file "<tessellate>1</tessellate><coordinates>" 938 ExportKMLPT $file $wps $tofile rtept 939 puts $file "</coordinates></LineString></Placemark>" 940 } 941 } 942 puts $file "</Folder>" 943 if { $badids > 0 } { GMMessage [format $MESS(cantsaveRTid) $badids] } 944 return 945} 946 947proc ExportKMLTR {file ixs tofile} { 948 # write TRs with indices in list $ixs either to file in KML format, 949 global TRTPoints TRObs TRDatum SFileDatum DataIndex TRName TRSegStarts 950 951 set idt $DataIndex(TPdate) 952 set ial $DataIndex(TPalt) ; set idp $DataIndex(TPdepth) 953 set ids $DataIndex(TPsecs) 954 955 puts $file "<Folder><name>Tracks</name>" 956 puts $file "<Visibility>1</Visibility>" 957 puts $file "<Open>0</Open>" 958 foreach i $ixs { 959 puts $file "<Folder>" 960 puts $file [ WriteXMLTag "name" $TRName($i) ] 961 if { $TRObs($i) != "" } { 962 puts $file [ WriteXMLTag "description" "$TRObs($i)" ] 963 } 964 puts $file "<Placemark id=\"Path\">" 965 puts $file "<name>Segment</name>" 966 puts $file "<styleUrl>#RedLine</styleUrl>" 967 puts $file " <LineString><tessellate>1</tessellate><coordinates>\n" 968 if { [SlowOpAborted] } { return } 969 # MF change: using proc ChangeTPsDatum 970 if { $TRDatum($i) != $SFileDatum($file) } { 971 set tps [ChangeTPsDatum $TRTPoints($i) $TRDatum($i) \ 972 $SFileDatum($file)] 973 } else { set tps $TRTPoints($i) } 974 # MF contribution: segment starters 975 set ssts $TRSegStarts($i) 976 set tpn 0 ; set nsst [lindex $ssts 0] 977 #-- 978 foreach tp $tps { 979 if { [SlowOpAborted] } { return } 980 # MF contribution: segment starters 981 if { $nsst == $tpn } { 982 puts $file "</coordinates></LineString>" 983 puts $file "</Placemark>" 984 puts $file "<Placemark id=\"Path\">" 985 puts $file "<name>Segment</name>" 986 puts $file "<styleUrl>#RedLine</styleUrl>" 987 puts $file "<LineString><tessellate>1</tessellate><coordinates>\n" 988 set ssts [lreplace $ssts 0 0] 989 set nsst [lindex $ssts 0] 990 } 991 incr tpn 992 #-- 993 set latd [lindex $tp 0] ; set longd [lindex $tp 1] 994 set alt [lindex $tp $ial ] 995 set secs [lindex $tp $ids ] 996 puts $file "$longd,$latd,$alt" 997 #set dints [ DateIntsFromSecs $secs ] 998 #set utcdints [ eval LocalTimeAndUTC $dints "local"] 999 #set time [eval FormatDate "ISO8601" $utcdints] 1000 #puts $file " <ele>$alt</ele>\n <time>$time</time>\n</trkpt>" 1001 } 1002 puts $file "</coordinates></LineString></Placemark>" 1003 puts $file "</Folder>" 1004 } 1005 puts $file "</Folder>" 1006 return 1007} 1008 1009## Ozi format 1010# Contributed by Alessandro Palmas (alpalmas _AT_ tin.it) 1011# Thanks to: 1012# Alex Mottram - gpsbabel staff - http://gpsbabel.sourceforge.net 1013# Dave Patton - http://www.confluence.org/ 1014 1015proc Export_Ozi {file what ixs} { 1016 # MF contribution: code moved out from general export procs 1017 1018 ExportOzi$what $file $ixs 1019 return 1020} 1021 1022proc DelphiTime {date} { 1023 # compute Delphi time (starting 1899-12-30 0:0:0) from GPSMan date 1024 # return the empty list on error 1025 1026 if { [set l [ScanDate $date]] == "" } { return "" } 1027 foreach "Y m D hh mm ss" $l {} 1028 set seconds_a [DateToSecsFrom $Y $m $D $hh $mm $ss 1950] 1029 set seconds_b [DateToSecsFrom 1950 1 1 0 0 0 1899] 1030 set seconds_0 [DateToSecsFrom 1899 12 30 0 0 0 1899] 1031 set delphi_1 [expr 1.0 * ($seconds_b - $seconds_0)/86400.0] 1032 set delphi_2 [expr 1.0 * $seconds_a/86400.0] 1033 set delphi [expr $delphi_1 + $delphi_2] 1034 return $delphi 1035} 1036 1037proc ExportOziWP {file ixs} { 1038 # derived from proc ExportGPStransWP 1039 # write WPs with indices in list $ixs to file in OZI format 1040 global WPName WPCommt WPPosn WPDatum WPDate 1041 global Datum 1042 global CREATIONDATE SFileDatum 1043 global ALSCALEFOR MESS TXT 1044 global WPAlt 1045 1046 set d [Today MM/DD/YYYY] 1047 1048 # $file must end in .wpt 1049 # we will have some checks here... To Be Done 1050 1051 puts $file "OziExplorer Waypoint File Version 1.1" 1052 puts $file "WGS 84" 1053 puts $file "Reserved 2" ;# reserved for future use 1054 puts $file "Reserved 3" ;# GPS Symbol Set, unused 1055 1056 # since max wp number is 1000 per file, we must trace this in $n; 1057 set n 0 ;# count wp in current $file 1058 set nf 0 ;# count for $file name 1059 foreach i $ixs { 1060 if { [SlowOpAborted] } { return } 1061 if { $i != -1 } { 1062 if { $CREATIONDATE } { 1063 set d $WPDate($i) 1064 } 1065 set latd [lindex $WPPosn($i) 0] ; set longd [lindex $WPPosn($i) 1] 1066 if { $WPDatum($i) != "WGS 84" } { 1067 # MF change: calling ToDatum instead of ConvertDatum 1068 set p [ToDatum $latd $longd $WPDatum($i) "WGS 84"] 1069 set latd [lindex $p 0] ; set longd [lindex $p 1] 1070 } 1071 set n [expr $n+1] 1072 if {$n > 1000} { 1073 GMMessage [format $MESS(toomany) $TXT(waypoint) 1000] 1074 return 1075 } 1076 puts -nonewline $file "$n," ;# Field 1: number 1077 puts -nonewline $file "$WPName($i)," ;# Field 2: Name (short) 1078 puts -nonewline $file "$latd," ;# Field 3: lat DDD 1079 puts -nonewline $file "$longd," ;# Field 4: long DDD 1080 1081 set delphitime [DelphiTime $d] 1082 puts -nonewline $file "$delphitime," ;# Field 5: date, in delphi format 1083 1084 puts -nonewline $file "0," ;# Field 6: symbol 1085 puts -nonewline $file "1," ;# Field 7: fixed 1086 puts -nonewline $file "3," ;# Field 8: map display format 1087 puts -nonewline $file "0," ;# Field 9: Foreground color: Black 1088 puts -nonewline $file "65535," ;# Field 10: Background color: White 1089 set wpcomm40 [string range $WPCommt($i) 0 39] 1090 puts -nonewline $file "$wpcomm40," ;# Field 11: Comment (Max 40, no commas) TBD 1091 puts -nonewline $file "," ;# Field 12: Direction 1092 puts -nonewline $file "0," ;# Field 13: Garmin Display Format 1093 puts -nonewline $file "0," ;# Field 14: Proximity Distance( 0 is off) 1094 1095 set mt [lindex $WPAlt($i) 0] 1096 # if not valid set ft -777 1097 if {$mt == ""} { 1098 set ft -777 1099 } else { 1100 set ft [expr $mt/$ALSCALEFOR(FT)] 1101 } 1102 puts -nonewline $file "$ft," ;# Field 15: Altitude, in feet. -777 is non valid 1103 puts -nonewline $file "6," ;# Field 16: Font size 1104 puts -nonewline $file "0," ;# Field 17: Font style: 0 normal, 1 bold 1105 puts -nonewline $file "17" ;# Field 18: Symbol Size, 17 is normal 1106 puts $file "" 1107 } 1108 } 1109 return 1110} 1111 1112proc ExportOziTR {file ixs} { 1113 # write TRs with indices in list $ixs to file in Ozi format 1114 global TRTPoints TRDatum SFileDatum 1115 global TRName 1116 global ALSCALEFOR 1117 global DataIndex 1118 1119 # It seems that in ozi 1 file <-> 1 track, anyway let's go... 1120 foreach i $ixs { 1121 if { [SlowOpAborted] } { return } 1122 if { $TRDatum($i) != "WGS 84" } { 1123 set tps [ChangeTPsDatum $TRTPoints($i) $TRDatum($i) \ 1124 "WGS 84"] 1125 } else { set tps $TRTPoints($i) } 1126 1127 #Line 1: File type & version 1128 puts $file "OziExplorer Track Point File Version 2.1" 1129 #Line 2: Datum 1130 puts $file "WGS 84" 1131 #Line 3: Reminder 1132 puts $file "Altitude is in Feet" 1133 #Line 4: Reserved line 1134 puts $file "Reserved 4" 1135 #Line 5: Various fields 1136 # in GPSBabel they use: 0,2,255,ComplimentsOfGPSBabel,0,0,2,8421376 1137 puts -nonewline $file "0," ;# Field 1: fixed 1138 puts -nonewline $file "2," ;# Field 2: track size 1139 puts -nonewline $file "255," ;# Field 3: track color 1140 1141 regsub -all -- {(?=[[:punct:]])} $TRName($i) "-" trackname 1142 puts -nonewline $file "$trackname," ;# Field 4: track name ( no commas! TBD regexp) 1143 1144 puts $file "0,0,2,8421376" ;# Field 5,6,7,8: track type & style 1145 #Line 6: Unused, if you want, put here number of track points 1146 puts $file "0" 1147 1148 foreach tp $tps { 1149 if { [SlowOpAborted] } { return } 1150 1151 puts -nonewline $file "[lindex $tp 0]," ; # 1- Lat, DDD 1152 puts -nonewline $file "[lindex $tp 1]," ; # 2- Lon, DDD 1153 puts -nonewline $file "0," ; # 3- 0: no break line, 1: break line 1154 1155 set mt [lindex $tp $DataIndex(TPalt)] 1156 # if not valid set ft -777 1157 if {$mt == ""} { 1158 set ft -777 1159 } else { 1160 set ft [expr $mt/$ALSCALEFOR(FT)] 1161 } 1162 puts -nonewline $file "$ft," ; # 4- altitude 1163 1164 set date [lindex $tp 4] 1165 set delphitime [DelphiTime $date] 1166 puts -nonewline $file "$delphitime," ; # 5- Date Delphi format TBD 1167 puts -nonewline $file "," ; # 6- Date MM/DD/YYYY TBD 1168 puts -nonewline $file "," ; # 7- Time TBD 1169 puts $file "" 1170 } 1171 } 1172 return 1173} 1174 1175# ------------------------------------------------------------ # 1176 1177## Shapefile format 1178 1179set SHPUndef -1e40 1180# datum must be kept compatible with position format 1181set SHPDatum "WGS 84" 1182set SHPPFormt DDD 1183set SHPZone "" 1184set SHPDUnit $ALTUNIT 1185set SHPAUnit $ALTUNIT 1186set SHPDim 3 1187 1188proc ExportShapefileTo {fname what ixs} { 1189 # export to Shapefile format items with indices $ixs of type $what 1190 # $fname may be empty in which case the user is asked to give a file name 1191 # $what in {WP, RT, TR, LN} 1192 # all data converted to $SHPDatum (currently set to "WGS 84") 1193 # return 1 on error, 0 on success 1194 global WPName WPCommt WPDate WPPFrmt WPPosn WPDatum WPAlt RTIdNumber \ 1195 RTCommt RTWPoints TRName TRObs TRDatum TRTPoints TRSegStarts \ 1196 LNName LNObs LNPFrmt LNDatum LNLPoints LNSegStarts DataIndex MESS \ 1197 TXT SHPUndef SHPPFormt SHPDatum SHPDUnit SHPAUnit SHPDim GFPFormt \ 1198 GFDUnit GFAUnit NNUMPFORMATS POSTYPE ALSCALEFOR INVTXT GSHPVersion 1199 1200 if { $fname == "" } { 1201 set ok 0 1202 set GFPFormt $TXT($SHPPFormt) 1203 set GFDUnit $TXT($SHPDUnit) ; set GFAUnit $TXT($SHPAUnit) 1204 set vs "SHPDim GFPFormt SHPDatum GFDUnit GFAUnit" 1205 set pfas [list $NNUMPFORMATS =GFPFormt TXT] 1206 set us [list $TXT(M) $TXT(FT)] 1207 set ds [list +$TXT(dimens)/[list 3 2] \ 1208 !$TXT(optPositionFormat)=FillPFormtMenu/$pfas \ 1209 !$TXT(datum)=FillDatumMenu/ \ 1210 +$TXT(distunit)/$us +$TXT(altunit)/$us] 1211 while { [set fn [GMGetFileName $TXT(exportto) $what w $vs $ds]] \ 1212 != ".." } { 1213 set basename [file rootname $fn] 1214 switch -- [set ext [file extension $fn]] { 1215 .shp - .shx - .dbf - "" { 1216 set ok 1 1217 } 1218 default { 1219 if { [GMConfirm [format $MESS(shpext) $ext]] } { 1220 set ok 1 1221 } 1222 } 1223 } 1224 if { $ok && ( [file exists $basename.shp] || \ 1225 [file exists $basename.shx] || \ 1226 [file exists $basename.dbf] ) } { 1227 if { [GMSelect $MESS(filexists) \ 1228 [list $TXT(ovwrt) $TXT(cancel)] "0 1"] } { 1229 set ok 0 1230 } 1231 } 1232 if { $ok } { 1233 set SHPPFormt $INVTXT($GFPFormt) 1234 if { [BadDatumFor $SHPPFormt $SHPDatum GMMessage] != 0 } { 1235 set ok 0 1236 } else { 1237 set SHPDUnit $INVTXT($GFDUnit) 1238 set SHPAUnit $INVTXT($GFAUnit) 1239 break 1240 } 1241 } 1242 } 1243 if { ! $ok } { return 1 } 1244 } else { 1245 # SHPDim, SHPPFormt, SHPDatum, SHPDUnit and SHPAUnit assumed to be 1246 # defined 1247 set basename [file rootname $fname] 1248 } 1249 if { $what == "LN" } { 1250 set shpwh TR 1251 } else { set shpwh $what } 1252 if { [set fsid [GSHPCreateFiles $basename $shpwh $SHPDim]] < 1 } { 1253 switch -- $fsid { 1254 0 { set m shpcntopen } 1255 -1 - 1256 -2 { BUG invalid type or dim } 1257 -3 { set m shpcntcrtfs } 1258 -4 { set m shpoutmem } 1259 } 1260 GMMessage $MESS($m) ; GSHPCloseFiles $fsid 1261 return 1 1262 } 1263 foreach "xix yix" $POSTYPE($SHPPFormt,xyixs) {} 1264 if { $POSTYPE($SHPPFormt) == "latlong" } { 1265 set scdist 1 1266 } else { set scdist $ALSCALEFOR($SHPDUnit) } 1267 set scalt $ALSCALEFOR($SHPAUnit) 1268 set slowid [SlowOpWindow $TXT(export)] 1269 switch $what { 1270 WP { 1271 foreach ix $ixs { 1272 if { [SlowOpAborted] } { break } 1273 set p $WPPosn($ix) 1274 if { $WPPFrmt($ix) != $SHPPFormt || \ 1275 $WPDatum($ix) != $SHPDatum } { 1276 set p [lindex [FormatPosition [lindex $p 0] [lindex $p 1] \ 1277 $WPDatum($ix) $SHPPFormt $SHPDatum] 0] 1278 } 1279 if { [lindex $p 2] == "--" } { 1280 GMMessage $MESS(outofgrid) 1281 continue 1282 } 1283 set x [expr $scdist*[lindex $p $xix]] 1284 set y [expr $scdist*[lindex $p $yix]] 1285 if { $SHPDim == 3 } { 1286 if { [set alt [lindex $WPAlt($ix) 0]] == "" } { 1287 set alt $SHPUndef 1288 } else { set alt [expr $alt*$scalt] } 1289 set r [GSHPWriteWP $fsid $x $y $alt $WPName($ix) \ 1290 $WPCommt($ix) $WPDate($ix)] 1291 } else { 1292 set r [GSHPWriteWP $fsid $x $y $WPName($ix) $WPCommt($ix) \ 1293 $WPDate($ix)] 1294 } 1295 switch -- $r { 1296 -3 { 1297 SlowOpFinish $slowid $MESS(shpoutmem) 1298 return 1 1299 } 1300 -4 { SlowOpFinish $slowid $MESS(shpcntwrtfs) ; return 1 } 1301 } 1302 } 1303 } 1304 RT { 1305 foreach ix $ixs { 1306 if { [SlowOpAborted] } { break } 1307 GSHPCreateRT $SHPDim $RTIdNumber($ix) $RTCommt($ix) 1308 set wpixs [Apply "$RTWPoints($ix)" IndexNamed WP] 1309 if { [Undefined $wpixs] } { 1310 SlowOpFinish $slowid \ 1311 [format $MESS(undefWP) $RTIdNumber($ix)] 1312 return 1 1313 } else { 1314 foreach wpix $wpixs { 1315 if { [SlowOpAborted] } { break } 1316 set p $WPPosn($wpix) 1317 if { $WPPFrmt($wpix) != $SHPPFormt || \ 1318 $WPDatum($wpix) != $SHPDatum } { 1319 set p [lindex [FormatPosition [lindex $p 0] \ 1320 [lindex $p 1] $WPDatum($wpix) \ 1321 $SHPPFormt $SHPDatum] 0] 1322 } 1323 if { [lindex $p 2] == "--" } { 1324 GMMessage $MESS(outofgrid) 1325 continue 1326 } 1327 set x [expr $scdist*[lindex $p $xix]] 1328 set y [expr $scdist*[lindex $p $yix]] 1329 if { $SHPDim == 3 } { 1330 if { [set alt [lindex $WPAlt($wpix) 0]] == "" } { 1331 set alt $SHPUndef 1332 } else { set alt [expr $scalt*$alt] } 1333 set r [GSHPAddWPToRT $x $y $alt] 1334 } else { 1335 set r [GSHPAddWPToRT $x $y] 1336 } 1337 if { $r == -2 } { 1338 SlowOpFinish $slowid $MESS(shpoutmem) 1339 return 1 1340 } 1341 } 1342 switch -- [GSHPWriteRT $fsid 1] { 1343 -5 { 1344 SlowOpFinish $slowid $MESS(shpoutmem) 1345 return 1 1346 } 1347 -6 { 1348 SlowOpFinish $slowid $MESS(shpcntwrtfs) 1349 return 1 1350 } 1351 } 1352 } 1353 } 1354 } 1355 TR { 1356 set ilt $DataIndex(TPlatd) ; set ilg $DataIndex(TPlongd) 1357 set ial $DataIndex(TPalt) 1358 set wsegs [expr $GSHPVersion >= 1.1] 1359 foreach ix $ixs { 1360 if { [SlowOpAborted] } { break } 1361 if { $wsegs && $TRSegStarts($ix) != "" } { 1362 switch -- [GSHPCreateTR $SHPDim $TRName($ix) $TRObs($ix) \ 1363 $TRSegStarts($ix)] { 1364 -2 { 1365 SlowOpFinish $slowid $MESS(shpoutmem) 1366 return 1 1367 } 1368 -3 { BUG invalid segment starters } 1369 } 1370 } else { 1371 GSHPCreateTR $SHPDim $TRName($ix) $TRObs($ix) 1372 } 1373 if { $TRDatum($ix) != $SHPDatum } { 1374 set tps [ChangeTPsDatum $TRTPoints($ix) \ 1375 $TRDatum($ix) $SHPDatum] 1376 } else { set tps $TRTPoints($ix) } 1377 foreach tp $tps { 1378 if { [SlowOpAborted] } { break } 1379 if { $SHPPFormt != "DMS" } { 1380 set p [lindex \ 1381 [FormatPosition [lindex $tp $ilt] [lindex $tp $ilg] \ 1382 $SHPDatum $SHPPFormt $SHPDatum] 0] 1383 if { [lindex $p 2] == "--" } { 1384 GMMessage $MESS(outofgrid) 1385 continue 1386 } 1387 } else { set p $tp } 1388 set x [expr $scdist*[lindex $p $xix]] 1389 set y [expr $scdist*[lindex $p $yix]] 1390 if { $SHPDim == 3 } { 1391 if { [set alt [lindex [lindex $tp $ial] 0]] == "" } { 1392 set alt $SHPUndef 1393 } else { set alt [expr $scalt*$alt] } 1394 set r [GSHPAddTPToTR $x $y $alt] 1395 } else { 1396 set r [GSHPAddTPToTR $x $y] 1397 } 1398 if { $r == -2 } { 1399 SlowOpFinish $slowid $MESS(shpoutmem) 1400 return 1 1401 } 1402 } 1403 switch -- [GSHPWriteTR $fsid 1] { 1404 -5 { SlowOpFinish $slowid $MESS(shpoutmem) ; return 1 } 1405 -6 { SlowOpFinish $slowid $MESS(shpcntwrtfs) ; return 1 } 1406 -7 { BUG segment starter too large } 1407 } 1408 } 1409 } 1410 LN { 1411 set ipos $DataIndex(LPposn) ; set ial $DataIndex(LPalt) 1412 set wsegs [expr $GSHPVersion >= 1.1] 1413 foreach ix $ixs { 1414 if { [SlowOpAborted] } { break } 1415 if { $wsegs && $LNSegStarts($ix) != "" } { 1416 switch -- [GSHPCreateTR $SHPDim $LNName($ix) $LNObs($ix) \ 1417 $LNSegStarts($ix)] { 1418 -2 { SlowOpFinish $slowid $MESS(shpoutmem) ; return 1 } 1419 -3 { BUG invalid segment starters } 1420 } 1421 } else { 1422 GSHPCreateTR $SHPDim $LNName($ix) $LNObs($ix) 1423 } 1424 if { $LNDatum($ix) != $SHPDatum } { 1425 if { [set lps [ChangeLPsDatum $LNLPoints($ix) \ 1426 $LNDatum($ix) $SHPDatum $SHPPFormt]] == -1 } { 1427 SlowOpFinish $slowid "" 1428 return 1 1429 } 1430 set pformt $SHPPFormt 1431 } else { 1432 set lps $LNLPoints($ix) ; set pformt $LNPFrmt($ix) 1433 } 1434 foreach lp $lps { 1435 if { [SlowOpAborted] } { break } 1436 set p [lindex $lp $ipos] 1437 if { $pformt != $SHPPFormt } { 1438 set p [lindex \ 1439 [FormatPosition [lindex $p 0] [lindex $p 1] \ 1440 $SHPDatum $SHPPFormt $SHPDatum] 0] 1441 if { [lindex $p 2] == "--" } { 1442 GMMessage $MESS(outofgrid) 1443 continue 1444 } 1445 } 1446 set x [expr $scdist*[lindex $p $xix]] 1447 set y [expr $scdist*[lindex $p $yix]] 1448 if { $SHPDim == 3 } { 1449 if { [set alt [lindex [lindex $lp $ial] 0]] == "" } { 1450 set alt $SHPUndef 1451 } else { set alt [expr $scalt*$alt] } 1452 set r [GSHPAddTPToTR $x $y $alt] 1453 } else { 1454 set r [GSHPAddTPToTR $x $y] 1455 } 1456 if { $r == -2 } { 1457 SlowOpFinish $slowid $MESS(shpoutmem) 1458 return 1 1459 } 1460 } 1461 switch -- [GSHPWriteTR $fsid 1] { 1462 -5 { SlowOpFinish $slowid $MESS(shpoutmem) ; return 1 } 1463 -6 { SlowOpFinish $slowid $MESS(shpcntwrtfs) ; return 1 } 1464 -7 { BUG segment starter too large } 1465 } 1466 } 1467 } 1468 } 1469 GSHPCloseFiles $fsid 1470 SlowOpFinish $slowid "" 1471 return 0 1472} 1473 1474## SimpleText format 1475# based on the Garmin Simple Text Output protocol and the following rules 1476# - position status: g or G, for 2D or 3D, depending on altitude being 1477# defined 1478# - EPH: always ___ 1479# - altitude: _____ if undefined, with position status g 1480# - horizontal speed: computed from previous point if any, or undefined 1481# - vertical speed: computed from previous point if any, or undefined 1482# - the first TP of a TR after a different TR is preceded by two 1483# sentences with all fields as undefined 1484# - the first TP of a TR segment (not the first one) is preceded by 1485# a sentence with all fields undefined 1486 1487proc Export_SimpleText {file type ixs} { 1488 # write TRs with indices in list $ixs to file in SimpleText format 1489 # $type assumed to be TR 1490 global TRTPoints TRDatum TRSegStarts DataIndex 1491 1492 if { $type != "TR" } { BUG Export_SimpleText not on TR? } 1493 foreach d "latd longd date secs alt" { set ix$d $DataIndex(TP$d) } 1494 set segstart "@______________________________________________________\r" 1495 set first 1 1496 foreach ix $ixs { 1497 if { $TRDatum($ix) != "WGS 84" } { 1498 set tps [ChangeTPsDatum $TRTPoints($ix) $TRDatum($ix) "WGS 84"] 1499 } else { set tps $TRTPoints($ix) } 1500 set sgsts $TRSegStarts($ix) 1501 if { $first } { 1502 set ssg [lindex $sgsts 0] ; set sgsts [lreplace $sgsts 0 0] 1503 set first 0 1504 set platd "" 1505 } else { 1506 set ssg 0 1507 puts $file $segstart 1508 } 1509 set tpn 0 1510 foreach tp $tps { 1511 if { [SlowOpAborted] } { return } 1512 if { $tpn == $ssg } { 1513 puts $file $segstart 1514 set ssg [lindex $sgsts 0] ; set sgsts [lreplace $sgsts 0 0] 1515 set platd "" 1516 } 1517 incr tpn 1518 foreach d "latd longd date secs alt" { 1519 set $d [lindex $tp [set ix$d]] 1520 } 1521 set sent @ 1522 # date 1523 set vs [DateIntsFromSecs $secs] 1524 append sent [format %02d [expr [lindex $vs 0]%100]] 1525 foreach v [lreplace $vs 0 0] { append sent [format %02d $v] } 1526 # position 1527 foreach x [list $latd $longd] hs "{N S} {E W}" wd "2 3" { 1528 if { $x < 0 } { 1529 set h [lindex $hs 1] ; set x [expr -$x] 1530 } else { set h [lindex $hs 0] } 1531 set ds [expr int(floor($x))] 1532 append sent $h [format "%0${wd}d" $ds] \ 1533 [format %05d [expr round(($x-$ds)*60000)]] 1534 } 1535 # status, EPH and altitude 1536 if { [set alt [lindex $alt 0]] == "" } { 1537 set status g ; set ealt ______ 1538 } else { 1539 set status G 1540 if { $alt < 0 } { 1541 set s - ; set ealt [expr -$alt] 1542 } else { set s + ; set ealt $alt } 1543 set ealt "$s[format %05d [expr round($ealt)]]" 1544 } 1545 append sent $status ___ $ealt 1546 # velocity 1547 if { $platd == "" || $secs-$psecs == 0 } { 1548 # no previous TP or with the same time-stamp 1549 append sent "_______________\r" 1550 } else { 1551 set dt [expr $secs-$psecs] 1552 set cosmlat [expr cos(($platd+$latd)*0.00872664625997164788)] 1553 # dm/s 1554 set velx [expr 1111200.0*($longd-$plongd)*$cosmlat/$dt] 1555 set vely [expr 1111200.0*($latd-$platd)/$dt] 1556 foreach c [list $vely $velx] hs "{E W} {N S}" { 1557 if { $c < 0 } { 1558 append sent [lindex $hs 1] ; set c [expr -$c] 1559 } else { append sent [lindex $hs 0] } 1560 append sent [format %04d [expr round($c)]] 1561 } 1562 # vertical speed 1563 if { $alt != "" && $palt != "" } { 1564 # cm/s 1565 set velh [expr round(($alt-$palt)*100.0/$dt)] 1566 if { $velh < 0 } { 1567 append sent D ; set velh [expr -$velh] 1568 } else { append sent U } 1569 append sent [format %04d $velh] \r 1570 } else { append sent "_____\r" } 1571 } 1572 set platd $latd ; set plongd $longd ; set palt $alt 1573 set psecs $secs 1574 1575 puts $file $sent 1576 } 1577 } 1578 return 1579} 1580 1581 1582 1583##### importing 1584 1585proc OpenImportFileFails {what fmt} { 1586 # open file in foreign format and set initial values for importing data 1587 # $what in $TYPES 1588 # return 0 unless operation is to be cancelled 1589 1590 return [OpenInputFileFails $what $fmt] 1591} 1592 1593proc OpenFileWithExtension {filename what exts} { 1594 # open file with base name $filename and extension in $exts and 1595 # if they cannot be opened for reading, ask the user 1596 # return ".." on error, otherwise the file channel 1597 # the actual file path is stored in the global File($what) 1598 # $what is in $FileTypes 1599 global File TXT 1600 1601 set bn [file rootname $filename] 1602 foreach ext $exts { 1603 if { ! [catch {set f [open $bn.$ext r]}] } { 1604 set File($what) [file join [pwd] $bn.$ext] 1605 return $f 1606 } 1607 } 1608 if { [set f [GMOpenFile $TXT(loadfrm) $what r]] == ".." } { 1609 return ".." 1610 } 1611 return $f 1612} 1613 1614### geo-referencing files 1615 1616## Tiff World File format 1617 1618proc ImportTFW {filename} { 1619 # read coordinates tranformation parameters from TFW file 1620 # try files with base name $filename and extension .tfw or .TFW and 1621 # if they cannot be opened for reading, ask the user 1622 # return 0 on failure, or pair with empty list (no known points to be 1623 # projected) and list with the values in the first six lines, 1624 # see proc MapInitTFWTransf (maptransf.tcl) 1625 global File MESS 1626 1627 if { [set f [OpenFileWithExtension $filename MapBkInfo "tfw TFW"]] == \ 1628 ".." } { 1629 return 0 1630 } 1631 set filename [file tail $File(MapBkInfo)] 1632 set i 0 ; set vals {} 1633 while { ! [eof $f] } { 1634 gets $f line 1635 if { $line != "" } { 1636 if { [scan $line %f v] != 1 } { 1637 set i 0 1638 break 1639 } 1640 lappend vals $v 1641 incr i 1642 } 1643 } 1644 close $f 1645 if { $i != 6 } { GMMessage "$MESS(badmapinfo): $filename" } 1646 return [list {} $vals] 1647} 1648 1649## partial support for OziExplorer .map files 1650# with thanks to Paulo Quaresma (pq _AT_ di.uevora.pt) for the information on 1651# the different forms of line 4 and to Kari Likovuori 1652# (kari.likovuori _AT_ gmail.com) for information leading to not dealing with 1653# projected points 1654 1655array set OziMapFAs { 1656 start {prefix {OziExplorer Map Data File} line 5} 1657 5 {datum 0 line 8} 1658 8 {prefix {Magnetic Variation,,,} line 9} 1659 9 {info "" search {Projection Setup,} ps} 1660 ps {info "" search {MMPXY,} xy} 1661 xy {loop mmpxy search {MMPLL,} ll} 1662 ll {loop mmpll end} 1663 1664 mmpxy,numxy {^MMPXY,[ ]*([0-9]+)[ ]*,[ ]*([0-9]+),[ ]*([0-9]+)[ ]*$} 1665 mmpll,latlong {^MMPLL,[ ]*([0-9]+)[ ]*,([^,]*),[ ]*(.+)[ ]*$} 1666} 1667 1668array set OziDatum { 1669 {Ascension Island 1958} {Ascension Island `58} 1670 {Astro Beacon 1945} {Astro Beacon "E"} 1671 {Astronomic Stn 1952} {Astronomic Stn `52} 1672 {Australian Geocentric 1994 (GDA94)} {WGS 84} 1673 {Australian Geod 1984} {Australian Geod `84} 1674 {Australian Geod 1966} {Australian Geod `66} 1675 {European 1950 (Mean France)} {European 1950; NW Europe} 1676 {European 1950 (Spain and Portugal)} {European 1950; Portugal+Spain} 1677 {Geodetic Datum 1949} {Geodetic Datum `49} 1678 {Hartebeeshoek94} {WGS 84} 1679 {Indian Bangladesh} {Indian (Bangladesh)} 1680 {ISTS 073 Astro 1969} {ISTS 073 Astro `69} 1681 {NGO1948} {NGO 1948} 1682 {NTF France} {NTF (Nouvelle Triangulation de France)} 1683 {Potsdam Rauenberg DHDN} Potsdam 1684 {Prov So Amrican 1956} {Prov So Amrican `56} 1685 {Prov So Chilean 1963} {Prov So Chilean `63} 1686 {Pulkovo 1942 (1)} {Pulkovo 1942} 1687 {Pulkovo 1942 (2)} {Pulkovo 1942} 1688 Rijksdriehoeksmeting {Rijks Driehoeksmeting} 1689 S42 {S-42 (Pulkovo 1942); Hungary} 1690 {South American 1969} {South American `69} 1691 {Wake-Eniwetok 1960} {Wake-Eniwetok `60} 1692} 1693 1694proc ImportOziMap {filename} { 1695 # read pixel and geodetic coordinates of points in an OziExplorer 1696 # .map file 1697 # try files with base name $filename and extension .map or .MAP and 1698 # if they cannot be opened for reading, ask the user 1699 # projected points cannot be dealt with because there is no way to 1700 # deal with the projection 1701 # return 0 on failure, or pair with list of latd,longd,datum and 1702 # list of pairs with pixel coordinates (in Tcl sign convention) 1703 # aligned with the previous one 1704 global OziMapFAs OziDatum File TXT MESS Datum 1705 1706 if { [set f [OpenFileWithExtension $filename MapBkInfo "map MAP"]] == \ 1707 ".." } { 1708 return 0 1709 } 1710 set filename [file tail $File(MapBkInfo)] 1711 set getline 1 ; set lno 0 ; set err 0 ; set datum "" 1712 set state start 1713 while { ! [eof $f] } { 1714 set trans $OziMapFAs($state) 1715 if { $getline } { 1716 gets $f line 1717 incr lno 1718 } 1719 # puts "\#$lno; trans=$trans" 1720 set getline 1 1721 switch [lindex $trans 0] { 1722 prefix { 1723 if { [string first [lindex $trans 1] $line] != 0 } { 1724 incr err 1725 break 1726 } 1727 } 1728 datum { 1729 set field [lindex $trans 1] 1730 set datum [lindex [split $line ","] $field] 1731 if { ! [catch {set d $OziDatum($datum)}] } { 1732 set datum $d 1733 } elseif { [DatumRefId $datum] == -1 } { 1734 incr err 1735 break 1736 } 1737 } 1738 info { 1739 regsub -all {,} $line "\n\t" line 1740 DisplayInfo $line 1741 } 1742 loop { 1743 switch [set sst [lindex $trans 1]] { 1744 mmpxy { 1745 set patt1 $OziMapFAs(mmpxy,numxy) 1746 set patt2 "" 1747 } 1748 mmpll { 1749 set patt1 $OziMapFAs(mmpll,latlong) 1750 set patt2 "" 1751 } 1752 } 1753 while 1 { 1754 if { ! [regexp $patt1 $line m pn a2 a3] } { 1755 set getline 0 1756 break 1757 } 1758 scan $pn %0d pn 1759 set data($pn,$sst) [list $a2 $a3] 1760 if { $patt2 != "" } { 1761 if { [regexp $patt2 $line m b1 b2 b3 b4 b5 b6] } { 1762 set data($pn,$sst,2) \ 1763 [list $b1 $b2 $b3 $b4 $b5 $b6] 1764 } 1765 } 1766 if { [eof $f] } { break } 1767 gets $f line 1768 incr lno 1769 } 1770 } 1771 } 1772 switch [lindex $trans 2] { 1773 line { 1774 set state [lindex $trans 3] 1775 while { $lno < $state && ! [eof $f] } { 1776 gets $f line 1777 incr lno 1778 } 1779 if { $lno < $state } { 1780 incr err 1781 break 1782 } 1783 set getline 0 1784 } 1785 search { 1786 set prefix [lindex $trans 3] 1787 while 1 { 1788 if { [string first $prefix $line] == 0 } { break } 1789 if { [eof $f] } { 1790 incr err 1791 break 1792 } 1793 gets $f line 1794 incr lno 1795 } 1796 if { $err } { break } 1797 set state [lindex $trans 4] 1798 set getline 0 1799 } 1800 end { 1801 set state end 1802 break 1803 } 1804 } 1805 } 1806 close $f 1807 if { $err } { 1808 GMMessage "$MESS(badmapinfo): $filename, $lno" 1809 return 0 1810 } 1811 if { $datum == "" || [catch {set es [array names data]}] } { 1812 incr err 1813 } else { 1814 set llds "" ; set pixs "" 1815 set es [lsort -dictionary $es] 1816 set prev "" ; set ll "" ; set pix "" 1817 foreach e $es { 1818 regexp {^([0-9]+),([^,]+)(.*)$} $e m pn cat cat2 1819 if { $pn != $prev } { 1820 if { $ll != "" && $pix != "" } { 1821 lappend ll $datum 1822 lappend llds $ll ; lappend pixs $pix 1823 } 1824 set prev $pn ; set ll "" ; set pix "" 1825 } 1826 set d $data($e) 1827 switch $cat { 1828 mmpxy { 1829 foreach "x y" $d {} 1830 scan $x %0d x ; scan $y %0d y 1831 if { $pix == "" } { 1832 set pix [list $x $y] 1833 } elseif { $pix != [list $x $y] } { 1834 set pix "" 1835 } 1836 } 1837 mmpll { 1838 foreach "long lat" $d {} 1839 if { [scan $lat %f lat] && [scan $long %f long] && \ 1840 [CheckLat Ignore $lat DDD] && \ 1841 [CheckLong Ignore $long DDD] } { 1842 if { $ll == "" } { 1843 set ll [list $lat $long] 1844 } elseif { $ll != [list $lat $long] } { 1845 set ll "" 1846 } 1847 } 1848 } 1849 } 1850 } 1851 if { $ll != "" && $pix != "" } { 1852 lappend ll $datum 1853 lappend llds $ll ; lappend pixs $pix 1854 } 1855 if { $llds == "" } { incr err } 1856 } 1857 if { $err } { 1858 GMMessage "$MESS(badmapinfo): $filename" 1859 return 0 1860 } 1861 set Datum $datum 1862 return [list $llds $pixs] 1863} 1864 1865### file dates 1866 1867proc GetFilesDates {files mdate dhour} { 1868 # find the dates of the given $files 1869 # $mdate=="pict": for digital pictures: get the date from an 1870 # EXIF tag (Tcl exif package, or exif or metacam utilities) 1871 # =="exif": files contain EXIF tags as produced by exif or metacam, 1872 # the date is taken from a tag 1873 # =="fmod": use the file last modification time 1874 # $dhour is difference in hours to apply to file dates 1875 # files whose date could not be retrieved are discarded with an error 1876 # return list of triples of date in seconds from $YEAR0, file, and 1877 # date in "%Y:%m:%d %H:%M:%S" format, sorted by seconds 1878 global YEAR0 MESS 1879 1880 set sfds "" ; set dates "" 1881 set dsecs [expr 3600*$dhour] 1882 switch $mdate { 1883 pict { 1884 # check availability of the exif package and the exif utility 1885 set exiflib [expr ! [catch {package require exif}]] 1886 set exif [expr ! [catch {set x [exec exif]}]] 1887 # check whether the metacam utility is available 1888 # a catch on metacam will always yield true... 1889 if { [catch {exec which which}] } { 1890 if { [catch {exec whereis -b whereis}] } { 1891 # maybe metacam is available after all... 1892 set metacam 1 1893 } else { 1894 set metacam [regexp {:.+$} [exec whereis -b metacam]] 1895 } 1896 } else { 1897 set metacam [expr ! [catch {exec which metacam}]] 1898 } 1899 foreach f $files { 1900 set date "" 1901 # the exif package gives an error when finding unknown tags 1902 if { $exiflib && \ 1903 ! [catch {set avs [exif::analyzeFile $f]}] && \ 1904 $avs != "" } { 1905 catch {unset d} 1906 array set d $avs 1907 set date $d(DateTime) 1908 } 1909 if { $date == "" && $exif && [set et [exec exif $f]] != "" } { 1910 foreach ln [split $et "\n"] { 1911 if { [string first "Date and Time" $ln] == 0 } { 1912 set ln [string trimright $ln] 1913 # this may fail but is checked below 1914 regexp {\|(.+)$} $ln x date 1915 break 1916 } 1917 } 1918 } 1919 if { $date == "" && $metacam && \ 1920 ! [catch {set et [exec metacam $f]}] } { 1921 foreach ln [split $et "\n"] { 1922 set ln [string trim $ln] 1923 if { [string first "Image Creation" $ln] == 0 } { 1924 set ln [string trimright $ln] 1925 regexp {: (.+)$} $ln x date 1926 break 1927 } 1928 } 1929 } 1930 set date [string trim $date] 1931 if { [lsearch -exact $dates $date] != -1 || \ 1932 [scan $date "%d:%0d:%0d %0d:%0d:%0d" y m d h mn s] != 6 || \ 1933 ! [CheckDateEls $y $m $d $h $mn $s] } { 1934 GMMessage "$MESS(badfile): $f" 1935 continue 1936 } 1937 set secs [DateToSecsFrom $y $m $d $h $mn $s $YEAR0] 1938 if { $dhour != 0 } { 1939 set secs [expr $secs+$dsecs] 1940 # assume use of $YEAR0 1941 set date [DateFromSecs $secs] 1942 } 1943 lappend sfds [list $secs $f $date] 1944 lappend dates $date 1945 } 1946 } 1947 exif { 1948 # EXIF files may have been produced by exif or metacam 1949 foreach f $files { 1950 if { [catch {set fc [open $f r]}] } { 1951 GMMessage "$MESS(badfile): $f" 1952 continue 1953 } 1954 set date "" 1955 while { ! [eof $fc] } { 1956 gets $fc ln 1957 if { [string first "Date and Time" $ln] == 0 } { 1958 set ln [string trimright $ln] 1959 if { [regexp {\|(.+)$} $ln x date] } { break } 1960 } else { 1961 set ln [string trim $ln] 1962 if { [string first "Image Creation" $ln] == 0 } { 1963 set ln [string trimright $ln] 1964 regexp {: (.+)$} $ln x date 1965 break 1966 } 1967 } 1968 } 1969 close $fc 1970 set date [string trim $date] 1971 if { [lsearch -exact $dates $date] != -1 || \ 1972 [scan $date "%d:%0d:%0d %0d:%0d:%0d" y m d h mn s] != 6 || \ 1973 ! [CheckDateEls $y $m $d $h $mn $s] } { 1974 GMMessage "$MESS(badfile): $f" 1975 continue 1976 } 1977 set secs [DateToSecsFrom $y $m $d $h $mn $s $YEAR0] 1978 if { $dhour != 0 } { 1979 set secs [expr $secs+$dsecs] 1980 # assume use of $YEAR0 1981 set date [DateFromSecs $secs] 1982 } 1983 lappend sfds [list $secs $f $date] 1984 lappend dates $date 1985 } 1986 } 1987 fmod { 1988 foreach f $files { 1989 if { ! [catch {set mt [file mtime $f]}] } { 1990 set date [clock format $mt -format "%Y:%m:%d %H:%M:%S"] 1991 if { [lsearch -exact $dates $date] == -1 } { 1992 scan $date "%d:%0d:%0d %0d:%0d:%0d" y m d h mn s 1993 set secs [DateToSecsFrom $y $m $d $h $mn $s $YEAR0] 1994 if { $dhour != 0 } { 1995 set secs [expr $secs+$dsecs] 1996 # assume use of $YEAR0 1997 set date [DateFromSecs $secs] 1998 } 1999 lappend sfds [list $secs $f $date] 2000 lappend dates $date 2001 } 2002 } else { GMMessage "$MESS(badfile): $f" } 2003 } 2004 } 2005 } 2006 return [lsort -index 0 -integer -increasing $sfds] 2007} 2008 2009### data files 2010 2011proc ImportFile {what fmt} { 2012 # open file in foreign format and load data from it 2013 # $fmt such that "in" is in $FILEFORMAT($fmt,mode) except GPSMan 2014 # $what either may be "Data" if $FILEFORMAT($fmt,filetype) == "data' 2015 # or a list of types in $FILEFORMAT($fmt,types) or the first 2016 # element of the pair $FILEFORMAT($fmt,io_types) 2017 2018 return [ImportFileFrom "" $what $fmt] 2019} 2020 2021proc ImportFileFrom {file what fmt} { 2022 # if $file=="" then ask user to select a file 2023 # return 1 on error, 0 on success 2024 global LChannel FILEFORMAT 2025 2026 if { [InitWPRenaming] == 0 } { return 1 } 2027 if { $fmt == "Shapefile" } { 2028 set r [ImportShapefileFrom $file $what] 2029 EndWPRenaming 2030 return $r 2031 } 2032 if { $file == "" && [OpenImportFileFails $what $fmt] } { return 1 } 2033 2034 if { $FILEFORMAT($fmt,filetype) == "unique" } { 2035 Import_$fmt $LChannel($what) normal 2036 } else { Import_$fmt $LChannel($what) $what normal } 2037 CloseInputFile $what 2038 EndWPRenaming 2039 return 0 2040} 2041 2042proc ImportGREls {what fmt} { 2043 # load data from file in foreign format according to contents of GR(s) 2044 # $fmt such that "in" is in $FILEFORMAT($fmt,mode) except GPSMan, and 2045 # $FILEFORMAT($fmt,GREls) is defined 2046 # $what in $TYPES identifies menu, not being used 2047 # possible types used here are those in $FILEFORMAT($fmt,types) or the 2048 # first element of the pair $FILEFORMAT($fmt,io_types) except 2049 # TR (there is no way to identify TRs) 2050 global FILEFORMAT 2051 2052 if { [catch {set types $FILEFORMAT($fmt,types)}] } { 2053 set types [lindex $FILEFORMAT($fmt,io_types) 0] 2054 } 2055 InputToGR $types TR OpenImportFileFails ImportGRElsIn CloseInputFile $fmt 2056 return 2057} 2058 2059proc ImportGRElsIn {types lixs fmt} { 2060 # import items of $types to replace items with given indices 2061 # with -1 meaning new items should be accepted 2062 # $lixs is list of lists of indices (and maybe -1) aligned with $types 2063 # $fmt: see proc ImportGREls 2064 # most formats have single-type files and $types and $lixs will 2065 # have a single element and a single list, respectively 2066 global LChannel LFileIxs FILEFORMAT 2067 2068 set file $LChannel(GR) 2069 foreach wh $types ixs $lixs { 2070 set LFileIxs($file,$wh) $ixs 2071 } 2072 if { $FILEFORMAT($fmt,filetype) == "unique" } { 2073 Import_$fmt $file inGR 2074 } else { Import_$fmt $file $types inGR } 2075 foreach wh $types { 2076 catch { unset LFileIxs($file,$wh) } 2077 } 2078 return 2079} 2080 2081## GPStrans format 2082 2083proc Import_GPStrans {file what how} { 2084 2085 if { [ImportGPStransHeader $file] } { 2086 ImportGPStrans$what $file normal 2087 } 2088 return 2089} 2090 2091proc ImportGPStransHeader {file} { 2092 # parse header when reading from file in GPStrans format 2093 global LFilePFrmt LFileDatum LFileEOF MESS 2094 2095 set m [ReadFile $file] 2096 if { $LFileEOF($file) || [string first "Format:" $m]!=0 } { 2097 GMMessage "$MESS(noformat): $m" 2098 return 0 2099 } 2100 set m [string range $m 8 end] 2101 set LFilePFrmt($file) [FindPFormat $m] 2102 if { $LFilePFrmt($file) != "BAD" } { 2103 set m [string range $m 17 end] 2104 if { [scan $m "%f" off] == 1 } { 2105 # don't know what to do with time offset 2106 set LFileDatum($file) [string range $m 24 end] 2107 if { [DatumRefId $LFileDatum($file)] == -1 } { 2108 GMMessage "$MESS(unkndatum): $LFileDatum($file)" 2109 return 0 2110 } 2111 return 1 2112 } 2113 } 2114 GMMessage "$MESS(badformat): $m" 2115 return 0 2116} 2117 2118proc ImportGPStransWP {file how} { 2119 # load WPs from file in GPStrans format 2120 # $how in {normal, inGR}: keep all data, keep data on WPs with indices 2121 # in $LFileIxs($file,WP) 2122 2123 LoadWPs $file 1 1 $how 2124 return 2125} 2126 2127proc ImportGPStransRT {file how} { 2128 # load RTs from file in GPStrans format 2129 # $how in {normal, inGR}: keep all data, keep data on RTs with 2130 # indices in $LFileIxs($file,RT) 2131 global LFileLNo LFileEOF MESS 2132 2133 while { 1 } { 2134 set m [ReadFile $file] 2135 if { $LFileEOF($file) } { return } 2136 if { ! [regexp "R\t.*" $m] } { 2137 GMMessage "$MESS(badRT) $LFileLNo($file)" 2138 return 2139 } 2140 if { [FindArgs RT [string range $m 2 end] $file] == "BADC" } { 2141 GMMessage "$MESS(badRTargs) $LFileLNo($file)" 2142 return 2143 } 2144 if { [BadRTRead $file 1 $how] } { return } 2145 } 2146} 2147 2148proc ImportGPStransTR {file how} { 2149 # load TRs from file in GPStrans format 2150 # $how in {normal, inGR}: keep all data, not used 2151 global LFileLNo LFileEOF LFileBuffFull MESS 2152 2153 while { 1 } { 2154 set m [ReadFile $file] 2155 if { $LFileEOF($file) } { return } 2156 if { ! [regexp "T\t.*" $m] } { 2157 GMMessage "$MESS(badTR) $LFileLNo($file)" 2158 return 2159 } 2160 set LFileBuffFull($file) 1 2161 if { [BadTRRead $file 1 $how] } { return } 2162 } 2163} 2164 2165## Fugawi export format 2166 2167proc Import_Fugawi {file how} { 2168 # this is a translation and adaptation of the Perl program "convert" under 2169 # copyright by Niki Hammler, http://www.nobaq.net 2170 # that converts exported FUGAWI data to DDD GPSman data 2171 global LFileEOF LFileVisible LFileLNo LFileIxs MESS 2172 2173 set date [Now] 2174 set dt "" ; set ixs "" ; set ns "" ; set chgns "" 2175 while { [set line [ReadFile $file]] != "" && ! $LFileEOF($file) } { 2176 if { [SlowOpAborted] } { return } 2177 set vs [split $line ","] 2178 if { [set l [llength $vs]] < 5 } { 2179 GMMessage "$MESS(nofieldsWP): $LFileLNo($file)" ; return 2180 } elseif { $l > 5 } { 2181 GMMessage "$MESS(excfieldsWP): $LFileLNo($file)" ; return 2182 } 2183 set name [lindex $vs 0] 2184 if { ! [CheckName Ignore $name] } { 2185 if { [set nname [AskForName $name]] == "" } { continue } 2186 set chgdname $name 2187 set name $nname 2188 } else { set chgdname "" } 2189 set lat [lindex $vs 2] ; set long [lindex $vs 3] 2190 if { ! [CheckLat GMMessage $lat DDD] || \ 2191 ! [CheckLong GMMessage $long DDD] } { continue } 2192 set latd [Coord DDD $lat S] ; set longd [Coord DDD $long W] 2193 set posn [list $latd $longd $lat $long] 2194 set comment [MakeComment [lindex $vs 1]] 2195 lappend dt [list $name $comment DDD $posn "WGS 84" $date] 2196 lappend ixs [IndexNamed WP $name] 2197 lappend ns $name 2198 lappend chgns $chgdname 2199 } 2200 if { $ns == "" } { return } 2201 switch $how { 2202 normal { 2203 foreach ix $ixs n $ns d $dt chgdname $chgns { 2204 set fd [FormData WP "Name Commt PFrmt Posn Datum Date" $d] 2205 if { $chgdname != "" } { 2206 set fd [AddOldNameToObs WP $fd $chgdname] 2207 } 2208 StoreWP $ix $n $fd $LFileVisible($file) 2209 } 2210 } 2211 inGR { 2212 set grixs $LFileIxs($file,WP) 2213 foreach ix $ixs n $ns d $dt { 2214 if { [lsearch -exact $grixs $ix] != -1 } { 2215 set fd [FormData WP "Name Commt PFrmt Posn Datum Date" $d] 2216 StoreWP $ix $n $fd $LFileVisible($file) 2217 } 2218 } 2219 } 2220 } 2221 return 2222} 2223 2224## file with NMEA 0183 log to be read as a track 2225 2226proc Import_NMEA {file args} { 2227 # read file with NMEA 0183 log as a TR 2228 # this uses procedures defined in files garmin_nmea.tcl and garmin.tcl 2229 global NMEARLTM MESS LFileOther LFileVisible 2230 2231 if { $NMEARLTM } { 2232 GMMessage $MESS(nmeainuse) 2233 return 2234 } 2235 OpenSerialLog 2236 Log "IN> Reading NMEA from file" 2237 GarminStartNMEA file $file 2238 set LFileOther($file) "" ; set errors 0 2239 while { ! [eof $file] } { 2240 if { [set line [gets $file]] != "" } { 2241 if { [SlowOpAborted] } { break } 2242 set buffer "" ; set xor 0 ; set error 0 2243 foreach char [split $line ""] { 2244 if { [binary scan $char "c" dec] != 1 } { 2245 incr error 2246 break 2247 } 2248 if { [set dec [expr ($dec+0x100)%0x100]] != 13 } { 2249 append buffer $char 2250 set xor [expr $xor ^ $dec] 2251 } 2252 } 2253 if { ! $error } { 2254 set error [ProcNMEALine $buffer $xor] 2255 } 2256 incr errors $error 2257 } 2258 } 2259 set NMEARLTM 0 2260 if { $errors } { 2261 GMMessage $MESS(badfile) 2262 } 2263 if { [set tps $LFileOther($file)] == "" } { 2264 GMMessage $MESS(voidTR) 2265 } else { 2266 set name [NewName TR] 2267 set fd [FormData TR "Name Datum TPoints" [list $name "WGS 84" $tps]] 2268 StoreTR -1 $name $fd $LFileVisible($file) 2269 } 2270 Log "IN> End of NMEA from file" 2271 return 2272} 2273 2274proc ImportNMEAData {data file} { 2275 # use data from NMEA sentences to form a TP 2276 # $data as described in proc UseRealTimeData (realtime.tcl) 2277 global LFileOther DateFormat 2278 2279 if { [llength $data] < 5 } { return } 2280 foreach "date rpos fix err alt" $data { break } 2281 if { $rpos == "_" } { return } 2282 if { $date == "_" } { 2283 set date [ConvGarminDate 0] 2284 } else { 2285 set date [eval LocalTimeAndUTC $date UTC] 2286 set date [list [eval FormatDate $DateFormat $date] \ 2287 [eval DateToSecs $date]] 2288 } 2289 set posn [eval FormatLatLong $rpos DMS] 2290 if { $alt == "_" } { 2291 set ns "latd longd latDMS longDMS date secs" 2292 set alt "" 2293 } else { 2294 set ns "latd longd latDMS longDMS date secs alt" 2295 } 2296 lappend LFileOther($file) [FormData TP $ns [concat $posn $date $alt]] 2297 return 2298} 2299 2300#### import from file in EasyGPS and GPX formats 2301#### VR contribution 2302 2303#### import from XML files in EasyGPS and GPX export format 2304 2305# XML global variable : context shared by the XML processing procedures 2306 2307proc XML_Init {} { 2308 global XML 2309 2310 # MF change: clear XML array 2311 catch { unset XML } 2312 #-- 2313 XML_Init_WP wpt 2314 foreach i {date lines rte_name trk_name searching_name tmpname tmpdesc} { 2315 set XML($i) "" 2316 } 2317 return 2318} 2319 2320proc XML_Init_WP {tag} { 2321 global XML DEFAULTSYMBOL 2322 2323 #- MD change: using also geocache 2324 foreach i {alt name time cmt long lat time type geocache} { 2325 set XML($i) "" 2326 } 2327 if { $tag != "trkpt" } { 2328 set XML(desc) "" 2329 } 2330 set XML(sym) $DEFAULTSYMBOL 2331 return 2332} 2333 2334# XML_ProcessItem_ 2335# Processing one XML item 2336# 2337# ii : index of line being processed 2338# item : string being processed 2339# token : value of XML tag 2340# tag : XML tag type 2341# return : current index of line 2342 2343proc XML_ProcessItem_KML {ii item token tag} { 2344 global XML 2345 2346 #<Placemark> 2347 # <name>Col Luisas</name> 2348 # <LookAt> 2349 # view point informations 2350 # </LookAt> 2351 # <styleUrl>#msn_ylw-pushpin01</styleUrl> 2352 # <Point> 2353 # <coordinates>7.069954449489316,44.7186167968765,0</coordinates> 2354 # </Point> 2355 #</Placemark> 2356 set XML(end) "" 2357 # MF contribution: using "--" 2358 switch -regexp -- $tag { 2359 ^Point { XML_Init_WP wpt } 2360 \/Point { 2361 set XML(name) $XML(tmpname) 2362 set XML(desc) $XML(tmpdesc) 2363 set XML(end) wpt } 2364 \/.* { } 2365 coordinates { 2366 regexp {([-0-9\.]+),([-0-9\.]+),([-0-9\.]+).*} $token x \ 2367 XML(long) XML(lat) $XML(alt)} 2368 name { set XML(tmpname) $token} 2369 description { set XML(tmpdesc) $token} 2370 .*CDATA { regexp {.*\[(.*)\]\]>} $item x XML(desc)} 2371 default { } 2372 } 2373 return $ii 2374} 2375 2376proc XML_ProcessItem_EasyGPS {ii item token tag} { 2377 global XML 2378 2379 set XML(end) "" 2380 # MF contribution: using "--" 2381 switch -regexp -- $tag { 2382 loc { } 2383 ^waypoint { XML_Init_WP wpt } 2384 \/waypoint { set XML(end) wpt } 2385 \/.* { } 2386 coord { regexp {lat="([-0-9\.]+)".*lon="([-0-9\.]+)".*$} $token x \ 2387 XML(lat) XML(long) } 2388 name { regexp {id="(.*)">} $token x XML(name) } 2389 .*CDATA { regexp {.*\[(.*)\]\]>} $item x XML(desc) } 2390 link { regsub {.*>} $token "" XML(cmt) } 2391 default { } 2392 } 2393 return $ii 2394} 2395 2396# XML_NormalizeSymbol 2397# Transforming a symbol name into the GPSMan internal name 2398# 2399# token : current name 2400# return : transformed name 2401 2402array set XML_Symbol_Translation { 2403 waypoint WP_dot 2404 fishing fish 2405 trailhead trail_head 2406 white_house house 2407 white_anchor anchor 2408 telephone phone 2409 campground camping 2410 hunting deer 2411 waypoint_dot WP_dot 2412} 2413 2414proc XML_NormalizeSymbol {token} { 2415 # normalizing the symbol's name 2416 global DEFAULTSYMBOL XML_Symbol_Translation MESS 2417 2418 regsub -all { } $token "_" symbol 2419 if { [BadSymbol $symbol ] } { 2420 set symbol [string tolower $symbol] 2421 if { [BadSymbol $symbol ] } { 2422 regsub {_area} $symbol "" symbol 2423 if { [BadSymbol $symbol ] } { 2424 if { [catch {set symbol $XML_Symbol_Translation($symbol)}] } { 2425 # MF change: using MESS 2426 GMMessage "$MESS(badSYMBOLcode): $symbol" 2427 set symbol $DEFAULTSYMBOL 2428 } 2429 } 2430 } 2431 } 2432 return $symbol 2433} 2434 2435proc XML_ProcessItem_GPX {ii item token tag} { 2436 global XML DateFormat MESS 2437 2438 set XML(end) "" 2439 if { [regexp {.*\/>} $token] } { 2440 set XML(end) $tag 2441 } 2442 # MF contribution: using "--" 2443 switch -regexp -- $tag { 2444 ^.xml { } 2445 gpx - bounds - author - email - url - src - keywords { } 2446 wissenbach: - topografix: { } 2447 ^wpt$ - ^rtept - ^trkpt { 2448 XML_Init_WP $tag 2449 # MF change: checking for errors 2450 if { ! [regexp {lat="([-0-9\.]+)".*lon="([-0-9\.eE]+)".*$} \ 2451 $token x XML(lat) XML(long)] } { 2452 GMMessage $MESS(badfile) 2453 set XML(end) error 2454 return 1000 2455 } 2456 } 2457 \/wpt$ { set XML(end) wpt } 2458 \/rtept$ { set XML(end) rtept } 2459 \/trkpt$ { set XML(end) trkpt } 2460 ^rte$ { set XML(searching_name) "rte_name" ; XML_Init_WP wpt } 2461 \/rte$ { set XML(end) rte } 2462 ^trk$ { set XML(searching_name) "trk_name" ; XML_Init_WP wpt } \/trk$ { set XML(end) trk } 2463 ^cmt { set XML(cmt) $token } 2464 ^sym { set XML(sym) [ XML_NormalizeSymbol $token ] } 2465 ^name { 2466 # MD change: only deal with names outside geocache 2467 if { $XML(geocache) == "" } { 2468 if { $token == "" } { 2469 # the name is in a CDATA tag 2470 set XML(name) [lindex $XML(lines) [expr $ii + 1]] 2471 regexp {.*CDATA\[(.*)\]\]\>} $XML(name) x XML(name) 2472 incr ii 1 2473 } else { 2474 # MF change: deleted changes in the name as it will be 2475 # checked/changed in proc XML_process 2476 set XML(name) $token 2477 } 2478 set XML($XML(searching_name)) $XML(name) 2479 set XML(searching_name) "" 2480 } 2481 } 2482 ^time { set XML(time) $token 2483 if { $XML(time) == "" } { 2484 set XML(time) $XML(date) 2485 } 2486 set datesecs [lindex [CheckConvDate $XML(time) ] 1] 2487 # MF contrib 2488 if { $datesecs == "" } { 2489 # undefined time 2490 set datesecs 0 2491 } 2492 #----- 2493 set dints [ DateIntsFromSecs $datesecs ] 2494 set dints1 [ eval LocalTimeAndUTC $dints "UTC" ] 2495 set time1 [eval FormatDate $DateFormat $dints1] 2496 set XML(time) $time1 2497 } 2498 ^desc - ^type { 2499 set XML($tag) $token 2500 # set XML($tag) [lindex $XML(lines) [expr $ii + 1]] 2501 # GMMessage "DESC - TYPE : $item - $token - $tag - $XML($tag)" 2502 # regexp {.*CDATA\[(.*)\]\]\>} $XML($tag) x XML($tag) 2503 # incr ii 1 2504 } 2505 ^ele { set XML(alt) $token} 2506 ^trkseg - ^number - CDATA { } 2507 \/geocache$ { #- MD change: adding support for geocache 2508 set XML(geocache) "" 2509 } 2510 ^geocache { #- MD change: adding support for geocache 2511 set XML(geocache) "in" 2512 } 2513 \/.* { } 2514 default { 2515 #GMMessage "Unknown element: $item - $token" 2516 } 2517 } 2518 return $ii 2519} 2520 2521# XML_Process 2522# Processing an XML file 2523 2524proc DecodeXMLChars { s } { 2525 regsub -all {>} $s {>} s 2526 regsub -all {<} $s {<} s 2527 regsub -all {"} $s {"} s 2528 regsub -all {'} $s {'} s 2529 regsub -all {&} $s {\&} s 2530 return $s 2531} 2532 2533proc XML_Process {fileType file what how date} { 2534 global MESS LFileVisible LFileIxs 2535 global XML 2536 2537 # dt : list of WP descriptions 2538 set dt {} 2539 # wpixs : list of WP indexes 2540 set wpixs {} 2541 # wpns : list of WP names 2542 set wpns {} 2543 # ltwps : list of lists of RT waypoints 2544 set ltwps {} 2545 # rtns : list of RT names 2546 set rtns {} 2547 # rtdr : list of RT descriptions 2548 set rtdt {} 2549 # rtixs : list of RT indexes 2550 set rtixs {} 2551 # lwps : list of RT waypoints names 2552 set lwps {} 2553 # ldt : list of RT waypoints descriptions 2554 set ldt {} 2555 # rtld : list of list of RT waypoints descriptions 2556 set rtld {} 2557 # trns : list of TR names 2558 set trns {} 2559 # trdesc : list of TR descriptions 2560 set trdesc {} 2561 # rtld : list of lists of TR points descriptions 2562 set ltrks {} 2563 # ltrkpts : list of TR points descriptions 2564 set ltrkpts {} 2565 ## MF contribution 2566 # ltrksgsts : list of TR segment starters 2567 set ltrksgsts {} 2568 # trsgsts : list of segment starters in a TR 2569 set trsgsts {} 2570 # trcount : counter of points in a TR 2571 set trcount 0 2572 ##-- 2573 # lchgdnames : list of changed names 2574 set lchgdnames {} 2575 2576 set llines [llength $XML(lines) ] 2577 for {set ii 1} {$ii<[expr $llines - 1]} {incr ii 1} { 2578 # MF contribution 2579 if { [SlowOpAborted] } { break } 2580 #-- 2581 set item [lindex $XML(lines) $ii] 2582 regsub {( |>).*} $item "" tag 2583 regsub {[^ >]*[ >]} $item "" token 2584 set cdata "" 2585 set raw_cdata [lindex $XML(lines) [expr $ii + 1]] 2586 regexp {.*CDATA\[(.*)\]\]\>} $raw_cdata x cdata 2587 if { $token == "" && $cdata != "" } { 2588 # GMMessage "NULL TOKEN : $item - $tag - $raw_cdata - $cdata - " 2589 set token $cdata 2590 set ii [ expr $ii + 1 ] 2591 } 2592 set ii [XML_ProcessItem_$fileType $ii $item $token $tag] 2593 # MF contribution: segment starters 2594 if { $tag == "trkseg" && $trcount > 0 && \ 2595 [lindex $trsgsts end] != $trcount } { 2596 lappend trsgsts $trcount 2597 } 2598 #-- 2599 switch $XML(end) { 2600 wpt - rtept { 2601 set chgdname "" 2602 set XML(name) [DecodeXMLChars $XML(name)] 2603 if { ! [CheckName Ignore $XML(name)] } { 2604 if { [set nname [AskForName $XML(name)]] == "" } { 2605 continue 2606 } 2607 # GMMessage $nname 2608 set chgdname $XML(name) 2609 set XML(name) $nname 2610 } 2611 if { ! [CheckLat GMMessage $XML(lat) DDD] || \ 2612 ! [CheckLong GMMessage $XML(long) DDD] } { continue } 2613 set latd [Coord DDD $XML(lat) S] 2614 set longd [Coord DDD $XML(long) W] 2615 set posn [list $latd $longd $XML(lat) $XML(long) ] 2616 set cmtS [ DecodeXMLChars $XML(cmt) ] 2617 set descS [ DecodeXMLChars $XML(desc) ] 2618 set d [list $XML(name) "$descS - $XML(type)" $cmtS \ 2619 DDD $posn "WGS 84" $XML(time) $XML(sym) $XML(alt)] 2620 if { $XML(end) == "wpt" } { 2621 lappend wpns $XML(name) 2622 lappend dt $d 2623 lappend wpixs [IndexNamed WP $XML(name) ] 2624 lappend lchgdnames $chgdname 2625 XML_Init_WP wpt 2626 } elseif { $XML(end) == "rtept" } { 2627 lappend lwps $XML(name) 2628 lappend ldt $d 2629 } 2630 } 2631 trkpt { 2632 # MF change: using FormatLatLong instead of CreatePos 2633 set p [FormatLatLong $XML(lat) $XML(long) DMS] 2634 # MF change: dealing with undefined time stamp 2635 if { $XML(time) == "" || \ 2636 [set datesecs [CheckConvDate $XML(time) ]] == "" } { 2637 set datesecs [ConvGarminDate 0] 2638 } 2639 lappend ltrkpts [FormData TP \ 2640 "latd longd latDMS longDMS date secs alt" \ 2641 [concat $p $datesecs $XML(alt) ]] 2642 # MF contribution: segment starters 2643 incr trcount 2644 #-- 2645 } 2646 trk { 2647 # MF change: using CheckString instead of CheckName 2648 set XML(trk_name) [DecodeXMLChars $XML(trk_name)] 2649 if { ! [CheckString Ignore $XML(trk_name)] } { 2650 set XML(trk_name) [NewName TR] 2651 } 2652 # MF change: preventing empty tracks to be added 2653 if { $ltrkpts != "" } { 2654 lappend trns $XML(trk_name) 2655 lappend trdesc [DecodeXMLChars $XML(desc)] 2656 lappend ltrks $ltrkpts 2657 # MF contribution: segment starters 2658 lappend ltrksgsts $trsgsts 2659 #-- 2660 set ltrkpts {} 2661 } 2662 # MF contribution: segment starters 2663 set trsgsts {} 2664 set trcount 0 2665 #-- 2666 } 2667 rte { 2668 # MF change: using CheckString instead of CheckName 2669 set XML(rte_name) [DecodeXMLChars $XML(rte_name)] 2670 if { ! [CheckString Ignore $XML(rte_name)] } { 2671 set XML(rte_name) [NewName RT] 2672 } 2673 set d [list [DecodeXMLChars $XML(desc)] \ 2674 [DecodeXMLChars $XML(cmt)]] 2675 # MF change: preventing empty routes to be added 2676 if { $lwps != "" } { 2677 lappend rtns $XML(rte_name) 2678 lappend rtdt $d 2679 lappend ltwps $lwps 2680 lappend rtixs [IndexNamed RT $XML(rte_name) ] 2681 lappend rtld $ldt 2682 set lwps {} 2683 } 2684 set ldt {} 2685 } 2686 default { } 2687 } 2688 set XML(end) 0 2689 } 2690 2691 if { $what == "Data" } { 2692 set lwhat {"WP" "TR" "RT"} 2693 } else { 2694 set lwhat $what 2695 } 2696 2697 ## MF contribution 2698 if { $wpixs == {} && $what == "WP" } { 2699 GMMessage $MESS(shpemptyfile) 2700 return 2701 } 2702 if { $ltrks == {} && $what == "TR" } { 2703 GMMessage $MESS(shpemptyfile) 2704 return 2705 } 2706 if { $ltwps == {} && $what == "RT" } { 2707 GMMessage $MESS(shpemptyfile) 2708 return 2709 } 2710 if { $wpixs == {} && $ltrks == {} && $ltwps == {} && $what == "Data" } { 2711 GMMessage $MESS(shpemptyfile) 2712 return 2713 } 2714 2715 foreach what $lwhat { 2716 # MF contribution: 2717 if { [SlowOpAborted] } { break } 2718 2719 if { $how == "inGR" } { 2720 set grixs $LFileIxs($file,$what) 2721 # GMMessage "Tracing Process_XML : inGR" 2722 } 2723 switch $what { 2724 WP { 2725 foreach ix $wpixs n $wpns d $dt chgdname $lchgdnames { 2726 # MF contribution: 2727 if { [SlowOpAborted] } { break } 2728 2729 if { $what != "inGR" || \ 2730 [lsearch -exact $grixs $ix] != -1 } { 2731 set fd [FormData WP "Name Obs Commt PFrmt Posn Datum \ 2732 Date Symbol Alt" $d] 2733 if { $chgdname != "" } { 2734 set fd [AddOldNameToObs WP $fd $chgdname] 2735 } 2736 StoreWP $ix $n $fd $LFileVisible($file) 2737 } 2738 } 2739 } 2740 RT { 2741 set wpsseen {} 2742 foreach ix $rtixs id $rtns d $rtdt wps $ltwps ldt $rtld { 2743 # MF contribution: 2744 if { [SlowOpAborted] } { break } 2745 2746 if { $what != "inGR" || \ 2747 [lsearch -exact $grixs $ix] != -1 } { 2748 # saving the WPs used in the route 2749 foreach n $wps d $ldt { 2750 # MF contribution: 2751 if { [SlowOpAborted] } { break } 2752 2753 if { [lsearch $wps $n ] != -1} { 2754 if { [ lsearch -exact $wpsseen $n ] == -1 } { 2755 set ix [IndexNamed WP $n] 2756 set fd [FormData WP \ 2757 "Name Obs Commt PFrmt Posn Datum Date Symbol Alt" $d] 2758 set nom [StoreWP $ix $n $fd \ 2759 $LFileVisible($file) ] 2760 lappend wpsseen $n 2761 } 2762 } 2763 } 2764 } 2765 set l [FormData RT "IdNumber Commt Obs WPoints" \ 2766 [list $id [lindex $d 0] [lindex $d 1] $wps]] 2767 StoreRT [IndexNamed RT $id] $id $l $wps \ 2768 $LFileVisible($file) 2769 } 2770 } 2771 TR { 2772 # includes MF contribution: segment starters 2773 foreach name $trns tps $ltrks desc $trdesc trsgsts $ltrksgsts { 2774 # MF contribution: 2775 if { [SlowOpAborted] } { break } 2776 #- 2777 set fd [FormData TR "Name Obs Datum TPoints SegStarts" \ 2778 [list $name $desc "WGS 84" $tps $trsgsts]] 2779 # MF change: must call IndexNamed 2780 StoreTR [IndexNamed TR $name] $name $fd $LFileVisible($file) 2781 } 2782 } 2783 } 2784 } 2785 return 2786} 2787 2788proc XML_ImportFile {fileType file what how} { 2789 global XML SYSENC File 2790 2791 XML_Init 2792 set XML(date) [Now] 2793 2794 # pre-processing the file 2795 2796 # MF change: new way of reading the file for dealing with encoding 2797 # - not using proc ReadFile as the file may need to be reopened, 2798 # what is done here with no need for changing $file 2799 # - it is still safe to use the globals LFile*($file) after this 2800 # try to find a XML declaration with an encoding tag 2801 foreach "lines encoding" [XMLDeclEncoding $file] {} 2802 if { $lines == "" } { return } 2803 if { $encoding == "" } { set encoding UTF-8 } 2804 if { [set encoding [TclEncodingName $encoding]] == "" } { return } 2805 if { $encoding != $SYSENC } { 2806 # must reopen file and configure the encoding 2807 set all_lines "" 2808 set efile [open $File($what) r] 2809 fconfigure $efile -encoding $encoding 2810 set reop 1 2811 } else { 2812 set efile $file 2813 set all_lines $lines 2814 set reop 0 2815 } 2816 # read all 2817 while { ! [eof $efile] } { 2818 gets $efile line 2819 if { [set line [string trim $line " \t"]] != "" } { 2820 append all_lines $line 2821 } 2822 } 2823 if { $reop } { close $efile } 2824 #----- 2825 2826 # one list item for each XML tag 2827 set XML(lines) [split $all_lines "<"] 2828 # MF contribution: 2829 if { [SlowOpAborted] } { return } 2830 2831 XML_Process $fileType $file $what $how $XML(date) 2832 return 2833} 2834 2835proc Import_GPX {file what how} { 2836 XML_ImportFile GPX $file $what $how 2837 return 2838} 2839 2840proc Import_KML {file what how} { 2841 XML_ImportFile KML $file $what $how 2842 return 2843} 2844 2845proc Import_EasyGPS {file how} { 2846 XML_ImportFile EasyGPS $file WP $how 2847 return 2848} 2849 2850### end of VR contribution 2851 2852proc XMLDeclEncoding {file} { 2853 # try to find the XML declaration and an encoding tag in it 2854 # return a pair with the concatenation of non-blank lines read in 2855 # and the encoding name (empty if not found) 2856 2857 set lines "" ; set state start 2858 while 1 { 2859 if { [eof $file] } { return [list $lines] } 2860 gets $file line 2861 if { [set line [string trim $line " \t"]] != "" } { 2862 append lines $line 2863 while 1 { 2864 switch $state { 2865 start { 2866 if { [regexp {<\?xml} $line] } { 2867 set state enc 2868 continue 2869 } 2870 if { [string first "<" $line] != -1 } { 2871 return [list $lines] 2872 } 2873 break 2874 } 2875 enc { 2876 if { [regexp \ 2877 {encoding[\t ]*=[\t ]*"([-_a-zA-Z0-9]+)"} \ 2878 $line x enc] } { 2879 return [list $lines $enc] 2880 } 2881 if { [regexp {encoding[\t ]*=[\t ]$} $line] } { 2882 set state encname 2883 break 2884 } 2885 if { [regexp {\?>} $line] } { 2886 return [list $lines] 2887 } 2888 break 2889 } 2890 encname { 2891 if { [regexp {^"([-_a-zA-Z0-9]+)"} $line x enc] } { 2892 return [list $lines $enc] 2893 } 2894 return [list $lines] 2895 } 2896 } 2897 2898 } 2899 } 2900 } 2901 # not used 2902 return 2903} 2904 2905 2906#### Map&Guide export format 2907 2908proc Import_MapGuide {file args} { 2909 global GFItemId GFItemCommt GFItemNB GFVersion 2910 2911 ImportMapGuide $file $GFItemId $GFItemCommt $GFItemNB $GFVersion 2912 return 2913} 2914 2915proc ImportMapGuide {file rtid rtcommt rtrmrk version} { 2916 # this is an adaptation of the script "mg2gpsman.tcl" 2917 # under copyright by Heiko Thede (Heiko.Thede _AT_ gmx.de) 2918 # that converts exported Map&Guide data to GPSman data 2919 # each file corresponds to one RT that will be split in more than one 2920 # if its length exceeds $MAXWPINROUTE 2921 # $rtid is the RT identifier/number given by user; it will be 2922 # replaced by an automatically generated one if empty 2923 # $rtcommt and $rtrmrk are the comment and remark given by the user 2924 # $version is in {03/04, 2002} 2925 global MAXWPINROUTE TXT MESS PositionFormat LFileVisible 2926 2927 # get rid of leading/trailing blanks 2928 foreach v "rtid rtcommt rtrmrk" { 2929 set $v [string trim [set $v]] 2930 } 2931 # generate RT id if none given 2932 if { $rtid == "" } { 2933 set rtid [NewName RT] ; set rtix -1 2934 } else { 2935 set rtix [IndexNamed RT $rtid] 2936 } 2937 set rts "" ; set wps "" 2938 2939 # WPs: prefix for names, position type 2940 # the first $rtid is used for all WPs even if the RT is split 2941 set prefix "$TXT(RT)$rtid" 2942 set nwps 0 2943 # positions of WPs, to avoid creating different WPs in the same place 2944 set coords "" ; set coordWPs "" 2945 # read lines 2946 while { ! [eof $file] } { 2947 gets $file line 2948 #select only relevant lines 2949 if { $line != "" } { 2950 if { [SlowOpAborted] } { return } 2951 set coordstart [string last "(" $line] 2952 set coordend [string last ")" $line] 2953 set coord [string range $line $coordstart $coordend] 2954 if { [set i [lsearch -exact $coords $coord]] != -1 } { 2955 # use WP in this position 2956 set wpt [lindex $coordWPs $i] 2957 } else { 2958 # create new WP and remember its position and name 2959 # generate name using $prefix if possible 2960 set fields [split $line "\t"] 2961 if { $version == 2002 } { 2962 if { ! [regexp {\((-?)([0-9]+),(-?)([0-9]+)\)} $coord x \ 2963 slong long slat lat] || \ 2964 [scan $long %2d%2d%d longd longm longs] != 3 || \ 2965 [scan $lat %2d%2d%d latd latm lats] != 3 } { 2966 # bad line: ignore WP 2967 continue 2968 } 2969 if { [string length $long] == 7 } { 2970 set longs [expr 0.1*$longs] 2971 set lats [expr 0.1*$lats] 2972 set wprmrk "[lindex $fields 0] [lrange $fields 2 3]" 2973 } else { 2974 set wprmrk "[lindex $fields 0] [lrange $fields 2 4]" 2975 } 2976 } elseif { ! [regexp {\((-?)([0-9]+),(-?)([0-9]+)\)} $coord x \ 2977 slong long slat lat] || \ 2978 ! ( [set x [string length $long]] == 7 && \ 2979 [scan $long %2d%2d%3d longd longm longs] == 3 || \ 2980 $x == 6 && \ 2981 [scan $long %1d%2d%3d longd longm longs] == 3 ) || \ 2982 ! ( [set x [string length $lat]] == 7 && \ 2983 [scan $lat %2d%2d%3d latd latm lats] == 3 || \ 2984 $x == 6 && \ 2985 [scan $lat %1d%2d%3d latd latm lats] == 3 ) } { 2986 # bad line: ignore WP 2987 continue 2988 } else { 2989 set longs [expr 0.1*$longs] 2990 set lats [expr 0.1*$lats] 2991 set wprmrk "[lindex $fields 0] [lrange $fields 2 3]" 2992 } 2993 set lat [expr $latd+($latm+$lats/60.0)/60.0] 2994 if { $slat == "-" } { 2995 set lat [expr -$lat] 2996 } 2997 set long [expr $longd+($longm+$longs/60.0)/60.0] 2998 if { $slong == "-" } { 2999 set long [expr -$long] 3000 } 3001 foreach "posn pfmt datum" \ 3002 [FormatPosition $lat $long "WGS 84" \ 3003 $PositionFormat "" DDD] { break } 3004 set wpt [NewName WP $prefix] 3005 lappend coords $coord ; lappend coordWPs $wpt 3006 set data [FormData WP "Name Obs PFrmt Posn Datum" \ 3007 [list $wpt $wprmrk $pfmt $posn $datum]] 3008 # displaying will be done along with RT if needs be 3009 StoreWP -1 $wpt $data 0 3010 } 3011 if { $nwps == $MAXWPINROUTE } { 3012 # save previous route and start new one 3013 lappend rts $rtid $wps 3014 # cannot use proc NewName here as previous RTs were not 3015 # stored yet 3016 set rtid "" 3017 set nwps 0 ; set wps "" 3018 } 3019 lappend wps $wpt 3020 incr nwps 3021 } 3022 } 3023 if { $wps == "" && $rts == "" } { 3024 GMMessage $MESS(voidRT) 3025 return 3026 } 3027 if { $nwps > 0 } { 3028 # save last route 3029 lappend rts $rtid $wps 3030 } 3031 # prepare comment and remark fields if any 3032 if { $rtcommt != "" && [CheckComment Ignore $rtcommt] } { 3033 set fields Commt 3034 set fvals [list $rtcommt] 3035 set rmrkix 1 3036 } else { 3037 set fields "" ; set fvals "" 3038 set rmrkix 0 3039 } 3040 if { $rtrmrk != "" } { 3041 lappend fields Obs 3042 lappend fvals $rtrmrk 3043 # prepare for adding new info to remark 3044 set norem 0 3045 set rtrmrk "${rtrmrk}\n" 3046 } else { set norem 1 } 3047 lappend fields IdNumber WPoints 3048 # store all routes 3049 foreach "rtid wps" $rts { 3050 if { [SlowOpAborted] } { return } 3051 if { $rtid == "" } { 3052 set rtid [NewName RT] ; set rtix -1 3053 } 3054 set fd [FormData RT $fields [linsert $fvals end $rtid $wps]] 3055 StoreRT $rtix $rtid $fd $wps $LFileVisible($file) 3056 3057 # add "Insert after $rtid" to remark for use in next route 3058 set rmk "${rtrmrk}$TXT(insa): $rtid" 3059 if { $norem } { 3060 # add remark field 3061 set fields [linsert $fields $rmrkix Obs] 3062 set fvals [linsert $fvals $rmrkix $rmk] 3063 set norem 0 3064 } else { 3065 # replace remark 3066 set fvals [lreplace $fvals $rmrkix $rmrkix $rmk] 3067 } 3068 } 3069 return 3070} 3071 3072## OziExplorer WP file format 3073# from the description in the implementation of exportation of the same 3074# format by Alessandro Palmas 3075 3076proc DateFromDelphiTime {dtime} { 3077 # build date from a Delphi time representation (days since 1899-12-30 0:0:0 3078 # as a float) 3079 # return empty on error (no message given) 3080 global YEAR0 3081 3082 # number of days from 1899-12-30 0:0:0 to 1988-01-01 0:0:0 = 32143 3083 if { [catch {set s88 [expr round(($dtime-32143)*86400)]}] || $s88 < 0 } { 3084 return "" 3085 } 3086 set y $YEAR0 ; set YEAR0 1988 3087 set d [DateFromSecs $s88] 3088 set YEAR0 $y 3089 return $d 3090} 3091 3092proc Import_Ozi {file what how} { 3093 # import data from $file in OziExplorer format 3094 # $how in {normal, inGR} 3095 # $what == WP 3096 # support is only for WP files and only the following fields are kept 3097 # Field 2: Name (short) 3098 # Field 3: lat DDD 3099 # Field 4: long DDD 3100 # Field 5: date, in Delphi format 3101 # Field 11: Comment 3102 # Field 15: Altitude, in feet. -777 is non valid 3103 global LFileVisible LFileLNo LFileIxs ALSCALEFOR MESS 3104 3105 # header 3106 # OziExplorer Waypoint File Version 1.1 3107 # DATUM 3108 # Reserved* 3109 # anything not starting by number 3110 if { ! [regexp {^OziExplorer Waypoint File} [ReadFile $file]] } { 3111 GMMessage $MESS(noheader) 3112 return 3113 } 3114 set datum [ReadFile $file] 3115 if { ! [catch {set d $OziDatum($datum)}] } { 3116 set datum $d 3117 } elseif { [DatumRefId $datum] == -1 } { 3118 GMMessage "$MESS(unkndatum): $datum" 3119 return 3120 } 3121 while { [set line [ReadFile $file]] != "" } { 3122 if { [regexp {^ *[0-9]+,} $line] } { break } 3123 } 3124 set dt "" ; set ixs "" ; set ns "" ; set chgns "" 3125 while 1 { 3126 if { [SlowOpAborted] } { return } 3127 if { [llength [set line [split $line ","]]] < 15 } { 3128 GMMessage "$MESS(nofieldsWP): $LFileLNo($file)" ; return 3129 } 3130 set name [lindex $line 1] 3131 if { ! [CheckName Ignore $name] } { 3132 if { [set nname [AskForName $name]] == "" } { continue } 3133 set chgdname $name 3134 set name $nname 3135 } else { set chgdname "" } 3136 set lat [lindex $line 2] ; set long [lindex $line 3] 3137 if { ! [CheckLat GMMessage $lat DDD] || \ 3138 ! [CheckLong GMMessage $long DDD] } { continue } 3139 set latd [Coord DDD $lat S] ; set longd [Coord DDD $long W] 3140 set posn [list $latd $longd $lat $long] 3141 set alt [lindex $line 14] 3142 if { $alt == -777 || \ 3143 [catch {set alt [expr $alt*$ALSCALEFOR(FT)]}] || \ 3144 [set alt [AltitudeList $alt]] == "nil" } { 3145 set alt "" 3146 } 3147 set comment [MakeComment [lindex $line 10]] 3148 set date [DateFromDelphiTime [lindex $line 4]] 3149 lappend dt [list $name $comment DDD $posn $datum $alt $date] 3150 lappend ixs [IndexNamed WP $name] 3151 lappend ns $name 3152 lappend chgns $chgdname 3153 if { [set line [ReadFile $file]] == "" } { break } 3154 } 3155 if { $ns == "" } { return } 3156 switch $how { 3157 normal { 3158 foreach ix $ixs n $ns d $dt chgdname $chgns { 3159 set fd [FormData WP "Name Commt PFrmt Posn Datum Alt Date" $d] 3160 if { $chgdname != "" } { 3161 set fd [AddOldNameToObs WP $fd $chgdname] 3162 } 3163 StoreWP $ix $n $fd $LFileVisible($file) 3164 } 3165 } 3166 inGR { 3167 set grixs $LFileIxs($file,WP) 3168 foreach ix $ixs n $ns d $dt { 3169 if { [lsearch -exact $grixs $ix] != -1 } { 3170 set fd [FormData WP \ 3171 "Name Commt PFrmt Posn Datum Alt Date" $d] 3172 StoreWP $ix $n $fd $LFileVisible($file) 3173 } 3174 } 3175 } 3176 } 3177 return 3178} 3179 3180## gd2 format 3181 3182proc Import_GD2 {file what how} { 3183 # import data from $file in gd2 format 3184 # $how in {normal, inGR} 3185 # $what in {WP, RT, TR}, but not TR if $how==inGR 3186 # gd2.c is a program by Randolph Bentson (bentson _AT_ grieg.seaslug.org) 3187 # distributed under GPL 3188 global LFileEOF LFileVisible LFileBuffFull LFileLNo LFileIxs MESS 3189 3190 set date [Now] 3191 set dt "" ; set ixs "" ; set ns "" ; set error 0 3192 switch $what { 3193 WP { set ns "" ; set chgns "" } 3194 RT { 3195 set rtid "" ; set dtwps "" ; set lwps "" ; set lchgwps "" 3196 set ldwps "" ; set rtwps start 3197 } 3198 TR { set tps "" } 3199 } 3200 while { [set line [ReadFile $file]] != "" && ! $LFileEOF($file) } { 3201 if { [SlowOpAborted] } { return } 3202 switch $what { 3203 WP { 3204 if { ! [regexp \ 3205 {^WPT ? (......) ([-0-9\.]+) ([-0-9\.]+) ([-0-9/:]+) (.*)$} \ 3206 $line x name lat long date commt] || \ 3207 [set dwp [ImportGD2WP $name $lat $long $date $commt]] == \ 3208 -1 } { 3209 set error 1 3210 } else { 3211 foreach "name chgdn d ix" $dwp {} 3212 lappend dt $d ; lappend ixs $ix ; lappend ns $name 3213 lappend chgns $chgdn 3214 } 3215 } 3216 RT { 3217 if { $rtwps == "" || \ 3218 ! [regexp {^RTE ([0-9]+) (.*)$} line rtid rtcommt] } { 3219 set error 1 3220 } else { 3221 set rtcommt [MakeComment [string trim $rtcommt]] 3222 set what RTWP 3223 set rtwps "" ; set dtwps "" ; set rtchgwps "" 3224 } 3225 } 3226 RTWP { 3227 if { ! [regexp \ 3228 {^ (......) ([-0-9\.]+) ([-0-9\.]+) ([-0-9:/]+) (.*)$} \ 3229 $line x name latd longd date commt] } { 3230 set what RT ; set LFileBuffFull($file) 1 3231 lappend dt [list $rtid $rtcommt $rtwps] 3232 lappend ixs [IndexNamed RT $rtid] 3233 lappend ns $rtid 3234 lappend lwps $rtwps ; lappend lchgwps $rtchgwps 3235 lappend ldwps $dtwps 3236 set rtid "" 3237 } elseif { [set dwp \ 3238 [ImportGD2WP $name $lat $long $date $commt]] == -1 } { 3239 set error 1 3240 } else { 3241 foreach "name chgdn d ix" $dwp {} 3242 lappend dtwps $d ; lappend rtwps $name 3243 lappend rtchgwps $chgdn 3244 } 3245 } 3246 TR { 3247 if { [regexp \ 3248 {^TRK ((S|N)[0-9]+ [0-9\.]+) ((W|E)[0-9]+ [0-9\.]+) ([-0-9:/]+) (0|1)$} \ 3249 $line x latdmm x longdmm x date new] } { 3250 set lat [Coord DMM $latdmm S] 3251 set long [Coord DMM $longdmm W] 3252 } elseif { ! [regexp \ 3253 {^TRK ([-0-9\.]+) ([-0-9\.]+) ([-0-9:/]+) (0|1)$} \ 3254 lat long date new] } { 3255 set error 1 3256 } 3257 if { ! $error } { 3258 if { ! [CheckLat GMMessage $lat DDD] || \ 3259 ! [CheckLong GMMessage $long DDD] || \ 3260 [set datesecs [CheckConvDate $date]] == "" } { 3261 set error 1 3262 } else { 3263 if { $new && $tps != "" } { 3264 lappend dt $tps 3265 set tps "" 3266 } 3267 set p [FormatLatLong $lat $long DMS] 3268 lappend tps [FormData TP \ 3269 "latd longd latDMS longDMS date secs" \ 3270 [concat $p $datesecs]] 3271 } 3272 } 3273 } 3274 } 3275 if { $error } { 3276 GMMessage "$MESS(loaderr) $LFileLNo($file)" 3277 return 3278 } 3279 } 3280 # terminate pending RT or TR if any 3281 switch $what { 3282 RT { 3283 if { $rtid != "" } { 3284 if { $rtwps == "" } { 3285 GMMessage "$MESS(loaderr) $LFileLNo($file)" 3286 return 3287 } 3288 lappend dt [list $rtid $rtcommt $rtwps] 3289 lappend ixs [IndexNamed RT $rtid] 3290 lappend ns $rtid 3291 lappend lwps $rtwps ; lappend lchgwps $rtchgwps 3292 lappend ldwps $dtwps 3293 } 3294 } 3295 TR { 3296 if { $tps != "" } { 3297 lappend dt $tps 3298 } 3299 } 3300 } 3301 switch $how { 3302 normal { 3303 switch $what { 3304 WP { 3305 foreach ix $ixs n $ns d $dt chgdname $chgns { 3306 if { [SlowOpAborted] } { return } 3307 set fd [FormData WP \ 3308 "Name Commt PFrmt Posn Datum Date" $d] 3309 if { $chgdname != "" } { 3310 set fd [AddOldNameToObs WP $fd $chgdname] 3311 } 3312 StoreWP $ix $n $fd $LFileVisible($file) 3313 } 3314 } 3315 RT { 3316 set wpsseen "" ; set wpsseenn "" 3317 foreach ix $ixs id $ns d $dt wps $ltwps dwps $ldwps \ 3318 chgns $lchgwps { 3319 set wpsn "" 3320 foreach nwp $wps dwp $dwps chgdname $chgns { 3321 if { [SlowOpAborted] } { return } 3322 if { [set k [lsearch -exact $wpsseen $nwp]] \ 3323 == -1 } { 3324 set ix [IndexNamed WP $nwp] 3325 set fd [FormData WP \ 3326 "Name Commt PFrmt Posn Datum Date" $dwp] 3327 if { $chgdname != "" } { 3328 set fd [AddOldNameToObs RT $fd $chgdname] 3329 } 3330 set nnwp [StoreWP $ix $nwp $fd 0] 3331 lappend wpsseen $nwp 3332 lappend wpsseenn $nnwp 3333 lappend wpsn $nnwp 3334 } else { 3335 lappend wpsn [lindex $wpsseenn $k] 3336 } 3337 } 3338 StoreRT $ix $id $d $wpsn $LFileVisible($file) 3339 } 3340 } 3341 TR { 3342 foreach tps $dt { 3343 if { [SlowOpAborted] } { return } 3344 set name [NewName TR] 3345 set fd [FormData TR "Name Datum TPoints" \ 3346 [list $name "WGS 84" $tps]] 3347 StoreTR -1 $name $fd $LFileVisible($file) 3348 } 3349 } 3350 } 3351 } 3352 inGR { 3353 set grixs $LFileIxs($file,$what) 3354 switch $what { 3355 WP { 3356 foreach ix $ixs n $ns d $dt chgdname $chgns { 3357 if { [SlowOpAborted] } { return } 3358 if { [lsearch -exact $grixs $ix] != -1 } { 3359 set fd [FormData WP \ 3360 "Name Commt PFrmt Posn Datum Date" $d] 3361 if { $chgdname != "" } { 3362 set fd [AddOldNameToObs WP $fd $chgdname] 3363 } 3364 StoreWP $ix $n $fd $LFileVisible($file) 3365 } 3366 } 3367 } 3368 RT { 3369 set wpsseen "" ; set wpsseenn "" 3370 foreach ix $ixs id $ns d $dt wps $ltwps dwps $ldwps \ 3371 chgns $lchgwps { 3372 if { [lsearch -exact $grixs $ix] != -1 } { 3373 set wpsn "" 3374 foreach nwp $wps dwp $dwps chgdname $chgns { 3375 if { [SlowOpAborted] } { return } 3376 if { [set k [lsearch -exact $wpsseen $nwp] \ 3377 == -1 } { 3378 set ix [IndexNamed WP $nwp] 3379 set fd [FormData WP \ 3380 "Name Commt PFrmt Posn Datum Date" \ 3381 $dwp] 3382 if { $chgdname != "" } { 3383 set fd \ 3384 [AddOldNameToObs RT $fd $chgdname] 3385 } 3386 set nnwp [StoreWP $ix $nwp $fd 0] 3387 lappend wpsseen $nwp 3388 lappend wpsseenn $nnwp 3389 lappend wpsn $nnwp 3390 } else { 3391 lappend wpsn [lindex $wpsseenn $k] 3392 } 3393 } 3394 StoreRT $ix $id $d $wpsn $LFileVisible($file) 3395 } 3396 } 3397 } 3398 } 3399 } 3400 } 3401 return 3402} 3403 3404proc ImportGD2WP {name lat long date commt} { 3405 # prepare WP data when importing from file in gd2 format 3406 # return 0 on error, otherwise list with name, old name (or ""), 3407 # list with WP data (see below) and index 3408 3409 set name [string trim $name] 3410 if { ! [CheckLat GMMessage $lat DDD] || \ 3411 ! [CheckLong GMMessage $long DDD] } { return -1 } 3412 if { ! [CheckName Ignore $name] } { 3413 if { [set nname [AskForName $name]] == "" } { return -1 } 3414 set chgdname $name 3415 set name $nname 3416 } else { set chgdname "" } 3417 set posn [FormatLatLong $lat $long DDD] 3418 set commt [MakeComment [string trim $commt]] 3419 return [list $name $chgdname [list $name $commt DDD $posn "WGS 84" $date] \ 3420 [IndexNamed WP $name]] 3421} 3422 3423## FAI IGC data file format 3424 3425 # number 999 for undefined taken to be "WGS 84" 3426array set IGCDatum { 3427 0 0 1 1 2 2 3 3 4 4 5 5 3428 6 6 7 8 8 11 9 12 10 9 11 10 3429 12 7 13 13 14 14 15 15 16 16 17 17 3430 18 19 19 18 20 20 21 22 22 23 23 24 3431 24 25 25 26 26 27 27 28 28 29 29 30 3432 30 31 31 32 32 75 33 33 34 34 35 35 3433 36 36 37 37 38 38 39 39 40 40 41 41 3434 42 42 43 43 44 44 45 45 46 46 47 47 3435 48 48 49 49 50 50 51 51 52 52 53 53 3436 54 54 55 55 56 56 57 60 58 58 59 57 3437 60 59 61 61 62 62 63 63 64 64 65 65 3438 66 66 67 70 68 67 69 68 70 69 71 71 3439 72 72 73 73 74 74 75 76 76 77 77 80 3440 78 81 80 83 81 84 82 85 83 78 85 91 3441 86 79 87 86 88 87 89 88 90 89 91 92 3442 92 93 93 94 94 95 95 96 97 97 98 98 3443 99 99 100 100 101 101 102 21 103 gm145 999 100 3444} 3445 3446array set IGCTrans { 3447 A A 3448 B {I J recdata} 3449 C {I J recdata} 3450 D {I J recdata} 3451 E {I J recdata} 3452 F {I J recdata} 3453 G recdata 3454 H {A H} 3455 I H 3456 J I 3457 K {I J recdata} 3458 L {I J recdata} 3459} 3460 3461array set IGCRE { 3462B {^B([0-9]{6})([0-9]{7})([NS])([0-9]{8})([EW])([AV])([-0-9]{5})([-0-9]{5})(.*)$} 3463 E {^E([0-9]{6})([A-Z0-9]{3})(.*)$} 3464 H {^H[FOP]([A-Z0-9]{3})([^:]*)(.*)$} 3465} 3466 3467proc Import_IGC {file args} { 3468 # import data from $file in FAI IGC format and return one TR 3469 global IGCTrans IGCRE IGCDatum TimeOffset DateFormat LFileEOF \ 3470 LFileVisible LFileLNo MESS YEAR0 GFOption File TXT 3471 3472 set name [file rootname [file tail $File(TR)]] 3473 if { $GFOption == "gps" } { 3474 set baroalt 0 3475 set rmrk "" 3476 } else { 3477 set baroalt 1 3478 set rmrk "$TXT(alt): baro" 3479 } 3480 set toffsetold $TimeOffset 3481 set TimeOffset 0 3482 set ymd [list $YEAR0 1 day 1] 3483 set datum "WGS 84" 3484 set oldpos "" ; set oldkeep 1 3485 set tps "" ; set sgsts "" ; set ntp 0 3486 set error 0 3487 set state A 3488 while { [set line [ReadFile $file]] != "" && ! $LFileEOF($file) } { 3489 if { [SlowOpAborted] } { return } 3490 set rtype [string index $line 0] 3491 if { [catch {set sts $IGCTrans($rtype)}] || \ 3492 [lsearch -exact $sts $state] == -1 } { 3493 incr error ; break 3494 } 3495 switch $rtype { 3496 A - L { 3497 } 3498 H { 3499 set state H 3500 if { ! [regexp $IGCRE(H) $line x stype s1 s2] } { 3501 incr error ; break 3502 } 3503 switch -- $stype { 3504 DTE { 3505 # date DDMMYY 3506 # proc ScanDate could be used here... 3507 # YY taken as 2000+YY if YY<70, and 1900+YY otherwise 3508 if { $s2 != "" || \ 3509 [scan $s1 %02d%02d%02d d m y] != 3 } { 3510 incr error ; break 3511 } 3512 if { $y < 70 } { 3513 incr y 2000 3514 } else { incr y 1900 } 3515 set ymd [list $y $m $d] 3516 set prevtime -1 3517 } 3518 TZN { 3519 # time zone offset in hours from UTC 3520 if { $s2 == "" } { 3521 set s $s1 3522 } else { set s [string range $s2 1 end] } 3523 if { [scan $s %0d t] != 1 } { 3524 incr error ; break 3525 } 3526 set TimeOffset $t 3527 } 3528 DTM { 3529 # datum 3530 if { [scan $s1 %03d n] != 1 || \ 3531 [catch {set gmno $IGCDatum($n)}] } { 3532 incr error ; break 3533 } 3534 set datum [DatumWithRefId $gmno] 3535 } 3536 } 3537 } 3538 I { 3539 set state I 3540 } 3541 J { 3542 set state J 3543 } 3544 C - D { 3545 set state recdata 3546 } 3547 F { 3548 set state recdata 3549 } 3550 B { 3551 set state recdata 3552 if { ! [regexp $IGCRE(B) $line x time lat hlat long hlong \ 3553 tfix palt alt exts] } { 3554 incr error ; break 3555 } 3556 # time stamp 3557 scan $time %02d%02d%02d hh mm ss 3558 if { $prevtime > $time } { 3559 set ymd [eval NextDay $ymd] 3560 } 3561 set prevtime $time 3562 set date [eval LocalTimeAndUTC $ymd $hh $mm $ss UTC] 3563 set date [list [eval FormatDate $DateFormat $date] \ 3564 [eval DateToSecs $date]] 3565 # position 3566 scan $lat %02d%0d latd m 3567 set latd [expr $latd+$m/60000.0] 3568 if { $hlat == "S" } { set latd [expr -$latd] } 3569 scan $long %03d%0d longd m 3570 set longd [expr $longd+$m/60000.0] 3571 if { $hlong == "W" } { set longd [expr -$longd] } 3572 # with bad quality fixes test whether position is 3573 # acceptable: not 0 0 as first value, and no 3574 # differences in lat and in long greater than 5 degrees 3575 set keep 1 3576 if { $tfix == "V" } { 3577 if { $oldpos == "" } { 3578 if { $latd == 0 && $longd == 0 } { set keep 0 } 3579 } elseif { abs([lindex $oldpos 0]-$latd) > 5 || \ 3580 abs([lindex $oldpos 1]-$longd) > 5 } { 3581 set keep 0 3582 } 3583 } 3584 if { $keep } { 3585 if { $oldkeep == 0 && $ntp != 0 } { 3586 lappend sgsts $ntp 3587 } 3588 set oldpos [list $latd $longd] 3589 set posn [FormatLatLong $latd $longd DMS] 3590 # altitude 3591 if { $baroalt } { 3592 set alt $palt ; set tfix "A" 3593 } 3594 scan $alt %0d alt 3595 if { $tfix == "V" || $alt == 0 } { 3596 set ns "latd longd latDMS longDMS date secs" 3597 set alt "" 3598 } else { 3599 set ns "latd longd latDMS longDMS date secs alt" 3600 } 3601 lappend tps [FormData TP $ns [concat $posn $date $alt]] 3602 incr ntp 3603 } 3604 set oldkeep $keep 3605 } 3606 E { 3607 set state recdata 3608 if { ! [regexp $IGCRE(E) $line x time stype s] } { 3609 incr error ; break 3610 } 3611 switch -- $stype { 3612 CGD { 3613 # change datum 3614 if { [scan $s %03d n] != 1 || \ 3615 [catch {set gmno $IGCDatum($n)}] } { 3616 incr error ; break 3617 } 3618 set datum [DatumWithRefId $gmno] 3619 } 3620 } 3621 } 3622 K { 3623 set state recdata 3624 } 3625 G { 3626 break 3627 } 3628 } 3629 } 3630 set TimeOffset $toffsetold 3631 if { $error } { 3632 GMMessage "$MESS(loaderr) $LFileLNo($file)" 3633 return 3634 } 3635 if { $tps == "" } { 3636 GMMessage $MESS(voidTR) 3637 return 3638 } 3639 if { [IndexNamed TR $name] != -1 } { 3640 set rmrk [AddToNB $rmrk "$TXT(file): $name"] 3641 set name [NewName TR] 3642 } 3643 set fd [FormData TR "Name Obs Datum TPoints SegStarts" \ 3644 [list $name $rmrk $datum $tps $sgsts]] 3645 StoreTR -1 $name $fd $LFileVisible($file) 3646 return 3647} 3648 3649## Kismet .network files with location information 3650# http://www.kismetwireless.net 3651 3652proc Import_Kismet {file how} { 3653 # import WPs from Kismet .network files with location information 3654 # $how in {normal, inGR}: keep all data, not used 3655 # some options can be changed by editing the file config.tcl and 3656 # redefining the KISMETOPT array elements 3657 # there is a single parameter for controlling the creation of a group 3658 # with the imported WPs for each type of network 3659 global KISMETOPT GFOption PositionFormat LFileVisible MESS TXT 3660 3661 set crgroups $GFOption 3662 foreach v "prename namenumber types defsymbol esymbols" { 3663 set $v $KISMETOPT($v) 3664 } 3665 set netno 0 3666 while { ! [eof $file] } { 3667 if { [SlowOpAborted] } { return } 3668 gets $file line ; set line [string trim $line] 3669 if { $line == "" || ! [regexp {^Network} $line] } { continue } 3670 # network 3671 incr netno 3672 set obs "" ; set name "" 3673 if { ! [regexp {: "(.+)" B?SSID} $line x name] || \ 3674 ! [CheckName Ignore $name] || [IndexNamed WP $name] != -1 } { 3675 if { $name != "" } { set obs "ssid = $name" } 3676 set k 0 3677 while { $k < 100 } { 3678 set name "$prename$namenumber" 3679 incr namenumber 3680 if { [CheckName Ignore $name] && \ 3681 [IndexNamed WP $name] == -1 } { 3682 break 3683 } 3684 incr k 3685 } 3686 if { $k >= 100 } { set name [NewName WP] } 3687 } 3688 if { [set line [NextLine 1 $file]] == "" } { return } 3689 # type? 3690 if { ! [regexp {^Type.*: ([-a-zA-Z0-9]+)$} $line x type] } { 3691 # "Bad Type line after $netno Network" 3692 GMMessage $MESS(badfile) 3693 continue 3694 } 3695 if { [lsearch -exact $types $type] == -1 } { continue } 3696 if { [set line [NextLine 3 $file]] == "" } { return } 3697 # channel? 3698 if { ! [regexp {^Channel.*:} $line] } { 3699 # "No Channel line found after $netno Network" 3700 GMMessage $MESS(badfile) 3701 continue 3702 } 3703 set obs [AddToNB $obs $line] 3704 if { [set line [NextLine 1 $file]] == "" } { return } 3705 # encryption? 3706 if { ! [regexp {^Encryption.*: "(.+)"$} $line x encr] } { 3707 # "No Encryption line found after $netno Network" 3708 GMMessage $MESS(badfile) 3709 continue 3710 } 3711 set symbol $defsymbol 3712 foreach p $esymbols { 3713 if { [lindex $p 0] == $type } { 3714 foreach "epatt s" [lindex $p 1] { 3715 if { [string match -nocase $epatt $encr] } { 3716 set symbol $s 3717 break 3718 } 3719 } 3720 break 3721 } 3722 } 3723 if { [set line [NextLine 10 $file]] == "" } { return } 3724 # min loc 3725 if { ! [regexp {^Min Loc.*: Lat ([-.0-9]+) Lon ([-.0-9]+) } $line \ 3726 x lat1 long1] } { 3727 # "No/bad Min Loc line after $netno Network" 3728 GMMessage $MESS(badfile) 3729 continue 3730 } 3731 if { [set line [NextLine 1 $file]] == "" } { return } 3732 # max loc 3733 if { ! [regexp {^Max Loc.*: Lat ([-.0-9]+) Lon ([-.0-9]+) } $line \ 3734 x lat2 long2] } { 3735 # "No/bad Max Loc line after $netno Network" 3736 GMMessage $MESS(badfile) 3737 continue 3738 } 3739 if { [catch {set lat [expr ($lat1+$lat2)*0.5]}] || \ 3740 [catch {set long [expr ($long1+$long2)*0.5]}] } { 3741 # "Error averaging coordinates after $netno Network" 3742 GMMessage $MESS(badfile) 3743 continue 3744 } 3745 foreach "posn pfmt datum" \ 3746 [FormatPosition $lat $long "WGS 84" $PositionFormat "" DDD] { 3747 break 3748 } 3749 set data [FormData WP "Name Obs PFrmt Posn Datum Symbol" \ 3750 [list $name $obs $pfmt $posn $datum $symbol]] 3751 StoreWP -1 $name $data $LFileVisible($file) 3752 lappend names $name 3753 lappend namesof($type) $name 3754 } 3755 if { $crgroups } { 3756 # create a group with WPs for each type of network 3757 foreach t [array names namesof] { 3758 set name ${prename}_$t 3759 if { [IndexNamed GR $name] != -1 } { set name [NewName GR] } 3760 set obs "Kismet type: $t" 3761 set els [list [list WP [lsort -dictionary $namesof($t)]]] 3762 set data [FormData GR "Name Obs Conts" [list $name $obs $els]] 3763 # displaying has already been taken care of 3764 StoreGR -1 $name $data 0 3765 } 3766 } 3767 return 3768} 3769 3770## BGA format: British Glider Association DOS turnpoints files available at 3771# http://www.spsys.demon.co.uk/turningpoints.htm 3772# 3773# PS contribution: most of the BGA support is 3774# based on code from the dos2gpsman script by 3775# Paul Scorer (p.scorer _AT_ leedsmet.ac.uk), distributed under GPL 3776 3777proc Import_BGA {file how} { 3778 # import WPs from file in BGA (DOS) format 3779 # $how in {normal, inGR}: keep all data, not used 3780 global BGAfeature BGAfindblty BGAairact PositionFormat LFileVisible \ 3781 ALSCALEFOR MESS TXT 3782 3783 set nwps 0 ; set ascale $ALSCALEFOR(FT) 3784 set date [Now] 3785 # Process each record 3786 while 1 { 3787 if { [SlowOpAborted] } { return } 3788 # get one record 3789 if {[gets $file fullname] > 0 && \ 3790 [gets $file trigraph] > 0 && \ 3791 [gets $file bganum] > 0 && \ 3792 [gets $file findability] > 0 && \ 3793 [gets $file exactpoint] > 0 && \ 3794 [gets $file description] > 0 && \ 3795 [gets $file distance] > 0 && \ 3796 [gets $file direction] > 0 && \ 3797 [gets $file feature] > 0 && \ 3798 [gets $file OSMap] > 0 && \ 3799 [gets $file Easting_Northing] > 0 && \ 3800 [gets $file Lat_Long] > 0 && \ 3801 [gets $file altitude] > 0 && \ 3802 [gets $file trigraph1] > 0 && \ 3803 [gets $file junk] == 0} { 3804 # Blank line - Record Separator 3805 if {[string equal $trigraph $trigraph1] } { 3806 # Simple consistency check: 3807 # Trigraph at last line should match that at second line 3808 scan $Lat_Long "%d%lf%s%d%lf%s" \ 3809 degLat minLat NS degLong minLong EW 3810 3811 # Matches "Findability"? 3812 if { $BGAfindblty != "" } { 3813 if { [BGACheckFind $BGAfindblty $findability] == 0 } { 3814 continue 3815 } 3816 } 3817 3818 # Matches "Feature"? 3819 if { $BGAfeature != "" } { 3820 if { [BGACheckPlace $BGAfeature $feature] == 0 } { 3821 continue 3822 } 3823 } 3824 3825 # Matches "Air Activity"? 3826 if { $BGAairact != "" } { 3827 if { [BGACheckActivity $BGAairact $findability] == 0 } { 3828 continue 3829 } 3830 } 3831 3832 set latd [expr $degLat+$minLat/60.0] 3833 if { $NS == "S" || $NS == "s" } { set latd [expr -$latd] } 3834 set longd [expr $degLong+$minLong/60.0] 3835 if { $EW == "W" || $NS == "w" } { set longd [expr -$longd] } 3836 foreach "posn pfmt datum" \ 3837 [FormatPosition $latd $longd {WGS 84} \ 3838 $PositionFormat "" DDD] { break } 3839 set altitude [expr $ascale*$altitude] 3840 set obs \ 3841 "$fullname\n$exactpoint\n$description\n$feature\n$findability" 3842 if { ! [CheckName Ignore $trigraph] } { 3843 if { [set nname [AskForName $trigraph]] == "" } { 3844 continue 3845 } 3846 set obs "$obs\n$TXT(oname): $trigraph" 3847 set trigraph $nname 3848 } 3849 set data [FormData WP "Name Obs PFrmt Posn Datum Alt Date" \ 3850 [list $trigraph $obs $pfmt $posn \ 3851 $datum $altitude $date]] 3852 StoreWP [IndexNamed WP $trigraph] $trigraph $data \ 3853 $LFileVisible($file) 3854 incr nwps 3855 } else { 3856 GMMessage $MESS(badfile) 3857 return 3858 } 3859 } else { 3860 break 3861 } 3862 } 3863 if { $nwps == 0 } { 3864 GMMessage $MESS(nosuchitems) 3865 } 3866 return 3867} 3868 3869proc BGACheckPlace {placeList feature} { 3870 # check if current record is associated with $feature 3871 3872 foreach place $placeList { 3873 if { [string equal -nocase $feature $place] } { 3874 return 1 3875 } 3876 } 3877 return 0 3878} 3879 3880proc BGACheckFind {findList findability} { 3881 # check if "findability" (A B C D or G) matches that given as parameter 3882 3883 foreach category $findList { 3884 if { [string equal -nocase -length 1 $category $findability] } { 3885 return 1 3886 } 3887 } 3888 return 0 3889} 3890 3891proc BGACheckActivity {activityList findability} { 3892 # check if category of "Air Activity" matches that given as parameter 3893 3894 foreach category $activityList { 3895 set len [string length $category] 3896 incr len 3897 if { [string length $findability] == $len } { 3898 return 1 3899 } 3900 } 3901 return 0 3902} 3903 3904## SimpleText format 3905# based on the Garmin Simple Text Output protocol and the following rules 3906# - discard lines with position status different from g or G 3907# - a single discarded line (not at the beginning of the file) is 3908# taken as a segment start marker 3909# - two or more discarded lines in sequence (not at the beginning of 3910# the file) are taken as starting a new TR 3911 3912proc Import_SimpleText {file how} { 3913 # load TRs from file in SimpleText format 3914 # $how in {normal, inGR}: keep all data, not used 3915 global LFileLNo LFileEOF LFileVisible MESS DateFormat 3916 3917 set tps "" ; set tpn 0 ; set es 0 ; set sgsts "" 3918 while { 1 } { 3919 set m [ReadFile $file] 3920 if { $LFileEOF($file) } { break } 3921 if { [string first @ $m] != 0 || \ 3922 [string length $m] != 55 } { 3923 GMMessage "$MESS(badTR) $LFileLNo($file)" 3924 return 3925 } 3926 set bad 0 3927 foreach fd "x yr mon day hr min sec hlt ltd ltm hlg lgd lgm st x alt" \ 3928 wd "1 2 2 2 2 2 2 1 2 5 1 3 5 1 3 6" \ 3929 type "x d d d d d d c d d c d d c x pd" { 3930 if { $type == "pd" } { 3931 if { [set u [string first _ $m]] != -1 && $u < $wd } { 3932 set $fd "" ; set type x 3933 } else { set type d } 3934 } 3935 switch $type { 3936 d { 3937 set type "0${wd}d" 3938 if { [scan $m "%$type" $fd] == 0 } { 3939 incr bad 3940 break 3941 } 3942 } 3943 c { set $fd [string range $m 0 [expr $wd-1]] } 3944 } 3945 set m [string replace $m 0 [expr $wd-1]] 3946 } 3947 if { $bad || ( $st != "G" && $st != "g" ) || $ltm < 0 || $lgm < 0 } { 3948 incr es 3949 continue 3950 } 3951 # date 3952 if { $yr > 86 } { 3953 # possible year 3000 bug! 3954 incr yr 1900 3955 } else { incr yr 2000 } 3956 if { ! [CheckDateEls $yr $mon $day $hr $min $sec] } { 3957 GMMessage "$MESS(baddate) $LFileLNo($file)" 3958 incr es 3959 continue 3960 } 3961 set l [list $yr $mon $day $hr $min $sec] 3962 set dtscs [list [eval FormatDate $DateFormat $l] [eval DateToSecs $l]] 3963 # position 3964 set lat "$hlt$ltd [expr $ltm/1000.0]" 3965 set long "$hlg$lgd [expr $lgm/1000.0]" 3966 if { ! [CheckLat GMMessage $lat DMM] || \ 3967 ! [CheckLong GMMessage $long DMM] } { 3968 incr es 3969 continue 3970 } 3971 set lat [Coord DMM $lat S] 3972 set long [Coord DMM $long W] 3973 set p [FormatLatLong $lat $long DMS] 3974 # altitude 3975 if { $st != "G" } { set alt "" } 3976 3977 if { $es > 1 } { 3978 if { $tps != "" } { 3979 set name [NewName TR] 3980 set fd [FormData TR "Name Datum TPoints SegStarts" \ 3981 [list $name "WGS 84" $tps $sgsts]] 3982 StoreTR -1 $name $fd $LFileVisible($file) 3983 } 3984 set tps "" ; set tpn 0 ; set sgsts "" 3985 } elseif { $es && $tps != "" } { 3986 # segment starter 3987 lappend sgsts $tpn 3988 } 3989 set es 0 3990 lappend tps [FormData TP "latd longd latDMS longDMS date secs alt" \ 3991 [concat $p $dtscs $alt]] 3992 incr tpn 3993 } 3994 if { $tps != "" } { 3995 set name [NewName TR] 3996 set fd [FormData TR "Name Datum TPoints SegStarts" \ 3997 [list $name "WGS 84" $tps $sgsts]] 3998 StoreTR -1 $name $fd $LFileVisible($file) 3999 } 4000 return 4001} 4002 4003## MapEdit Polish format 4004# tentative support from sample files as no description was found in the Web 4005 4006proc Import_MapEdit {file args} { 4007 # import points of interest as waypoints from MapEdit Polish format 4008 # coordinates are taken as the average coordinates given for each POI 4009 # repeated names are taken to be of different points and are renamed 4010 # to each repeated name it is first appended the number of repeats 4011 # and then the user is prompted for a replacement or given the option 4012 # of the name to be automatically generated 4013 global LFileEOF LFileVisible MESS PositionFormat 4014 4015 set names {} 4016 while 1 { 4017 if { [SlowOpAborted] } { break } 4018 while { ! $LFileEOF($file) && [ReadFile $file] != {[POI]} } { 4019 continue 4020 } 4021 set lines {} ; set line {} 4022 while { ! $LFileEOF($file) && \ 4023 [set line [ReadFile $file]] != {[END]} } { 4024 lappend lines $line 4025 } 4026 if { $line == {} } { break } 4027 if { $line != {[END]} } { 4028 GMMessage $MESS(badfile) 4029 break 4030 } 4031 set n 0 ; set lat 0 ; set long 0 ; set name {} 4032 foreach line $lines { 4033 if { [regexp {^Label=(.*)$} $line x name] } { continue } 4034 if { [regexp {^Data[0-9]+=[(]([-.0-9]+),([-.0-9]+)[)]$} $line \ 4035 x la lo] } { 4036 set lat [expr $lat+$la] ; set long [expr $long+$lo] 4037 incr n 4038 } 4039 } 4040 if { $n == 0 } { 4041 GMMessage $MESS(badfile) 4042 continue 4043 } 4044 set lat [expr 1.0*$lat/$n] ; set long [expr 1.0*$long/$n] 4045 if { ! [CheckLat GMMessage $lat DDD] || \ 4046 ! [CheckLong GMMessage $long DDD] } { break } 4047 if { [catch {set nrep $rep($name)}] } { set nrep 0 } 4048 if { $nrep != 0 || ! [CheckName Ignore $name] } { 4049 set rep($name) [incr nrep] 4050 set chgdname $name 4051 if { $nrep != 0 } { append name $nrep } 4052 if { "[set name [AskForName $name]]" == "" } { 4053 continue 4054 } 4055 } else { 4056 set chgdname "" ; set rep($name) 1 4057 } 4058 foreach "posn pfmt datum" \ 4059 [FormatPosition $lat $long "WGS 84" \ 4060 $PositionFormat "" DDD] { break } 4061 set data [FormData WP "Name PFrmt Posn Datum" \ 4062 [list $name $pfmt $posn $datum]] 4063 if { $chgdname != "" } { 4064 set data [AddOldNameToObs WP $data $chgdname] 4065 } 4066 StoreWP [IndexNamed WP $name] $name $data $LFileVisible($file) 4067 } 4068 return 4069} 4070 4071## GTrackMaker format 4072 4073 # datums having the same definition in GTM and GPSMan (possibly under 4074 # different names 4075array set GTMEquivDatum { 4076 1 "Adindan; B Faso" 2 "Adindan; Cameroon" 4077 3 "Adindan; Ethiopia" 4 "Adindan; Mali" 4078 5 "Adindan; Ethiopia+Sudan" 6 "Adindan; Senegal" 4079 7 "Adindan; Sudan" 8 "Afgooye" 4080 9 "Ain el Abd 1970; Bahrain" 10 "Ain el Abd 1970; Saudi Arabia" 4081 11 "American Samoa 1962" 13 "Antigua Island Astro 1943" 4082 14 "Arc 1950; Botswana" 15 "Arc 1950; Burundi" 4083 16 "Arc 1950; Lesotho" 17 "Arc 1950; Malawi" 4084 18 "Arc 1950" 19 "Arc 1950; Swaziland" 4085 20 "Arc 1950; Zaire" 21 "Arc 1950; Zambia" 4086 22 "Arc 1950; Zimbabwe" 23 "Arc 1960; Kenya+Tanzania" 4087 24 "Arc 1960; Kenya" 25 "Arc 1960; Tanzania" 4088 26 "Ascension Island `58" 27 "Astro Beacon \"E\"" 4089 28 "Astro DOS 71/4" 29 "Astro Tern Island (FRIG)" 4090 30 "Astronomic Stn `52" 34 "Bellevue (IGN)" 4091 35 "Bermuda 1957" 36 "Bissau" 4092 37 "Bogota Observatory" 38 "Bukit Rimpah" 4093 39 "Camp Area Astro" 40 "Campo Inchauspe" 4094 41 "Canton Astro 1966" 42 "Cape" 4095 43 "Cape Canaveral" 44 "Carthage" 4096 45 "Chatham 1971" 46 "Chua Astro" 4097 47 "Corrego Alegre" 48 "Dabola" 4098 49 "Deception Island" 50 "Djakarta (Batavia)" 4099 51 "DOS 1968" 52 "Easter Island 1967" 4100 53 "Estonia Coord System 1937" 54 "European 1950; Cyprus" 4101 55 "European 1950; Egypt" 56 "European 1950; England Channel" 4102 57 "European 1950; England Channel" 4103 58 "European 1950; Finland+Norway" 4104 59 "European 1950; Greece" 60 "European 1950; Iran" 4105 61 "European 1950; Italy (Sardinia)" 4106 62 "European 1950; Italy (Sicily)" 4107 63 "European 1950; Malta" 64 "European 1950" 4108 65 "European 1950; NW Europe" 4109 66 "European 1950; Middle East" 4110 67 "European 1950; Portugal+Spain" 4111 68 "European 1950; Tunisia" 4112 69 "European 1979" 70 "Fort Thomas 1955" 4113 71 "Gan 1970" 72 "Geodetic Datum `49" 4114 73 "Graciosa Base SW 1948" 74 "Guam 1963" 4115 75 "Gunung Segara" 76 "GUX 1 Astro" 4116 77 "Herat North" 78 "Hermannskogel" 4117 79 "Hjorsey 1955" 80 "Hong Kong 1963" 4118 81 "Hu-Tzu-Shan" 82 "Indian (Bangladesh)" 4119 83 "Indian (India, Nepal)" 84 "Indian (Pakistan)" 4120 85 "Indian 1954" 86 "Indian 1960; Vietnam (Con Son)" 4121 87 "Indian 1960; Vietnam (N16)" 4122 88 "Indian 1975" 89 "Indonesian 1974" 4123 90 "Ireland 1965" 91 "ISTS 061 Astro 1968" 4124 92 "ISTS 073 Astro `69" 93 "Johnston Island 1961" 4125 94 "Kandawala" 95 "Kerguelen Island" 4126 96 "Kertau 1948" 97 "Kusaie Astro 1951" 4127 98 "NAD83; Canada" 99 "L.C. 5 Astro" 4128 100 "Leigon" 101 "Liberia 1964" 4129 102 "Luzon Philippines" 103 "Luzon Mindanao" 4130 104 "M'Poraloko" 105 "Mahe 1971" 4131 106 "Massawa" 107 "Merchich" 4132 108 "Midway Astro 1961" 109 "Minna; Cameroon" 4133 110 "Minna" 111 "Montserrat Island Astro 1958" 4134 112 "Nahrwn Masirah Ilnd" 113 "Nahrwn Saudi Arbia" 4135 114 "Nahrwn United Arab" 115 "Naparima BWI" 4136 116 "NAD27 Alaska" 117 "NAD27 Alaska; Aleutian East" 4137 118 "NAD27 Alaska; Aleutian West" 4138 119 "NAD27 Bahamas" 120 "NAD27 San Salvador" 4139 121 "NAD27 Canada West" 122 "NAD27 Canada Middle" 4140 123 "NAD27 Canada East" 124 "NAD27 Canada North" 4141 125 "NAD27 Canada Yukon" 126 "NAD27 Canal Zone" 4142 127 "NAD27 Cuba" 128 "NAD27 Greenland" 4143 129 "NAD27 Caribbean" 130 "NAD27 Central" 4144 131 "NAD27 Canada" 132 "NAD27 CONUS" 4145 133 "NAD27 CONUS East" 134 "NAD27 CONUS West" 4146 135 "NAD27 Mexico" 136 "NAD83; Canada" 4147 137 "NAD83; Aleutian Ids" 138 "NAD83; Canada" 4148 139 "NAD83; Canada" 140 "NAD83; Hawaii" 4149 141 "NAD83; Canada" 142 "North Sahara 1959" 4150 143 "Observatorio 1966" 144 "Old Egyptian" 4151 145 "Old Hawaiian; Hawaii" 146 "Old Hawaiian; Kauai" 4152 147 "Old Hawaiian; Maui" 148 "Old Hawaiian" 4153 149 "Old Hawaiian; Oahu" 150 "Oman" 4154 151 "Ord Srvy Grt Britn; England" 4155 152 "Ord Srvy Grt Britn; England+Wales" 4156 153 "Ord Srvy Grt Britn" 154 "Ord Srvy Grt Britn; Scotland+Shetlands" 4157 155 "Ord Srvy Grt Britn; Wales" 4158 156 "Pico De Las Nieves" 157 "Pitcairn Astro 1967" 4159 158 "Point 58" 159 "Pointe Noire 1948" 4160 160 "Porto Santo 1936" 161 "Prov So Amrican 56; Bolivia" 4161 162 "Prov So Amrican 56; Chile North" 4162 163 "Prov So Amrican 56; Chile South" 4163 164 "Prov So Amrican 56; Colombia" 4164 165 "Prov So Amrican 56; Ecuador" 4165 166 "Prov So Amrican 56; Guyana" 4166 167 "Prov So Amrican `56" 168 "Prov So Amrican 56; Peru" 4167 169 "Prov So Amrican 56; Venezuela" 4168 170 "Prov So Chilean `63" 171 "Puerto Rico" 4169 172 "Pulkovo 1942" 173 "Qatar National" 4170 174 "Qornoq" 175 "Reunion" 4171 176 "Rome 1940" 177 "S-42 (Pulkovo 1942); Hungary" 4172 178 "S-42 (Pulkovo 1942); Poland" 4173 179 "S-42 (Pulkovo 1942); Czechoslavakia" 4174 180 "S-42 (Pulkovo 1942); Latvia" 4175 181 "S-42 (Pulkovo 1942); Kazakhstan" 4176 182 "S-42 (Pulkovo 1942); Albania" 4177 183 "S-42 (Pulkovo 1942); Hungary" 4178 184 "S-JTSK" 185 "Santo (DOS)" 4179 186 "Sao Braz" 187 "Sapper Hill 1943" 4180 188 "Schwarzeck" 189 "Selvagem Grande 1938" 4181 190 "Sierra Leone" 191 "South American 69; Argentina" 4182 192 "South American 69; Bolivia" 4183 193 "South American 69; Brazil" 4184 194 "South American 69; Chile" 4185 195 "South American 69; Colombia" 4186 196 "South American 69; Ecuador" 4187 197 "South American 69; Baltra" 4188 198 "South American 69; Guyana" 4189 199 "South American `69" 200 "South American 69; Paraguay" 4190 201 "South American 69; Peru" 4191 202 "South American 69; Trinidad+Tobago" 4192 203 "South American 69; Venezuela" 4193 204 "South Asia" 205 "Tananarive Observatory 1925" 4194 206 "Timbalai 1948" 207 "Tokyo" 4195 208 "Tokyo" 209 "Tokyo; Okinawa" 4196 210 "Tokyo; South Korea" 211 "Tristan Astro 1968" 4197 212 "Viti Levu 1916" 213 "Voirol 1960" 4198 214 "Wake Island Astro 195" 217 "WGS 84" 4199 218 "Yacare" 219 "Zanderij" 4200 220 "Rijks Driehoeksmeting" 221 "NTF (NTF ellipsoid)" 4201 224 "CH-1903" 226 "European 1950; Belgium" 4202 227 "Israeli" 228 "Rome 1940; Luxembourg" 4203 229 "Finland Hayford" 230 "Dionisos" 4204 231 "South American 69; Brazil/IBGE" 4205 232 "Potsdam" 233 "Datum 73" 4206 234 "WGS 72" 4207} 4208 4209 # datums having a different definition in GTM; GPSMan definition will be used 4210array set GTMEquivDatum { 4211 12 "Anna 1 Astro 1965" 31 "Australian Geod `66" 4212 32 "Australian Geod `84" 33 "Ayabelle Lighthouse" 4213 215 "Wake-Eniwetok 1960" 216 "WGS 1972" 4214 222 "Potsdam" 223 "RT 90" 4215 225 "Austrian (MGI)" 4216} 4217 4218set GTMVersions 211 4219 4220array set GTMTypes { 4221 header {int charray=10 byte unused=1 byte unused=1 unused=1 byte unused=1 4222 long long long long long long long float float float float long 4223 long unused=4 unused=4 bool bool unused=2 unused=2 unused=2 4224 unused=2 unused=2 unused=2 bool unused=2 varstring varstring 4225 varstring varstring} 4226 datum {unused=2 unused=8 unused=8 unused=8 unused=8 int double double int 4227 int int} 4228 image {varstring varstring float float float float long float float byte 4229 byte} 4230 wp {double double charray=10 varstring int byte long int float unused=2} 4231 wpstyle {long varstring byte long long float byte bool long byte byte byte 4232 byte} 4233 tr {double double long byte float} 4234 trstyle {varstring byte long float byte int} 4235 rt {double double charray=10 varstring varstring int byte byte long int 4236 float int} 4237 icon {varstring byte long} 4238 layer {int varstring long byte byte byte int} 4239} 4240 4241array set GTMDescr { 4242 header {version code maplinewidth unused fontsize unused unused iconcolour 4243 unused gridcolour bgcolour nwpstyles usercolour nwps ntrs nrts 4244 maxlong minlong maxlat minlat nimgs ntrnames unused unused 4245 rectcoords truegrid unused unused unused unused unused unused 4246 hasmap unused gridfontname unused unused unused} 4247 datum {unused unused unused unused unused ndatum a f dx dy dz} 4248 image {NOTUSED} 4249 wp {lat long name commt symbol style secs txtangle alt unused} 4250 wpstyle {NOTUSED} 4251 tr {lat long secs new alt} 4252 trstyle {NOTUSED} 4253 rt {lat long wpname wpcommt rtname wpsymbol wpstyle new secs unused unused 4254 unused} 4255 icon {NOTUSED} 4256 layer {NOTUSED} 4257} 4258 4259array set GTMConstr { 4260 header { 4261 { if { [lsearch $GTMVersions $version] == -1 } { set m badGTMvers } } 4262 { if { $code != "TrackMaker" } { set m badGTMfile } } 4263 { if { $nwpstyles < 0 || $nwps < 0 || $ntrs < 0 || $nrts < 0 || $nimgs < 0 || $ntrnames < 0 } { 4264 set m badGTMcounts } } 4265 { if { $nwps == 0 } { set nwpstyles 0 } } 4266 { if { $ntrs == 0 } { set ntrnames 0 } } 4267 } 4268 datum { 4269 { if { [catch {set eqdatum $GTMEquivDatum($ndatum)}] } { 4270 set m badGTMdatum } } 4271 } 4272 wp { 4273 { if { $lat < -90 || $lat > 90 } { set m badGTMlat } } 4274 { if { $long < -180 || $long > 180 } { set m badGTMlong } } 4275 } 4276 tr { 4277 { if { $lat < -90 || $lat > 90 } { set m badGTMlat } } 4278 { if { $long < -180 || $long > 180 } { set m badGTMlong } } 4279 } 4280 rt { 4281 { if { $lat < -90 || $lat > 90 } { set m badGTMlat } } 4282 { if { $long < -180 || $long > 180 } { set m badGTMlong } } 4283 } 4284} 4285 4286# 4287# file structure: 4288# header, datum, image info, wps, wpstyles, trs, trstyles, rts, layers, 4289# symbols, symbol images, map images 4290# 4291# header has counts of 4292# wpstyles, wps, tps, rtwps, imgs, trnames 4293 4294proc Import_GTrackMaker {file args} { 4295 # names in GTMDescr lists are implicitly used here as local variables! 4296 global GTMVersions GTMTypes GTMDescr GTMConstr GTMEquivDatum ReadBinError \ 4297 PositionFormat DateFormat LFileVisible LFileSlowId YEAR0 MESS 4298 4299 fconfigure $file -translation binary 4300 set ReadBinError 0 4301 set m "" ; set one 1 4302 set wpl "" ; set trl "" ; set trtps "" ; set rtl "" ; set rtwps "" 4303 foreach b "header datum image wp wpstyle tr trstyle rt" \ 4304 c "one one nimgs nwps nwpstyles ntrs ntrnames nrts" { 4305 for { set i 0 } { $i < [set $c] } { incr i } { 4306 if { [SlowOpAborted] } { return } 4307 set vals [ReadBinData $file $GTMTypes($b)] 4308 if { $ReadBinError } { 4309 SlowOpFinish $LFileSlowId($file) $MESS(errorGTMread) 4310 return 4311 } 4312 if { $GTMDescr($b) != "NOTUSED" } { 4313 # assign values to vars 4314 foreach $GTMDescr($b) $vals {} 4315 # check constraints that may assign values to other variables 4316 foreach ct $GTMConstr($b) { 4317 eval $ct 4318 if { $m != "" } { 4319 SlowOpFinish $LFileSlowId($file) $MESS($m) 4320 return 4321 } 4322 } 4323 # use values in variables corresponding to fields and in 4324 # variables assigned during evaluation of constraints 4325 switch $b { 4326 wp { 4327 # unused: symbol, style, txtangle 4328 lappend wpl \ 4329 [list $lat $long $name $commt $secs $alt] 4330 } 4331 tr { 4332 if { $new } { 4333 if { $trtps != "" } { lappend trl $trtps } 4334 set trtps "" 4335 } 4336 lappend trtps [list $lat $long $secs $alt] 4337 } 4338 rt { 4339 # unused: wpsymbol, wpstyle 4340 # assume route name only defined when $new 4341 if { $new } { 4342 if { $rtwps != "" } { 4343 lappend rtl [list $oldroute $rtwps] 4344 } 4345 set rtwps "" 4346 set oldroute $rtname 4347 } 4348 lappend rtwps \ 4349 [list $lat $long $wpname $wpcommt $secs] 4350 } 4351 } 4352 } 4353 } 4354 } 4355 if { $trtps != "" } { lappend trl $trtps } 4356 if { $rtwps != "" } { 4357 lappend rtl [list $oldroute $rtwps] 4358 } 4359 set oldYEAR0 $YEAR0 ; set YEAR0 1990 4360 foreach wpd $wpl { 4361 if { [SlowOpAborted] } { return } 4362 foreach "lat long name commt secs alt" $wpd {} 4363 # GTM comment saved in remark, along with name if already in use 4364 if { [set ix [IndexNamed WP $name]] != -1 } { 4365 set commt "$name\n$commt" 4366 } 4367 foreach "posn pfmt datum" \ 4368 [FormatPosition $lat $long $eqdatum $PositionFormat "" DDD] { 4369 break 4370 } 4371 set date [DateFromSecs $secs] 4372 set data [FormData WP "Name Obs PFrmt Posn Datum Date Alt" \ 4373 [list $name $commt $pfmt $posn $datum $date $alt]] 4374 StoreWP $ix $name $data $LFileVisible($file) 4375 } 4376 foreach trtps $trl { 4377 if { $trtps != "" } { 4378 set tps "" 4379 foreach tpd $trtps { 4380 if { [SlowOpAborted] } { return } 4381 foreach "lat long secs alt" $tpd {} 4382 set dints [DateIntsFromSecs $secs] 4383 set date [eval FormatDate $DateFormat $dints] 4384 set secs [eval DateToSecsFrom $dints $oldYEAR0] 4385 set d [FormatLatLong $lat $long DMS] 4386 lappend d $date $secs $alt 4387 lappend tps \ 4388 [FormData TP "latd longd latDMS longDMS date secs alt" $d] 4389 } 4390 set name [NewName TR] 4391 set data [FormData TR "Name Datum TPoints" \ 4392 [list $name $eqdatum $tps]] 4393 StoreTR -1 $name $data $LFileVisible($file) 4394 } 4395 } 4396 foreach rtd $rtl { 4397 foreach "rtname rtwps" $rtd {} 4398 if { $rtwps != "" } { 4399 set wpns "" 4400 foreach wpd $rtwps { 4401 if { [SlowOpAborted] } { return } 4402 # GTM wp comment saved in remark, along with name if in use 4403 foreach "lat long wpname commt secs" $wpd {} 4404 if { [set ix [IndexNamed WP $wpname]] != -1 } { 4405 set commt "$wpname\n$commt" 4406 } 4407 foreach "posn pfmt datum" \ 4408 [FormatPosition $lat $long $eqdatum \ 4409 $PositionFormat "" DDD] { break } 4410 set date [DateFromSecs $secs] 4411 set data [FormData WP "Name Obs PFrmt Posn Datum Date" \ 4412 [list $name $commt $pfmt $posn $datum $date]] 4413 set wpname [StoreWP $ix $wpname $data 0] 4414 lappend wpns $wpname 4415 } 4416 # GTM route name will be saved in remark 4417 set id [NewName RT] 4418 set data [FormData RT "IdNumber Obs WPoints" \ 4419 [list $id $commt $wps]] 4420 StoreRT -1 $id $data $wps $LFileVisible($file) 4421 } 4422 } 4423 set YEAR0 $oldYEAR0 4424 return 4425} 4426 4427## Shapefile format 4428 4429proc ImportShapefileFrom {fname what} { 4430 # import from Shapefile format items of type $what 4431 # if $fname=="" ask user to give a file name 4432 # $what in {WP, RT, TR, LN} 4433 # return 1 on error, 0 on success 4434 global SHPPFormt SHPZone SHPDatum SHPAUnit SHPDUnit SHPDim GFPFormt \ 4435 GFDUnit GFAUnit GFVisible NNUMPFORMATS MESS TXT INVTXT \ 4436 MAXWPINROUTE ZGRID POSTYPE ALSCALEFOR SHOWFILEITEMS 4437 4438 set GFVisible $SHOWFILEITEMS 4439 if { $fname == "" } { 4440 set ok 0 4441 set GFPFormt $TXT($SHPPFormt) 4442 set GFDUnit $TXT($SHPDUnit) ; set GFAUnit $TXT($SHPAUnit) 4443 set vs "SHPDim GFPFormt SHPZone SHPDatum GFDUnit GFAUnit GFVisible" 4444 set pfas [list $NNUMPFORMATS =GFPFormt TXT] 4445 set us [list $TXT(M) $TXT(FT)] 4446 set ds [list +$TXT(dimens)/[list 3 2] \ 4447 !$TXT(optPositionFormat)=FillPFormtMenu/$pfas \ 4448 =$TXT(zone) !$TXT(datum)=FillDatumMenu/ \ 4449 +$TXT(distunit)/$us +$TXT(altunit)/$us @$TXT(mapitems)] 4450 while { [set fn [GMGetFileName $TXT(importfrm) $what r $vs $ds]] \ 4451 != ".." } { 4452 set SHPPFormt $INVTXT($GFPFormt) 4453 if { [BadDatumFor $SHPPFormt $SHPDatum GMMessage] != 0 } { 4454 continue 4455 } 4456 set SHPDUnit $INVTXT($GFDUnit) 4457 set SHPAUnit $INVTXT($GFAUnit) 4458 if { $ZGRID($SHPPFormt) } { 4459 set SHPZone [string trim $SHPZone] 4460 while { ! [CheckZone GMMessage $SHPZone $SHPPFormt] } { 4461 set SHPZone "" 4462 if { ! [GMChooseParams $TXT(zone) SHPZone \ 4463 [list =$TXT(zone)]] } { 4464 set SHPZone "" 4465 return 1 4466 } 4467 set SHPZone [string trim $SHPZone] 4468 } 4469 } else { set SHPZone "" } 4470 set basename [file rootname $fn] 4471 switch -- [set ext [file extension $fn]] { 4472 .shp - .shx - .dbf - "" { 4473 set ok 1 ; break 4474 } 4475 default { 4476 if { [GMConfirm [format $MESS(shpext) $ext]] } { 4477 set ok 1 ; break 4478 } 4479 } 4480 } 4481 } 4482 if { ! $ok } { return 1 } 4483 } else { 4484 # SHPDim SHPPFormt, SHPZone, SHPDatum, SHPDUnit and SHPAUnit assumed to 4485 # have been defined 4486 set basename [file rootname $fname] 4487 } 4488 if { [set fsid [GSHPOpenInputFiles $basename]] < 1 } { 4489 switch -- $fsid { 4490 0 { set m shpcntopen } 4491 -1 { set m shpemptyfile } 4492 -2 { set m shpwrongfile } 4493 -3 { set m shpoutmem } 4494 } 4495 GMMessage $MESS($m) 4496 GSHPCloseFiles $fsid 4497 return 1 4498 } 4499 if { [set info [GSHPInfoFrom $fsid]] == 0 } { BUG bad channel ; return 1 } 4500 foreach "fwh fno fdim fix dbfn dbfnps" $info {} 4501 if { $fno < 1 } { 4502 GMMessage $MESS(shpemptyfile) ; GSHPCloseFiles $fsid 4503 return 1 4504 } 4505 if { $fwh == "UNKNOWN" } { 4506 if { $what == "WP" } { 4507 GMMessage $MESS(shpwrongfile) ; GSHPCloseFiles $fsid 4508 return 1 4509 } 4510 } elseif { $fwh != $what && \ 4511 ( $what != "LN" || $fwh != "TR" ) } { 4512 GMMessage $MESS(shpwrongfile) ; GSHPCloseFiles $fsid 4513 return 1 4514 } 4515 if { $fwh == "UNKNOWN" || $fwh == "WP" } { 4516 set dbfs "" 4517 foreach "n x" $dbfnps { 4518 lappend dbfs $n 4519 } 4520 } 4521 if { $fdim < $SHPDim && ! [GMConfirm $MESS(shplessdim)] } { 4522 GSHPCloseFiles $fsid 4523 return 1 4524 } 4525 if { $SHPPFormt == "UTM/UPS" } { 4526 regexp {^([0-5]?[0-9]|60)([A-HJ-NP-Z])$} $SHPZone x ze zn 4527 set zone [list $ze $zn] 4528 } else { set zone $SHPZone } 4529 if { $POSTYPE($SHPPFormt) == "latlong" } { 4530 set iscdist 1 4531 } else { set iscdist [expr 1.0/$ALSCALEFOR($SHPDUnit)] } 4532 set iscalt [expr 1.0/$ALSCALEFOR($SHPAUnit)] 4533 set zz [expr $fdim+$SHPDim == 6] ; set alt "" 4534 set tpfs "latd longd latDMS longDMS" 4535 set lpfs "posn" 4536 set slowid [SlowOpWindow $TXT(import)] 4537 switch $fwh { 4538 WP { 4539 set wpfs "Name Commt Obs PFrmt Posn Datum Date" 4540 if { $zz } { 4541 set ixdbfs 6 4542 } else { set ixdbfs 5 } 4543 while { $fno } { 4544 if { [SlowOpAborted] } { break } 4545 incr fno -1 4546 if { [set fd [GSHPGetObj $fsid $fno]] != "" } { 4547 if { $fd == 0 || $fd == -1 } { 4548 BUG bad GSHPGetObj ; return 4549 } 4550 if { [set name [lindex $fd 0]] == "" } { 4551 set name [NewName WP] 4552 set chgdname "" 4553 } elseif { ! [CheckName Ignore $name] } { 4554 if { [set nname [AskForName $name]] == "" } { 4555 continue 4556 } 4557 set chgdname $name ; set name $nname 4558 } else { set chgdname "" } 4559 set commt [MakeComment [lindex $fd 1]] 4560 if { ! [CheckDate Ignore [set date [lindex $fd 2]]] } { 4561 set date "" 4562 } 4563 set x [expr $iscdist*[lindex $fd 3]] 4564 set y [expr $iscdist*[lindex $fd 4]] 4565 if { [set posn [ConvertPos $SHPPFormt $zone $x $y \ 4566 $SHPDatum $SHPPFormt]] == -1 } { 4567 continue 4568 } 4569 if { $chgdname != "" } { 4570 set obs "$TXT(oname): $chgdname" 4571 set sep "\n" 4572 } else { set obs "" ; set sep "" } 4573 foreach n $dbfs v [lindex $fd $ixdbfs] { 4574 if { $v != "" } { 4575 set obs "${obs}${sep}$n: $v" 4576 set sep "\n" 4577 } 4578 } 4579 set pd [list $name $commt $obs $SHPPFormt $posn $SHPDatum \ 4580 $date] 4581 if { $zz && ! ([BadAltitude [set alt [lindex $fd 5]]] || \ 4582 $alt < -1e35) } { 4583 set alt [expr $iscalt*$alt] 4584 set fs [linsert $wpfs end Alt] 4585 lappend pd $alt 4586 } else { set fs $wpfs } 4587 set pd [FormData WP $fs $pd] 4588 StoreWP [IndexNamed WP $name] $name $pd $GFVisible 4589 } 4590 } 4591 } 4592 RT { 4593 set wpfs "Name PFrmt Posn Datum" 4594 while { $fno } { 4595 if { [SlowOpAborted] } { break } 4596 incr fno -1 4597 if { [set fd [GSHPGetObj $fsid $fno]] != "" } { 4598 if { $fd == 0 || $fd == -1 } { 4599 BUG bad GSHPGetObj ; return 1 4600 } 4601 if { [set name [lindex $fd 0]] == "" || \ 4602 ! [CheckNumber Ignore $name] } { 4603 set name [NewName RT] 4604 } 4605 set commt [MakeComment [lindex $fd 1]] 4606 if { [set np [lindex $fd 2]] < 1 } { 4607 GMMessage $MESS(voidRT) ; continue 4608 } 4609 set wpns "" 4610 while { $np } { 4611 if { [SlowOpAborted] } { break } 4612 incr np -1 4613 if { [set pd [GSHPReadNextPoint $fsid]] == -2 } { 4614 break 4615 } 4616 if { $pd == 0 || $pd == -1 } { 4617 BUG bad GSHPReadNextPoint ; return 1 4618 } 4619 set x [expr $iscdist*[lindex $pd 0]] 4620 set y [expr $iscdist*[lindex $pd 1]] 4621 if { [set posn [ConvertPos $SHPPFormt $zone $x $y \ 4622 $SHPDatum $SHPPFormt]] == -1 } { 4623 continue 4624 } 4625 lappend wpns [set wpn [NewName WP]] 4626 set wdt [list $wpn $SHPPFormt $posn $SHPDatum] 4627 if { $zz && ! ([BadAltitude [set alt [lindex $pd 2]]] \ 4628 || $alt < -1e35) } { 4629 set alt [expr $iscalt*$alt] 4630 set fs [linsert $wpfs end Alt] 4631 lappend wdt $alt 4632 } else { set fs $wpfs } 4633 StoreWP -1 $wpn [FormData WP $fs $wdt] 0 4634 } 4635 if { [set np [llength $wpns]] == 0 } { 4636 GMMessage $MESS(voidRT) ; continue 4637 } 4638 if { $np > $MAXWPINROUTE } { 4639 GMMessage [format $MESS(toomuchWPs) $MAXWPINROUTE] 4640 } 4641 set fd [FormData RT "IdNumber Commt WPoints" \ 4642 [list $name $commt $wpns]] 4643 StoreRT [IndexNamed RT $name] $name $fd $wpns $GFVisible 4644 } 4645 } 4646 } 4647 TR { 4648 while { $fno } { 4649 if { [SlowOpAborted] } { break } 4650 incr fno -1 4651 if { [set fd [GSHPGetObj $fsid $fno]] != "" } { 4652 switch -- $fd { 4653 -1 - -2 { BUG bad GSHPGetObj ; return 1 } 4654 -3 { SlowOpFinish $slowid $MESS(shpoutmem) ; return 1 } 4655 } 4656 if { ! [CheckString Ignore [set name [lindex $fd 0]]] } { 4657 set name [NewName $what] 4658 } 4659 set commt [MakeComment [lindex $fd 1]] 4660 if { [set np [lindex $fd 2]] < 1 } { 4661 GMMessage $MESS(voidTR) ; continue 4662 } 4663 set ssts [lindex $fd 3] 4664 set pts "" 4665 if { $what == "TR" } { 4666 while { $np } { 4667 if { [SlowOpAborted] } { break } 4668 incr np -1 4669 if { [set pd [GSHPReadNextPoint $fsid]] == -2 } { 4670 break 4671 } 4672 if { $pd == 0 || $pd == -1 } { 4673 BUG bad GSHPReadNextPoint ; return 1 4674 } 4675 set x [expr $iscdist*[lindex $pd 0]] 4676 set y [expr $iscdist*[lindex $pd 1]] 4677 set tpd [ConvertPos $SHPPFormt $zone \ 4678 $x $y $SHPDatum DMS] 4679 if { $zz && \ 4680 ! ([BadAltitude [set alt [lindex $pd 2]]] \ 4681 || $alt < -1e35) } { 4682 set alt [expr $iscalt*$alt] 4683 set fs [linsert $tpfs end alt] 4684 lappend tpd $alt 4685 } else { set fs $tpfs } 4686 lappend pts [FormData TP $fs $tpd] 4687 } 4688 if { [set np [llength $pts]] == 0 } { 4689 GMMessage $MESS(voidTR) ; continue 4690 } 4691 set fd [FormData TR \ 4692 "Name Obs TPoints Datum SegStarts" \ 4693 [list $name $commt $pts $SHPDatum $ssts]] 4694 StoreTR [IndexNamed TR $name] $name $fd $GFVisible 4695 } else { 4696 # LN 4697 while { $np } { 4698 if { [SlowOpAborted] } { break } 4699 incr np -1 4700 if { [set pd [GSHPReadNextPoint $fsid]] == -2 } { 4701 break 4702 } 4703 if { $pd == 0 || $pd == -1 } { 4704 BUG bad GSHPReadNextPoint ; return 1 4705 } 4706 set x [expr $iscdist*[lindex $pd 0]] 4707 set y [expr $iscdist*[lindex $pd 1]] 4708 if { [set posn [ConvertPos $SHPPFormt $zone \ 4709 $x $y $SHPDatum $SHPPFormt]] == -1 } { 4710 continue 4711 } 4712 set dt [list $posn] 4713 if { $zz && \ 4714 ! ([BadAltitude [set alt [lindex $pd 2]]] \ 4715 || $alt < -1e35) } { 4716 set alt [expr $iscalt*$alt] 4717 set fs [linsert $lpfs end alt] 4718 lappend dt $alt 4719 } else { set fs $lpfs } 4720 lappend pts [FormData LP $fs $dt] 4721 } 4722 if { [set np [llength $pts]] == 0 } { 4723 GMMessage $MESS(voidLN) ; continue 4724 } 4725 set fd [FormData LN \ 4726 "Name Obs LPoints Datum PFrmt SegStarts" \ 4727 [list $name $commt $pts $SHPDatum $SHPPFormt $ssts]] 4728 StoreLN [IndexNamed LN $name] $name $fd $GFVisible 4729 } 4730 } 4731 } 4732 } 4733 UNKNOWN { 4734 while { $fno } { 4735 if { [SlowOpAborted] } { break } 4736 incr fno -1 4737 if { [set fd [GSHPGetObj $fsid $fno]] != "" } { 4738 switch -- $fd { 4739 -1 - -2 { BUG bad GSHPGetObj ; return 1 } 4740 -3 { SlowOpFinish $slowid $MESS(shpoutmem) ; return 1 } 4741 } 4742 foreach "npts ssts dbfvs" $fd {} 4743 if { $what == "TR" } { 4744 set pfrmt DMS 4745 } else { set pfrmt $SHPPFormt } 4746 set pts "" 4747 while { $npts } { 4748 if { [SlowOpAborted] } { break } 4749 incr npts -1 4750 if { [set pd [GSHPReadNextPoint $fsid]] == -2 } { 4751 break 4752 } 4753 if { $pd == 0 || $pd == -1 } { 4754 BUG bad GSHPReadNextPoint ; return 1 4755 } 4756 set x [expr $iscdist*[lindex $pd 0]] 4757 set y [expr $iscdist*[lindex $pd 1]] 4758 if { [set posn [ConvertPos $SHPPFormt $zone \ 4759 $x $y $SHPDatum $pfrmt]] == -1 } { 4760 continue 4761 } 4762 if { ! $zz || [BadAltitude [set alt [lindex $pd 2]]] \ 4763 || $alt < -1e35 } { 4764 set alt "" 4765 } else { set alt [expr $iscalt*$alt] } 4766 lappend pts [list $posn $alt] 4767 } 4768 if { $pts == "" } { 4769 GMMessage $MESS(void$what) ; continue 4770 } 4771 set name [NewName $what] 4772 set obs "" ; set sep "" 4773 foreach n $dbfs v $dbfvs { 4774 if { $v != "" } { 4775 set obs "${obs}${sep}$n: $v" 4776 set sep "\n" 4777 } 4778 } 4779 switch $what { 4780 RT { 4781 set wpfs "Name PFrmt Posn Datum" 4782 set wpns "" 4783 foreach pt $pts { 4784 if { [SlowOpAborted] } { break } 4785 lappend wpns [set wpn [NewName WP]] 4786 foreach "posn alt" $pt {} 4787 set wdt [list $wpn $pfrmt $posn $SHPDatum] 4788 if { $zz && $alt != "" } { 4789 set fs [linsert $wpfs end Alt] 4790 lappend wdt $alt 4791 } else { set fs $wpfs } 4792 StoreWP -1 $wpn [FormData WP $fs $wdt] 0 4793 } 4794 if { [llength $wpns] > $MAXWPINROUTE } { 4795 GMMessage [format $MESS(toomuchWPs) \ 4796 $MAXWPINROUTE] 4797 } 4798 set fd [FormData RT "IdNumber Obs WPoints" \ 4799 [list $name $obs $wpns]] 4800 StoreRT -1 $name $fd $wpns $GFVisible 4801 } 4802 TR { 4803 set tps "" 4804 foreach pt $pts { 4805 if { [SlowOpAborted] } { break } 4806 foreach "tpd alt" $pt {} 4807 if { $alt != "" } { 4808 set fs [linsert $tpfs end alt] 4809 lappend tpd $alt 4810 } else { set fs $tpfs } 4811 lappend tps [FormData TP $fs $tpd] 4812 } 4813 set fd [FormData TR \ 4814 "Name Obs TPoints Datum SegStarts" \ 4815 [list $name $obs $tps $SHPDatum $ssts]] 4816 StoreTR -1 $name $fd $GFVisible 4817 } 4818 LN { 4819 set lps "" 4820 foreach pt $pts { 4821 if { [SlowOpAborted] } { break } 4822 foreach "posn alt" $pt {} 4823 set dt [list $posn] 4824 if { $alt != "" } { 4825 set fs [linsert $lpfs end alt] 4826 lappend dt $alt 4827 } else { set fs $lpfs } 4828 lappend lps [FormData LP $fs $dt] 4829 } 4830 set fd [FormData LN \ 4831 "Name Obs LPoints Datum PFrmt SegStarts" \ 4832 [list $name $obs $lps $SHPDatum $pfrmt $ssts]] 4833 StoreLN -1 $name $fd $GFVisible 4834 } 4835 } 4836 } 4837 } 4838 } 4839 } 4840 GSHPCloseFiles $fsid 4841 SlowOpFinish $slowid "" 4842 return 0 4843} 4844 4845#### 4846# MGM contribution 4847#### import/export from/to file in MapSend and Meridian formats 4848 4849proc Export_MapSend {file what ixs} { 4850 # MF contribution: code by MGM moved out from general export procs 4851 4852 fconfigure $file -translation {binary binary} 4853 ExportMapSend$what $file $ixs 4854 return 4855} 4856 4857proc Export_Meridian {file what ixs} { 4858 # MF contribution: code by MGM moved out from general export procs 4859 4860 ExportMeridian$what $file $ixs 4861 return 4862} 4863 4864proc ReadMapSendHeader {file} { 4865 global ms_content ms_ver 4866 4867 set hlen 0 4868 binary scan [read $file 1] "c" hlen 4869 4870 set tmp [read $file $hlen] 4871 4872 set ms_ver 1 4873 set teststr "" 4874 scan $tmp "%*s%*2s%d" ms_ver 4875 4876 set ms_content 0 4877 set tmp [ReadBinData $file [list long]] 4878 set ms_content [lindex $tmp 0] 4879 4880 return $ms_content 4881} 4882 4883proc ReadString {file} { 4884 set slen 0 4885 binary scan [read $file 1] c slen 4886 set slen [expr $slen & 0xFF] 4887 set tmpstr [read $file $slen] 4888 return $tmpstr 4889} 4890 4891proc WriteString {file str} { 4892 puts -nonewline $file [binary format c [string length $str]] 4893 puts -nonewline $file $str 4894 return 4895} 4896 4897proc ReadMapSendTP {file} { 4898 global ms_ver 4899 set longd 0 4900 set latd 0 4901 set alt 0 4902 set tm 0 4903 set valid 0 4904 set cs 0 4905 # Endianess,word len issues here !!! 4906 set tmp [ReadBinData $file [list double double long long long]] 4907 set longd [lindex $tmp 0] 4908 set latd [lindex $tmp 1] 4909 set alt [lindex $tmp 2] 4910 set tm [lindex $tmp 3] 4911 set valid [lindex $tmp 4] 4912 4913 # centiseconds 4914 if { $ms_ver >= 30 } { 4915 binary scan [read $file 1] "c" cs 4916 } 4917 4918 set ns "latd longd latDMS longDMS alt date secs" 4919 set latd [expr $latd * -1] 4920 # MF change: using FormatLatLong instead of CreatePos 4921 set p [FormatLatLong $latd $longd DMS] 4922 set dt [DateFromSecs [expr $tm - 567648000]] 4923 set tp "" 4924 4925 if {$valid} { 4926 set tp [FormData TP $ns [concat $p $alt [list $dt] [expr $tm%86400]]] 4927 } 4928 4929 return $tp 4930} 4931 4932proc WriteMapSendTP {file tp} { 4933 global DataIndex TPlatDMS TPlongDMS TPdate 4934 4935 set lat [expr [lindex $tp $DataIndex(TPlatd) ] * -1] 4936 set long [lindex $tp $DataIndex(TPlongd) ] 4937 set dt [lindex $tp $DataIndex(TPdate)] 4938 set alt [lindex $tp $DataIndex(TPalt)] 4939 set secs [lindex $tp $DataIndex(TPsecs)] 4940 4941 WriteBinData $file [list double double long long long byte] \ 4942 [list $long $lat [expr int($alt)] [expr $secs + 567648000] 1 0] 4943 4944 return 4945} 4946 4947proc ReadMapSendWP {file} { 4948 global ms_ver LFileVisible SYMBOLS MAG_SYMTAB 4949 4950 set wpnam [ReadString $file] 4951 set wpcom [ReadString $file] 4952 4953 set num 0 4954 binary scan [read $file 4] i num 4955 4956 set longd 0 4957 set latd 0 4958 set alt 0 4959 set icon 0 4960 set stat 0 4961 4962 binary scan [read $file 1] c icon 4963 4964 binary scan [read $file 1] c stat 4965 4966 set tmp [ReadBinData $file [list double double double]] 4967 set alt [lindex $tmp 0] 4968 set longd [lindex $tmp 1] 4969 set latd [lindex $tmp 2] 4970 set latd [expr $latd * -1] 4971 # MF change: using FormatLatLong instead of CreatePos 4972 set p [FormatLatLong $latd $longd DMS] 4973 4974 set ns "Name Commt Posn Symbol Alt" 4975 set sym [lindex $MAG_SYMTAB $icon] 4976 # MF contribution: setting undefined symbol to default 4977 if { $sym == "" } { 4978 global DEFAULTSYMBOL 4979 set sym $DEFAULTSYMBOL 4980 } 4981 4982 set wp [FormData WP $ns [list $wpnam $wpcom $p $sym $alt]] 4983 set ix [IndexNamed WP $wpnam] 4984 StoreWP $ix $wpnam $wp $LFileVisible($file) 4985 return 4986} 4987 4988proc WriteMapSendWP {file widx cnt} { 4989 global WPPosn WPAlt WPName WPCommt WPSymbol MAG_SYMTAB 4990 4991 WriteString $file $WPName($widx) 4992 WriteString $file $WPCommt($widx) 4993 4994 set latd [lindex $WPPosn($widx) 0] 4995 set longd [lindex $WPPosn($widx) 1] 4996 set snum [lsearch -exact $MAG_SYMTAB $WPSymbol($widx)] 4997 4998 #altitude 4999 # MF contribution: access to altitude array 5000 set wpa [lindex $WPAlt($widx) 0] 5001 if {$wpa == "" } {set wpa 0} 5002 5003 #write index,symbol,status,alt,pos 5004 WriteBinData $file [list long byte byte double double double]\ 5005 [list $cnt $snum 2 $wpa $longd [expr $latd * -1]] 5006 return 5007} 5008 5009proc ReadMapSendRT {file} { 5010 global ms_ver LFileVisible 5011 # Read the route header, blocks 5012 5013 set rtnam [ReadString $file] 5014 5015 set tmp [ReadBinData $file [list long long]] 5016 set num [lindex $tmp 0] 5017 set block_cnt [lindex $tmp 1] 5018 5019 set i 0 5020 set wps "" 5021 while { $i < $block_cnt } { 5022 lappend wps [ReadMapSendRTBlock $file] 5023 # need to accomodate errors here !!! 5024 incr i 5025 } 5026 5027 set stages "" 5028 set id 1 5029 set obs "" 5030 set ix [IndexNamed RT $id] 5031 set l [FormData RT "IdNumber Commt Obs WPoints Stages" \ 5032 [list $id "" $obs $wps $stages]] 5033 StoreRT $ix $id $l $wps $LFileVisible($file) 5034 return 5035} 5036 5037proc ReadMapSendRTBlock {file} { 5038 # Read a route block 5039 global ms_ver LFileVisible SYMBOLS 5040 5041 set longd 0 5042 set latd 0 5043 set icon 0 5044 set stat 0 5045 5046 set rtwpnam [ReadString $file] 5047 5048 set tmp [ReadBinData $file [list long double double]] 5049 set num [lindex $tmp 0] 5050 set longd [lindex $tmp 1] 5051 set latd [expr [lindex $tmp 2] * -1] 5052 5053 binary scan [read $file 1] c icon 5054 5055 return $rtwpnam 5056} 5057 5058proc Import_Meridian {file what how} { 5059 # Matt.Martin _AT_ ieee.org 5060 # MF contribution: added $what argument, not used 5061 global LFileEOF LFileVisible LFileLNo MESS ms_ver PDTYPE 5062 5063 # track points 5064 set tps "" 5065 5066 set date [Now] 5067 set dt "" ; set ixs "" ; set ns "" 5068 set line [gets $file] 5069 set ftype [string range $line 5 7] 5070 5071 switch $ftype { 5072 5073 RTE - 5074 WPL { 5075 set block_cnt 0 5076 while { [string range $line 5 7] == "WPL" } { 5077 # Strip checksum and LF/CR 5078 #regsub {\*..\r?\n?$} [gets $file] "X" line 5079 regsub "\\*...\*\$" $line "" line 5080 set thedat [lrange [UnPackData [split $line ""] \ 5081 [concat [list string] $PDTYPE(WPIN)]] 1 7] 5082 AddMagWPT [lindex [ConvWPData [list $thedat]] 0] 5083 incr block_cnt 5084 # get the next line 5085 set line [gets $file] 5086 } 5087 5088 # get route info 5089 5090 set dat "" 5091 while { [string range $line 5 7] == "RTE" } { 5092 # need to accomodate errors here !!! 5093 set thedat [lrange [UnPackData [split $line ""] \ 5094 [concat [list string] $PDTYPE(RTIN)]] 1 8] 5095 lappend dat $thedat 5096 set line [gets $file] 5097 } 5098 InDataRT $dat 5099 } 5100 TRK { 5101 set block_cnt 0 5102 while { [string length $line]} { 5103 # process each line at a time 5104 set tmp [lrange [UnPackData [split [string range $line 0 \ 5105 [expr [string length $line] -4]] ""] \ 5106 [concat [list string] $PDTYPE(TRIN)]] 1 8] 5107 lappend tps [lindex [ConvTPData $tmp] 1] 5108 incr block_cnt 5109 set line [gets $file] 5110 } 5111 5112 set tname [NewName TR] 5113 set ix [IndexNamed TR $tname] 5114 set data [FormData TR "Name Obs Datum TPoints" \ 5115 [list $tname $block_cnt "WGS 84" $tps]] 5116 StoreTR $ix $tname $data $LFileVisible($file) 5117 } 5118 } 5119 return 5120} 5121 5122proc Import_MapSend {file what how} { 5123 # Matt.Martin _AT_ ieee.org 5124 # MF contribution: added $what argument, not used 5125 global LFileEOF LFileVisible LFileLNo MESS ms_ver 5126 5127 # track points 5128 set tps "" 5129 5130 set date [Now] 5131 set dt "" ; set ixs "" ; set ns "" 5132 fconfigure $file -translation {binary binary} 5133 set ftype [ReadMapSendHeader $file] 5134 5135 switch $ftype { 5136 1 { 5137 set wp_cnt 0 5138 # waypoint count 5139 set tmp [ReadBinData $file [list long]] 5140 set block_cnt [lindex $tmp 0] 5141 5142 set i 0 5143 set wps "" 5144 5145 while { $i < $block_cnt } { 5146 ReadMapSendWP $file 5147 # need to accomodate errors here !!! 5148 incr i 5149 } 5150 5151 # get route count 5152 set rt_cnt 0 5153 set tmp [ReadBinData $file [list long]] 5154 set rt_cnt [lindex $tmp 0] 5155 5156 set i 0 5157 while { $i < $rt_cnt } { 5158 ReadMapSendRT $file 5159 # need to accomodate errors here !!! 5160 incr i 5161 } 5162 } 5163 2 { 5164 # getting track data 5165 # read track name 5166 set tname [ReadString $file] 5167 5168 # get block count 5169 set block_cnt 0 5170 set tmp [ReadBinData $file [list long]] 5171 set block_cnt [lindex $tmp 0] 5172 5173 set i 0 5174 while { $i < $block_cnt } { 5175 lappend tps [ReadMapSendTP $file] 5176 # need to accomodate errors here !!! 5177 incr i 5178 } 5179 5180 set ix [IndexNamed TR $tname] 5181 set data [FormData TR "Name Obs Datum TPoints" \ 5182 [list $tname $block_cnt "WGS 84" $tps]] 5183 StoreTR $ix $tname $data $LFileVisible($file) 5184 } 5185 } 5186 return 5187} 5188 5189proc MapSendHeader {file type} { 5190 puts -nonewline $file [binary format c 0xd] 5191 puts -nonewline $file "4D533334 MS34" 5192 WriteBinData $file [list long] [list $type] 5193 return 5194} 5195 5196 5197proc ExportMeridianWP {f items} { 5198 5199 set cnt 0 5200 foreach i $items { 5201 # MF contribution 5202 if { [SlowOpAborted] } { return } 5203 #-- 5204 incr cnt 5205 set outdat [PrepMagWPData $i] 5206 puts -nonewline $f [join [MakeMagPacket WPL $outdat] ""] 5207 } 5208 return 5209} 5210 5211proc ExportMeridianRT {f items} { 5212 global RTWPoints 5213 5214 # First, Dump out all waypoints 5215 set wplist "" 5216 foreach i $items { 5217 # MF contribution 5218 if { [SlowOpAborted] } { return } 5219 #-- 5220 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 5221 foreach w $wps { 5222 # only add to list if not there already 5223 if { [lsearch -exact $wplist $w] == -1 } { 5224 lappend wplist $w 5225 } 5226 } 5227 } 5228 ExportMeridianWP $f $wplist 5229 5230 # Then the routes 5231 foreach i $items { 5232 # MF contribution 5233 if { [SlowOpAborted] } { return } 5234 #-- 5235 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 5236 set lncnt [expr int(([llength $wps] + 1 )/2)] 5237 set lnnum 1 5238 while { [llength $wps]} { 5239 set outdat [PrepMagRTdata [lindex $wps 0] [lindex $wps 1] \ 5240 $lncnt $lnnum $i] 5241 set wps [lreplace $wps 0 1] 5242 5243 puts -nonewline $f [join [MakeMagPacket RTE $outdat] ""] 5244 incr lnnum 5245 } 5246 } 5247 return 5248} 5249 5250proc ExportMeridianTR {f items} { 5251 global TRTPoints TRDatum 5252 5253 set cnt 0 5254 foreach i $items { 5255 # MF contribution: only change the datum if needed 5256 if { [SlowOpAborted] } { return } 5257 if { $TRDatum($i) != "WGS 84" } { 5258 set tps [ChangeTPsDatum $TRTPoints($i) $TRDatum($i) "WGS 84"] 5259 } else { set tps $TRTPoints($i) } 5260 #-- 5261 incr cnt 5262 foreach p $tps { 5263 # setup the packet 5264 # MF change: datum conversion made above 5265 set outdat [PrepMagTRData [lreplace $p 2 3]] 5266 # add the checksum and write 5267 puts -nonewline $f [join [MakeMagPacket TRK $outdat] ""] 5268 } 5269 } 5270 return 5271} 5272 5273proc DumpMapSendWP {f items} { 5274 WriteBinData $f [list long] [list [llength $items]] 5275 set cnt 0 5276 foreach i $items { 5277 incr cnt 5278 WriteMapSendWP $f $i $cnt 5279 } 5280} 5281 5282proc ExportMapSendWP {f items} { 5283 MapSendHeader $f 1 5284 DumpMapSendWP $f $items 5285 WriteBinData $f [list long] [list 0] 5286 return 5287} 5288 5289proc ExportMapSendRT {f items} { 5290 global RTWPoints RTData RTIdNumber WPName WPPosn WPSymbol MAG_SYMTAB 5291 5292 # MF contribution 5293 set badrts "" 5294 ## 5295 5296 # First, Dump out all waypoints 5297 set wplist "" 5298 foreach i $items { 5299 # MF contribution 5300 if { ! [CheckNumber Ignore $RTIdNumber($i)] } { 5301 lappend badrts $i 5302 continue 5303 } 5304 ## 5305 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 5306 foreach w $wps { 5307 # only add to list if not there already 5308 if { [lsearch -exact $wplist $w] == -1 } { 5309 lappend wplist $w 5310 } 5311 } 5312 } 5313 # MF contribution 5314 if { [set n [llength $badrts]] > 0 } { 5315 global MESS 5316 GMMessage [format $MESS(cantsaveRTid) $n] 5317 } 5318 ## 5319 5320 MapSendHeader $f 1 5321 DumpMapSendWP $f $wplist 5322 5323 ############################################################# 5324 # Then the routes 5325 ############################################################# 5326 5327 # number of routes 5328 WriteBinData $f [list long] [list [llength $items]] 5329 5330 foreach i $items { 5331 # MF contribution 5332 if { $i == [lindex $badrts 0] } { 5333 set badrts [lreplace $badrts 0 0] 5334 continue 5335 } 5336 ## 5337 set wps [Apply "$RTWPoints($i)" IndexNamed WP] 5338 set lncnt [expr int(([llength $wps] + 1 )/2)] 5339 # route name 5340 WriteString $f $RTIdNumber($i) 5341 #route num, block cnt 5342 WriteBinData $f [list long long] [list $RTIdNumber($i) [llength $wps]] 5343 5344 set wpnum 1 5345 foreach w $wps { 5346 # name 5347 WriteString $f $WPName($w) 5348 # wp index 5349 # long 5350 set longd [lindex $WPPosn($w) 1] 5351 # lat 5352 set latd [lindex $WPPosn($w) 0] 5353 # sym 5354 set snum [lsearch -exact $MAG_SYMTAB $WPSymbol($w)] 5355 incr wpnum 5356 WriteBinData $f [list long double double byte] \ 5357 [list [expr [lsearch $wplist $w]+1] $longd \ 5358 [expr $latd * -1] $snum] 5359 } 5360 } 5361 return 5362} 5363 5364proc ExportMapSendTR {of ixs} { 5365 global TRName TRTPoints 5366 5367 MapSendHeader $of 2 5368 set i [lindex $ixs 0] 5369 WriteString $of $TRName($i) 5370 WriteBinData $of [list long] [list [llength $TRTPoints($i)]] 5371 5372 foreach tp $TRTPoints($i) { 5373 WriteMapSendTP $of $tp 5374 } 5375 return 5376} 5377 5378 5379 5380 5381 5382 5383