gpsman 6.4.4.2-2 / usr / lib / gpsman / shape2quadr.tcl

#!/bin/sh
# This is a Tcl/Tk script to be interpreted by tclsh (Tk8.3 or better): \
exec tclsh "$0" "$@"

#
#  shape2quadr --- distribute items in a shapefile by gpsman files according
#            to user given quadrangles
#
# This is a script done in the context of
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
#  Copyright (c) 2004 Miguel Filgueiras (mig@ncc.up.pt) / Universidade do Porto
#
#    This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 2 of the License, or
#      (at your option) any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program.
#

# last change:  7 July 2004

# needs the gpsmanshp library, preferably version 1.2 or later
#  see http://www.ncc.up.pt/gpsmanshp


set Usage \
{shape2quadr.tcl FILE PREFIX [NAME MINLONG MAXLONG MINLAT MAXLAT]+
shape2quadr.tcl FILE PREFIX -d QPREFIX LONG LONGRANGE STEPLONG MAXLONG LAT LATRANGE STEPLAT MAXLAT}

set datum "WGS 84"

if { [llength $argv] < 7 } {
    puts stderr $Usage
    exit 1
}

package require gpsmanshp

set basename [file rootname [lindex $argv 0]]

if { [set fsid [GSHPOpenInputFiles $basename]] < 1 } {
    puts stderr "Error when opening shapefile $basename: $fsid"
    exit 1
}

if { [set info [GSHPInfoFrom $fsid]] == 0 } { BUG bad channel ; exit 1 }

foreach "fwh fno fdim fix dbfn dbfnps" $info {}

if { $fno < 1 } {
    puts stderr "Empty shapefile"
    exit 1
}

if { $fwh == "WP" } {
    puts stderr "WP file not supported"
    exit 1
}

set fprefix [lindex $argv 1]

set argv [lreplace $argv 0 1]

set quadrs ""
foreach d "x y" {
    set qmax$d -1e3 ; set qmin$d 1e3
}

if { [lindex $argv 0] == "-d" } {
    # QPREFIX LONG LONGRANGE STEPLONG MAXLONG LAT LATRANGE STEPLAT MAXLAT
    if { [llength $argv] != 10 } {
	puts stderr $Usage
	exit 1
    }
    foreach "x qpre lo0 lod lost lomx la0 lad last lamx" $argv { break }
    foreach v "lo0 lod lost lomx la0 lad last lamx" {
	if { [catch {set $v [expr [set $v]]}] } {
	    puts stderr "Bad value [set $v]"
	    exit 1
	}
    }
    if { $lod <= 0 || $lad <= 0 } {
	puts stderr "Ranges must be positive: $lod, $lad"
	exit 1
    }
    if { $lost <= 0 || $last <= 0 } {
	puts stderr "Steps must be positive: $lost, $last"
	exit 1
    }
    if { $lo0 > $lomx || $la0 > $lamx } {
	puts stderr "Bad bounds"
	exit 1
    }
    set qminx $lo0 ; set qminy $la0
    set qno 0
    for { set lo $lo0 } { $lo < $lomx } { set lo [expr $lo+$lost] } {
	set lox [expr $lo+$lod]
	set qmaxx $lox
	for { set la $la0 } { $la < $lamx } { set la [expr $la+$last] } {
	    set lax [expr $la+$lad]
	    set qmaxy $lax
	    set name "${qpre}[incr qno]"
	    array set quadr [list $name {} $name,x0 $lo $name,x1 $lox \
				$name,y0 $la $name,y1 $lax]
	    lappend quadrs $name
	}
    }
} else {
    while { $argv != {} } {
	# for each quadrangle: NAME MINLONG MAXLONG MINLAT MAXLAT
	foreach {name x0 x1 y0 y1} $argv { break }
	set argv [lreplace $argv 0 4]
	if { $name == "" } {
	    puts stderr "Quadrangle with empty name"
	    exit 1
	}
	if { ! [catch {set quadr($name)}] } {
	    puts stderr "Repeated quadrangle name: $name"
	    exit 1
	}
	foreach k "x0 y0 x1 y1" mx "180 90 180 90" {
	    if { [catch {expr [set $k]}] || abs([set $k]) > $mx } {
		puts stderr "Bad bound [set $k] for quadrangle $name"
		exit 1
	    }
	}
	if { $x0 >= $x1 || $y0 >= $y1 } {
	    puts stderr "Bad bounds for quadrangle $name"
	    exit 1
	}
	array set quadr [list $name {} $name,x0 $x0 $name,x1 $x1 \
			    $name,y0 $y0 $name,y1 $y1]
	foreach d "x y" {
	    if { [set ${d}0] < [set qmin$d] } { set qmin$d [set ${d}0] }
	    if { [set ${d}1] > [set qmax$d] } { set qmax$d [set ${d}1] }
	}
	lappend quadrs $name
    }
}

puts "[llength $quadrs] quadrangles defined; $fno items to be processed"

