1#!/bin/sh 2# This is a Tcl/Tk script to be interpreted by tclsh (Tk8.3 or better): \ 3exec tclsh "$0" "$@" 4 5# 6# shape2quadr --- distribute items in a shapefile by gpsman files according 7# to user given quadrangles 8# 9# This is a script done in the context of 10# 11# gpsman --- GPS Manager: a manager for GPS receiver data 12# 13# Copyright (c) 2004 Miguel Filgueiras (mig@ncc.up.pt) / Universidade do Porto 14# 15# This program is free software; you can redistribute it and/or modify 16# it under the terms of the GNU General Public License as published by 17# the Free Software Foundation; either version 2 of the License, or 18# (at your option) any later version. 19# 20# This program is distributed in the hope that it will be useful, 21# but WITHOUT ANY WARRANTY; without even the implied warranty of 22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23# GNU General Public License for more details. 24# 25# You should have received a copy of the GNU General Public License 26# along with this program. 27# 28 29# last change: 7 July 2004 30 31# needs the gpsmanshp library, preferably version 1.2 or later 32# see http://www.ncc.up.pt/gpsmanshp 33 34 35set Usage \ 36{shape2quadr.tcl FILE PREFIX [NAME MINLONG MAXLONG MINLAT MAXLAT]+ 37shape2quadr.tcl FILE PREFIX -d QPREFIX LONG LONGRANGE STEPLONG MAXLONG LAT LATRANGE STEPLAT MAXLAT} 38 39set datum "WGS 84" 40 41if { [llength $argv] < 7 } { 42 puts stderr $Usage 43 exit 1 44} 45 46package require gpsmanshp 47 48set basename [file rootname [lindex $argv 0]] 49 50if { [set fsid [GSHPOpenInputFiles $basename]] < 1 } { 51 puts stderr "Error when opening shapefile $basename: $fsid" 52 exit 1 53} 54 55if { [set info [GSHPInfoFrom $fsid]] == 0 } { BUG bad channel ; exit 1 } 56 57foreach "fwh fno fdim fix dbfn dbfnps" $info {} 58 59if { $fno < 1 } { 60 puts stderr "Empty shapefile" 61 exit 1 62} 63 64if { $fwh == "WP" } { 65 puts stderr "WP file not supported" 66 exit 1 67} 68 69set fprefix [lindex $argv 1] 70 71set argv [lreplace $argv 0 1] 72 73set quadrs "" 74foreach d "x y" { 75 set qmax$d -1e3 ; set qmin$d 1e3 76} 77 78if { [lindex $argv 0] == "-d" } { 79 # QPREFIX LONG LONGRANGE STEPLONG MAXLONG LAT LATRANGE STEPLAT MAXLAT 80 if { [llength $argv] != 10 } { 81 puts stderr $Usage 82 exit 1 83 } 84 foreach "x qpre lo0 lod lost lomx la0 lad last lamx" $argv { break } 85 foreach v "lo0 lod lost lomx la0 lad last lamx" { 86 if { [catch {set $v [expr [set $v]]}] } { 87 puts stderr "Bad value [set $v]" 88 exit 1 89 } 90 } 91 if { $lod <= 0 || $lad <= 0 } { 92 puts stderr "Ranges must be positive: $lod, $lad" 93 exit 1 94 } 95 if { $lost <= 0 || $last <= 0 } { 96 puts stderr "Steps must be positive: $lost, $last" 97 exit 1 98 } 99 if { $lo0 > $lomx || $la0 > $lamx } { 100 puts stderr "Bad bounds" 101 exit 1 102 } 103 set qminx $lo0 ; set qminy $la0 104 set qno 0 105 for { set lo $lo0 } { $lo < $lomx } { set lo [expr $lo+$lost] } { 106 set lox [expr $lo+$lod] 107 set qmaxx $lox 108 for { set la $la0 } { $la < $lamx } { set la [expr $la+$last] } { 109 set lax [expr $la+$lad] 110 set qmaxy $lax 111 set name "${qpre}[incr qno]" 112 array set quadr [list $name {} $name,x0 $lo $name,x1 $lox \ 113 $name,y0 $la $name,y1 $lax] 114 lappend quadrs $name 115 } 116 } 117} else { 118 while { $argv != {} } { 119 # for each quadrangle: NAME MINLONG MAXLONG MINLAT MAXLAT 120 foreach {name x0 x1 y0 y1} $argv { break } 121 set argv [lreplace $argv 0 4] 122 if { $name == "" } { 123 puts stderr "Quadrangle with empty name" 124 exit 1 125 } 126 if { ! [catch {set quadr($name)}] } { 127 puts stderr "Repeated quadrangle name: $name" 128 exit 1 129 } 130 foreach k "x0 y0 x1 y1" mx "180 90 180 90" { 131 if { [catch {expr [set $k]}] || abs([set $k]) > $mx } { 132 puts stderr "Bad bound [set $k] for quadrangle $name" 133 exit 1 134 } 135 } 136 if { $x0 >= $x1 || $y0 >= $y1 } { 137 puts stderr "Bad bounds for quadrangle $name" 138 exit 1 139 } 140 array set quadr [list $name {} $name,x0 $x0 $name,x1 $x1 \ 141 $name,y0 $y0 $name,y1 $y1] 142 foreach d "x y" { 143 if { [set ${d}0] < [set qmin$d] } { set qmin$d [set ${d}0] } 144 if { [set ${d}1] > [set qmax$d] } { set qmax$d [set ${d}1] } 145 } 146 lappend quadrs $name 147 } 148} 149 150puts "[llength $quadrs] quadrangles defined; $fno items to be processed" 151 152set time0 [clock seconds] 153set discarded 0 154set lnno 0 155 156switch $fwh { 157 RT { 158 puts stderr "RT file: will convert to LN files" 159 set ixno 2 ; set ixstss 100 160 set ixdbfs 0 ; set dbflst 0 ; set dbfs "Name Comment" 161 } 162 TR { 163 puts stderr "TR file: will convert to LN files" 164 set ixno 2 ; set ixstss 3 165 set ixdbfs 0 ; set dbflst 0 ; set dbfs "Name Comment" 166 } 167 UNKNOWN { 168 set ixno 0 ; set ixstss 1 ; set ixdbfs 2 ; set dbflst 1 169 set dbfs "" 170 foreach "n p" $dbfnps { 171 lappend dbfs $n 172 } 173 } 174} 175 176while { $fno } { 177 incr fno -1 178 if { [set fd [GSHPGetObj $fsid $fno]] == "" } { continue } 179 if { $fd <= 0 } { 180 puts stderr "Error reading object ($fno to read)" ; exit 1 181 } 182 if { [set np [lindex $fd $ixno]] < 1 } { 183 puts stderr "no points in line ($fno to read)" ; continue 184 } 185 set dpts "" 186 foreach d "x y" { 187 set omax$d -1e3 ; set omin$d 1e3 188 } 189 while { $np } { 190 incr np -1 191 if { [set pd [GSHPReadNextPoint $fsid]] == -2 } { 192 break 193 } 194 if { $pd == 0 || $pd == -1 } { 195 BUG bad GSHPReadNextPoint ; return 1 196 } 197 foreach "x y" $pd { break } 198 foreach d "x y" h "EW NS" { 199 set v [set $d] 200 if { $v < [set omin$d] } { set omin$d $v } 201 if { $v > [set omax$d] } { set omax$d $v } 202 # CreatePos DDD 203 if { $v < 0 } { 204 set v [expr -$v] ; set h [string index $h 1] 205 } else { set h [string index $h 0] } 206 set f$d "${h}[format %.5f $v]" 207 } 208 lappend dpts "$y $x $fy $fx" 209 } 210 if { $omaxx < $qminx || $ominx > $qmaxx || \ 211 $omaxy < $qminy || $ominy > $qmaxy } { 212 incr discarded 213 continue 214 } 215 set d 1 216 foreach q $quadrs { 217 if { $omaxx < $quadr($q,x0) || $ominx > $quadr($q,x1) || \ 218 $omaxy < $quadr($q,y0) || $ominy > $quadr($q,y1) } { 219 continue 220 } 221 if { $d } { 222 set d 0 223 set name LN[format %06d [incr lnno]] 224 set obs "" 225 if { $dbfs != "" } { 226 set sep "" 227 if { $dbflst } { 228 foreach n $dbfs v [lindex $fd $ixdbfs] { 229 if { $v != "" } { 230 set obs "${obs}${sep}$n: $v" 231 set sep "\n" 232 } 233 } 234 } else { 235 set ix $ixdbfs 236 foreach n $dbfs { 237 if { [set v [lindex $fd $ix]] != "" } { 238 set obs "${obs}${sep}$n: $v" 239 set sep "\n" 240 } 241 incr ix 242 } 243 } 244 } 245 set line($name) [list $dpts [lindex $fd $ixstss] $obs] 246 } 247 lappend quadr($q) $name 248 } 249 incr discarded $d 250} 251 252GSHPCloseFiles $fsid 253 254puts "$discarded discarded\n\nquadrangle\tnumber of lines" 255 256set date [clock format [clock seconds]] 257 258foreach q $quadrs { 259 set n [llength $quadr($q)] 260 puts "$q\t$n" 261 if { $n } { 262 set fn ${fprefix}_$q 263 if { [catch {set f [open $fn w]}] } { 264 puts stderr "cannot write file $fn; skipping" 265 continue 266 } 267 puts $f "% Written by shape2quadr.tcl $date" 268 puts $f "% Quadrangle bounds: x $quadr($q,x0) to $quadr($q,x1), y $quadr($q,y0) to $quadr($q,y1)" 269 puts $f "" 270 puts $f "!Format: DDD 0 $datum" 271 puts $f "" 272 puts $f "!Creation: no" 273 puts $f "" 274 275 foreach ln $quadr($q) { 276 puts $f "!LN:\t$ln" 277 foreach "dpts ssts obs" $line($ln) {} 278 if { $obs != "" } { 279 puts $f "!NB:\t$obs" 280 puts $f "" 281 } 282 set lpn 0 ; set nsst [lindex $ssts 0] 283 foreach lp $dpts { 284 if { $nsst == $lpn } { 285 puts $f "!LS:" 286 set ssts [lreplace $ssts 0 0] 287 set nsst [lindex $ssts 0] 288 } 289 incr lpn 290 puts $f "\t$lp\t" 291 } 292 } 293 puts $f "" 294 puts $f "!G:\tQuadrangle $q" 295 set c "!GL:" 296 foreach ln $quadr($q) { 297 puts $f "${c}\t$ln" 298 set c "" 299 } 300 } 301} 302 303puts "spent [clock format [expr [clock seconds]-$time0] -format %T]" 304