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