set time0 [clock seconds]
set discarded 0
set lnno 0

switch $fwh {
    RT {
	puts stderr "RT file: will convert to LN files"
	set ixno 2 ; set ixstss 100
	set ixdbfs 0 ; set dbflst 0 ; set dbfs "Name Comment"
    }
    TR {
	puts stderr "TR file: will convert to LN files"
	set ixno 2 ; set ixstss 3
	set ixdbfs 0 ; set dbflst 0 ; set dbfs "Name Comment"
    }
    UNKNOWN {
	set ixno 0 ; set ixstss 1 ; set ixdbfs 2 ; set dbflst 1
	set dbfs ""
	foreach "n p" $dbfnps {
	    lappend dbfs $n
	}
    }
}

while { $fno } {
    incr fno -1
    if { [set fd [GSHPGetObj $fsid $fno]] == "" } { continue }
    if { $fd <= 0 } {
	puts stderr "Error reading object ($fno to read)" ; exit 1
    }
    if { [set np [lindex $fd $ixno]] < 1 } {
	puts stderr "no points in line ($fno to read)" ; continue
    }
    set dpts ""
    foreach d "x y" {
	set omax$d -1e3 ; set omin$d 1e3
    }
    while { $np } {
	incr np -1
	if { [set pd [GSHPReadNextPoint $fsid]] == -2 } {
	    break
	}
	if { $pd == 0 || $pd == -1 } {
	    BUG bad GSHPReadNextPoint ; return 1
	}
	foreach "x y" $pd { break }
	foreach d "x y" h "EW NS" {
	    set v [set $d]
	    if { $v < [set omin$d] } { set omin$d $v }
	    if { $v > [set omax$d] } { set omax$d $v }
	    # CreatePos DDD
	    if { $v < 0 } {
		set v [expr -$v] ; set h [string index $h 1]
	    } else { set h [string index $h 0] }
	    set f$d "${h}[format %.5f $v]"
	}
	lappend dpts "$y $x $fy $fx"
    }
    if { $omaxx < $qminx || $ominx > $qmaxx || \
	     $omaxy < $qminy || $ominy > $qmaxy } {
	incr discarded
	continue
    }
    set d 1
    foreach q $quadrs {
	if { $omaxx < $quadr($q,x0) || $ominx > $quadr($q,x1) || \
		 $omaxy < $quadr($q,y0) || $ominy > $quadr($q,y1) } {
	    continue
	}
	if { $d } {
	    set d 0
	    set name LN[format %06d [incr lnno]]
	    set obs ""
	    if { $dbfs != "" } {
		set sep ""
		if { $dbflst } {
		    foreach n $dbfs v [lindex $fd $ixdbfs] {
			if { $v != "" } {
			    set obs "${obs}${sep}$n: $v"
			    set sep "\n"
			}
		    }
		} else {
		    set ix $ixdbfs
		    foreach n $dbfs {
			if { [set v [lindex $fd $ix]] != "" } {
			    set obs "${obs}${sep}$n: $v"
			    set sep "\n"
			}
			incr ix
		    }
		}
	    }
	    set line($name) [list $dpts [lindex $fd $ixstss] $obs]
	}
	lappend quadr($q) $name
    }
    incr discarded $d
}

GSHPCloseFiles $fsid

puts "$discarded discarded\n\nquadrangle\tnumber of lines"

set date [clock format [clock seconds]]

foreach q $quadrs {
    set n [llength $quadr($q)]
    puts "$q\t$n"
    if { $n } {
	set fn ${fprefix}_$q
	if { [catch {set f [open $fn w]}] } {
	    puts stderr "cannot write file $fn; skipping"
	    continue
	}
	puts $f "% Written by shape2quadr.tcl $date"
	puts $f "% Quadrangle bounds: x $quadr($q,x0) to $quadr($q,x1), y $quadr($q,y0) to $quadr($q,y1)"
	puts $f ""
	puts $f "!Format: DDD 0 $datum"
	puts $f ""
	puts $f "!Creation: no"
	puts $f ""

	foreach ln $quadr($q) {
	    puts $f "!LN:\t$ln"
	    foreach "dpts ssts obs" $line($ln) {}
	    if { $obs != "" } {
		puts $f "!NB:\t$obs"
		puts $f ""
	    }
	    set lpn 0 ; set nsst [lindex $ssts 0]
	    foreach lp $dpts {
		if { $nsst == $lpn } {
		    puts $f "!LS:"
		    set ssts [lreplace $ssts 0 0]
		    set nsst [lindex $ssts 0]
		}
		incr lpn
		puts $f "\t$lp\t"
	    }
	}
	puts $f ""
	puts $f "!G:\tQuadrangle $q"
	set c "!GL:"
	foreach ln $quadr($q) {
	    puts $f "${c}\t$ln"
	    set c ""
	}
    }
}

puts "spent [clock format [expr [clock seconds]-$time0] -format %T]"