1 ! Copyright (C) 2018 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: arrays combinators io io.binary.fast io.encodings.binary
5 io.files kernel math sequences ;
14 : read-ints ( n -- parts )
15 [ read-int ] replicate ;
17 : read-double ( -- n )
18 8 read le> bits>double ;
20 : read-doubles ( n -- array )
21 [ read-double ] replicate ;
26 : read-range ( -- range )
31 TUPLE: header file-code file-length version shape-type x-min
32 y-min x-max y-max z-min z-max m-min m-max ;
34 : read-header ( -- header )
35 4 read be> dup 9994 assert=
38 read-int dup 1000 assert=
52 : read-point ( -- point )
53 read-double read-double point boa ;
55 : read-points ( n -- points )
56 [ read-point ] replicate ;
58 TUPLE: multipoint box points ;
60 : read-multipoint ( -- multipoint )
61 read-box read-int read-points multipoint boa ;
63 TUPLE: polyline box parts points ;
65 : read-polyline ( -- polyline )
66 read-box read-int read-int [ read-ints ] dip
67 read-points polyline boa ;
69 TUPLE: polygon box parts points ;
71 : read-polygon ( -- polygon )
72 read-box read-int read-int [ read-ints ] dip
73 read-points polygon boa ;
75 TUPLE: point-m x y m ;
77 : read-point-m ( -- point-m )
78 read-double read-double read-double point-m boa ;
80 TUPLE: multipoint-m box points m-range m-array ;
82 : read-multipoint-m ( -- multipoint-m )
84 [ read-points read-range ] [ read-doubles ] bi
87 TUPLE: polyline-m box parts points m-range m-array ;
89 : read-polyline-m ( -- polyline-m )
90 read-box read-int read-int [ read-ints ] dip
91 [ read-points read-range ] [ read-doubles ] bi
94 TUPLE: polygon-m box parts points m-range m-array ;
96 : read-polygon-m ( -- polygon-m )
97 read-box read-int read-int [ read-ints ] dip
98 [ read-points read-range ] [ read-doubles ] bi
101 TUPLE: point-z x y z m ;
103 : read-point-z ( -- point-z )
104 read-double read-double read-double read-double point-z boa ;
106 TUPLE: multipoint-z box points z-range z-array m-range m-array ;
108 : read-multipoint-z ( -- multipoint-z )
110 [ read-points read-range ]
111 [ read-doubles read-range ]
112 [ read-doubles ] tri multipoint-z boa ;
114 TUPLE: polyline-z box parts points z-range z-array m-range
117 : read-polyline-z ( -- polyline-z )
118 read-box read-int read-int [ read-ints ] dip
119 [ read-points read-range ]
120 [ read-doubles read-range ]
121 [ read-doubles ] tri polyline-z boa ;
123 TUPLE: polygon-z box parts points z-range z-array m-range
126 : read-polygon-z ( -- polygon-z )
127 read-box read-int read-int [ read-ints ] dip
128 [ read-points read-range ]
129 [ read-doubles read-range ]
130 [ read-doubles ] tri polygon-z boa ;
132 TUPLE: multipatch box parts points part-types z-range z-array
135 : read-multipatch ( -- multipatch )
136 read-box read-int read-int
137 [ [ read-ints ] [ read-ints ] bi ] dip
138 [ read-points read-range ]
139 [ read-doubles read-range ]
140 [ read-doubles ] tri multipatch boa ;
142 : read-shape ( -- shape )
146 { 3 [ read-polyline ] }
147 { 5 [ read-polygon ] }
148 { 8 [ read-multipoint ] }
149 { 11 [ read-point-z ] }
150 { 13 [ read-polyline-z ] }
151 { 15 [ read-polygon-z ] }
152 { 18 [ read-multipoint-z ] }
153 { 21 [ read-point-m ] }
154 { 23 [ read-polyline-m ] }
155 { 25 [ read-polygon-m ] }
156 { 28 [ read-multipoint-m ] }
157 { 31 [ read-multipatch ] }
160 TUPLE: record number content-length shape ;
162 : read-record ( -- record/f )
163 4 read [ be> 4 read be> read-shape record boa ] [ f ] if* ;
165 : read-records ( -- records )
166 [ read-record dup ] [ ] produce nip ;
168 : read-shp ( -- header shapes )
169 read-header read-records ;
171 : file>shp ( path -- header shapes )
172 binary [ read-shp ] with-file-reader ;
174 TUPLE: index offset content-length ;
176 : read-index ( -- index/f )
177 4 read [ be> 4 read be> index boa ] [ f ] if* ;
179 : read-indices ( -- indices )
180 [ read-index dup ] [ ] produce nip ;
182 : read-shx ( -- header indices )
183 read-header read-indices ;
185 : file>shx ( path -- header indices )
186 binary [ read-shx ] with-file-reader ;