diff --git a/extra/shapefiles/shapefiles.factor b/extra/shapefiles/shapefiles.factor index f8a3ad569f..3a1b022733 100644 --- a/extra/shapefiles/shapefiles.factor +++ b/extra/shapefiles/shapefiles.factor @@ -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 ; + +: 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 ;