shapefiles: reorganize a bit, and add ``load-shapes``.
John Benediktsson
parent
da877c9e47
commit
84f8449771
|
|
@ -1,11 +1,26 @@
|
|||
! Copyright (C) 2018 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: arrays combinators io io.binary.fast io.encodings.binary
|
||||
USING: accessors combinators io io.binary io.encodings.binary
|
||||
io.files kernel math sequences ;
|
||||
|
||||
IN: shapefiles
|
||||
|
||||
SINGLETON: null-shape
|
||||
TUPLE: point x y ;
|
||||
TUPLE: multipoint box points ;
|
||||
TUPLE: polygon box parts points ;
|
||||
TUPLE: polyline box parts points ;
|
||||
TUPLE: point-z < point z m ;
|
||||
TUPLE: polyline-z < polyline z-range z-array m-range m-array ;
|
||||
TUPLE: polygon-z < polygon z-range z-array m-range m-array ;
|
||||
TUPLE: multipoint-z < multipoint z-range z-array m-range m-array ;
|
||||
TUPLE: point-m < point m ;
|
||||
TUPLE: polyline-m < polyline m-range m-array ;
|
||||
TUPLE: polygon-m < polygon m-range m-array ;
|
||||
TUPLE: multipoint-m < multipoint m-range m-array ;
|
||||
TUPLE: multipatch box parts part-types points z-range z-array m-range m-array ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: read-int ( -- n )
|
||||
|
|
@ -26,10 +41,71 @@ IN: shapefiles
|
|||
: read-range ( -- range )
|
||||
2 read-doubles ;
|
||||
|
||||
PRIVATE>
|
||||
: read-point ( -- point )
|
||||
read-double read-double point boa ;
|
||||
|
||||
TUPLE: header file-code file-length version shape-type x-min
|
||||
y-min x-max y-max z-min z-max m-min m-max ;
|
||||
: read-points ( n -- points )
|
||||
[ read-point ] replicate ;
|
||||
|
||||
: (read-multipoint) ( -- box points )
|
||||
read-box read-int read-points ;
|
||||
|
||||
: read-multipoint ( -- multipoint )
|
||||
(read-multipoint) multipoint boa ;
|
||||
|
||||
: read-poly ( -- box parts points )
|
||||
read-box read-int read-int [ read-ints ] dip read-points ;
|
||||
|
||||
: read-point-z ( -- point-z )
|
||||
read-double read-double read-double read-double point-z boa ;
|
||||
|
||||
: read-poly-z ( -- box parts points z-range z-array m-range m-array )
|
||||
read-poly read-range over length
|
||||
[ read-doubles read-range ] [ read-doubles ] bi ;
|
||||
|
||||
: read-multipoint-z ( -- multipoint-z )
|
||||
(read-multipoint) read-range over length
|
||||
[ read-doubles read-range ] [ read-doubles ] bi
|
||||
multipoint-z boa ;
|
||||
|
||||
: read-point-m ( -- point-m )
|
||||
read-double read-double read-double point-m boa ;
|
||||
|
||||
: read-poly-m ( -- box parts points m-range m-array )
|
||||
read-poly read-range over length read-doubles ;
|
||||
|
||||
: read-multipoint-m ( -- multipoint-m )
|
||||
(read-multipoint) read-range over length read-doubles
|
||||
multipoint-m boa ;
|
||||
|
||||
: read-multipatch ( -- multipatch )
|
||||
read-box read-int read-int
|
||||
[ [ read-ints ] [ read-ints ] bi ] dip
|
||||
[ read-points read-range ]
|
||||
[ read-doubles read-range ]
|
||||
[ read-doubles ] tri multipatch boa ;
|
||||
|
||||
: read-shape ( -- shape )
|
||||
read-int {
|
||||
{ 0 [ null-shape ] }
|
||||
{ 1 [ read-point ] }
|
||||
{ 3 [ read-poly polyline boa ] }
|
||||
{ 5 [ read-poly polygon boa ] }
|
||||
{ 8 [ read-multipoint ] }
|
||||
{ 11 [ read-point-z ] }
|
||||
{ 13 [ read-poly-z polyline-z boa ] }
|
||||
{ 15 [ read-poly-z polygon-z boa ] }
|
||||
{ 18 [ read-multipoint-z ] }
|
||||
{ 21 [ read-point-m ] }
|
||||
{ 23 [ read-poly-m polyline-m boa ] }
|
||||
{ 25 [ read-poly-m polygon-m boa ] }
|
||||
{ 28 [ read-multipoint-m ] }
|
||||
{ 31 [ read-multipatch ] }
|
||||
} case ;
|
||||
|
||||
TUPLE: header { file-code initial: 9994 } file-length
|
||||
{ version initial: 1000 } shape-type x-min y-min x-max y-max
|
||||
z-min z-max m-min m-max ;
|
||||
|
||||
: read-header ( -- header )
|
||||
4 read be> dup 9994 assert=
|
||||
|
|
@ -47,118 +123,6 @@ y-min x-max y-max z-min z-max m-min m-max ;
|
|||
read-double
|
||||
header boa ;
|
||||
|
||||
SINGLETON: null-shape
|
||||
|
||||
TUPLE: point x y ;
|
||||
|
||||
: read-point ( -- point )
|
||||
read-double read-double point boa ;
|
||||
|
||||
: read-points ( n -- points )
|
||||
[ read-point ] replicate ;
|
||||
|
||||
TUPLE: multipoint box points ;
|
||||
|
||||
: read-multipoint ( -- multipoint )
|
||||
read-box read-int read-points multipoint boa ;
|
||||
|
||||
TUPLE: polyline box parts points ;
|
||||
|
||||
: read-polyline ( -- polyline )
|
||||
read-box read-int read-int [ read-ints ] dip
|
||||
read-points polyline boa ;
|
||||
|
||||
TUPLE: polygon box parts points ;
|
||||
|
||||
: read-polygon ( -- polygon )
|
||||
read-box read-int read-int [ read-ints ] dip
|
||||
read-points polygon boa ;
|
||||
|
||||
TUPLE: point-z x y z m ;
|
||||
|
||||
: read-point-z ( -- point-z )
|
||||
read-double read-double read-double read-double point-z boa ;
|
||||
|
||||
TUPLE: polyline-z box parts points z-range z-array m-range
|
||||
m-array ;
|
||||
|
||||
: read-polyline-z ( -- polyline-z )
|
||||
read-box read-int read-int [ read-ints ] dip
|
||||
[ read-points read-range ]
|
||||
[ read-doubles read-range ]
|
||||
[ read-doubles ] tri polyline-z boa ;
|
||||
|
||||
TUPLE: polygon-z box parts points z-range z-array m-range
|
||||
m-array ;
|
||||
|
||||
: read-polygon-z ( -- polygon-z )
|
||||
read-box read-int read-int [ read-ints ] dip
|
||||
[ read-points read-range ]
|
||||
[ read-doubles read-range ]
|
||||
[ read-doubles ] tri polygon-z boa ;
|
||||
|
||||
TUPLE: multipoint-z box points z-range z-array m-range m-array ;
|
||||
|
||||
: read-multipoint-z ( -- multipoint-z )
|
||||
read-box read-int
|
||||
[ read-points read-range ]
|
||||
[ read-doubles read-range ]
|
||||
[ read-doubles ] tri multipoint-z boa ;
|
||||
|
||||
TUPLE: point-m x y m ;
|
||||
|
||||
: read-point-m ( -- point-m )
|
||||
read-double read-double read-double point-m boa ;
|
||||
|
||||
TUPLE: polyline-m box parts points m-range m-array ;
|
||||
|
||||
: read-polyline-m ( -- polyline-m )
|
||||
read-box read-int read-int [ read-ints ] dip
|
||||
[ read-points read-range ] [ read-doubles ] bi
|
||||
polyline-m boa ;
|
||||
|
||||
TUPLE: polygon-m box parts points m-range m-array ;
|
||||
|
||||
: read-polygon-m ( -- polygon-m )
|
||||
read-box read-int read-int [ read-ints ] dip
|
||||
[ read-points read-range ] [ read-doubles ] bi
|
||||
polygon-m boa ;
|
||||
|
||||
TUPLE: multipoint-m box points m-range m-array ;
|
||||
|
||||
: read-multipoint-m ( -- multipoint-m )
|
||||
read-box read-int
|
||||
[ read-points read-range ] [ read-doubles ] bi
|
||||
multipoint-m boa ;
|
||||
|
||||
TUPLE: multipatch box parts part-types points z-range z-array
|
||||
m-range m-array ;
|
||||
|
||||
: read-multipatch ( -- multipatch )
|
||||
read-box read-int read-int
|
||||
[ [ read-ints ] [ read-ints ] bi ] dip
|
||||
[ read-points read-range ]
|
||||
[ read-doubles read-range ]
|
||||
[ read-doubles ] tri multipatch boa ;
|
||||
|
||||
: read-shape ( -- shape )
|
||||
read-int {
|
||||
{ 0 [ null-shape ] }
|
||||
{ 1 [ read-point ] }
|
||||
{ 3 [ read-polyline ] }
|
||||
{ 5 [ read-polygon ] }
|
||||
{ 8 [ read-multipoint ] }
|
||||
{ 11 [ read-point-z ] }
|
||||
{ 13 [ read-polyline-z ] }
|
||||
{ 15 [ read-polygon-z ] }
|
||||
{ 18 [ read-multipoint-z ] }
|
||||
{ 21 [ read-point-m ] }
|
||||
{ 23 [ read-polyline-m ] }
|
||||
{ 25 [ read-polygon-m ] }
|
||||
{ 28 [ read-multipoint-m ] }
|
||||
{ 31 [ read-multipatch ] }
|
||||
} case ;
|
||||
|
||||
TUPLE: record number content-length shape ;
|
||||
|
||||
: read-record ( -- record/f )
|
||||
|
|
@ -186,3 +150,23 @@ TUPLE: index offset content-length ;
|
|||
|
||||
: file>shx ( path -- header indices )
|
||||
binary [ read-shx ] with-file-reader ;
|
||||
|
||||
: num-records ( path -- n )
|
||||
".shx" append binary [
|
||||
read-header file-length>> 2 * 100 - 8 /
|
||||
] with-file-reader ;
|
||||
|
||||
: nth-index ( n path -- index )
|
||||
".shx" append binary [
|
||||
8 * 100 + seek-absolute seek-input read-index
|
||||
] with-file-reader ;
|
||||
|
||||
: nth-record ( n path -- record )
|
||||
[ nth-index offset>> ] keep ".shp" append binary [
|
||||
2 * seek-absolute seek-input read-record
|
||||
] with-file-reader ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: load-shapes ( path -- shapes )
|
||||
".shp" append file>shp nip [ shape>> ] map ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue