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=
54 : read-point ( -- point )
55 read-double read-double point boa ;
57 : read-points ( n -- points )
58 [ read-point ] replicate ;
60 TUPLE: multipoint box points ;
62 : read-multipoint ( -- multipoint )
63 read-box read-int read-points multipoint boa ;
65 TUPLE: polyline box parts points ;
67 : read-polyline ( -- polyline )
68 read-box read-int read-int [ read-ints ] dip
69 read-points polyline boa ;
71 TUPLE: polygon box parts points ;
73 : read-polygon ( -- polygon )
74 read-box read-int read-int [ read-ints ] dip
75 read-points polygon boa ;
77 TUPLE: point-z x y z m ;
79 : read-point-z ( -- point-z )
80 read-double read-double read-double read-double point-z boa ;
82 TUPLE: polyline-z box parts points z-range z-array m-range
85 : read-polyline-z ( -- polyline-z )
86 read-box read-int read-int [ read-ints ] dip
87 [ read-points read-range ]
88 [ read-doubles read-range ]
89 [ read-doubles ] tri polyline-z boa ;
91 TUPLE: polygon-z box parts points z-range z-array m-range
94 : read-polygon-z ( -- polygon-z )
95 read-box read-int read-int [ read-ints ] dip
96 [ read-points read-range ]
97 [ read-doubles read-range ]
98 [ read-doubles ] tri polygon-z boa ;
100 TUPLE: multipoint-z box points z-range z-array m-range m-array ;
102 : read-multipoint-z ( -- multipoint-z )
104 [ read-points read-range ]
105 [ read-doubles read-range ]
106 [ read-doubles ] tri multipoint-z boa ;
108 TUPLE: point-m x y m ;
110 : read-point-m ( -- point-m )
111 read-double read-double read-double point-m boa ;
113 TUPLE: polyline-m box parts points m-range m-array ;
115 : read-polyline-m ( -- polyline-m )
116 read-box read-int read-int [ read-ints ] dip
117 [ read-points read-range ] [ read-doubles ] bi
120 TUPLE: polygon-m box parts points m-range m-array ;
122 : read-polygon-m ( -- polygon-m )
123 read-box read-int read-int [ read-ints ] dip
124 [ read-points read-range ] [ read-doubles ] bi
127 TUPLE: multipoint-m box points m-range m-array ;
129 : read-multipoint-m ( -- multipoint-m )
131 [ read-points read-range ] [ read-doubles ] bi
134 TUPLE: multipatch box parts part-types points z-range z-array
137 : read-multipatch ( -- multipatch )
138 read-box read-int read-int
139 [ [ read-ints ] [ read-ints ] bi ] dip
140 [ read-points read-range ]
141 [ read-doubles read-range ]
142 [ read-doubles ] tri multipatch boa ;
144 : read-shape ( -- shape )
148 { 3 [ read-polyline ] }
149 { 5 [ read-polygon ] }
150 { 8 [ read-multipoint ] }
151 { 11 [ read-point-z ] }
152 { 13 [ read-polyline-z ] }
153 { 15 [ read-polygon-z ] }
154 { 18 [ read-multipoint-z ] }
155 { 21 [ read-point-m ] }
156 { 23 [ read-polyline-m ] }
157 { 25 [ read-polygon-m ] }
158 { 28 [ read-multipoint-m ] }
159 { 31 [ read-multipatch ] }
162 TUPLE: record number content-length shape ;
164 : read-record ( -- record/f )
165 4 read [ be> 4 read be> read-shape record boa ] [ f ] if* ;
167 : read-records ( -- records )
168 [ read-record dup ] [ ] produce nip ;
170 : read-shp ( -- header records )
171 read-header read-records ;
173 : file>shp ( path -- header records )
174 binary [ read-shp ] with-file-reader ;
176 TUPLE: index offset content-length ;
178 : read-index ( -- index/f )
179 4 read [ be> 4 read be> index boa ] [ f ] if* ;
181 : read-indices ( -- indices )
182 [ read-index dup ] [ ] produce nip ;
184 : read-shx ( -- header indices )
185 read-header read-indices ;
187 : file>shx ( path -- header indices )
188 binary [ read-shx ] with-file-reader ;