extra/shapefiles/shapefiles.factor

   1 ! Copyright (C) 2018 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: arrays combinators io io.binary.fast io.encodings.binary
   5 io.files kernel math sequences ;
   6
   7 IN: shapefiles
   8
   9 <PRIVATE
  10
  11 : read-int ( -- n )
  12     4 read le> ;
  13
  14 : read-double ( -- n )
  15     8 read le> bits>double ;
  16
  17 : read-box ( -- box )
  18     4 [ read-double ] replicate ;
  19
  20 : read-int-array ( n -- parts )
  21     [ read-int ] replicate ;
  22
  23 : read-range ( -- range )
  24     read-double read-double 2array ;
  25
  26 : read-double-array ( n -- array )
  27     [ read-double ] replicate ;
  28
  29 PRIVATE>
  30
  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 ;
  33
  34 : read-header ( -- header )
  35     4 read be> dup 9994 assert= ! file code
  36     20 read drop ! unused
  37     4 read be> ! file-length
  38     read-int dup 1000 assert= ! version
  39     read-int ! shape-type
  40     read-double ! x-min
  41     read-double ! y-min
  42     read-double ! x-max
  43     read-double ! y-max
  44     read-double ! z-min
  45     read-double ! z-max
  46     read-double ! m-min
  47     read-double ! m-max
  48     header boa ;
  49
  50 TUPLE: point x y ;
  51
  52 : read-point ( -- point )
  53     read-double read-double point boa ;
  54
  55 : read-points ( n -- points )
  56     [ read-point ] replicate ;
  57
  58 TUPLE: multipoint box points ;
  59
  60 : read-multipoint ( -- multipoint )
  61     read-box read-int [ read-point ] replicate multipoint boa ;
  62
  63 TUPLE: polyline box parts points ;
  64
  65 : read-polyline ( -- polyline )
  66     read-box read-int read-int
  67     [ [ read-int ] replicate ]
  68     [ [ read-point ] replicate ] bi*
  69     polyline boa ;
  70
  71 TUPLE: polygon box parts points ;
  72
  73 : read-polygon ( -- polygon )
  74     read-box read-int read-int
  75     [ read-int-array ] [ read-points ] bi*
  76     polygon boa ;
  77
  78 TUPLE: point-m x y m ;
  79
  80 : read-point-m ( -- point-m )
  81     read-double read-double read-double point-m boa ;
  82
  83 TUPLE: multipoint-m box points m-range m-array ;
  84
  85 : read-multipoint-m ( -- multipoint-m )
  86     read-box read-int
  87     [ read-points read-range ] [ read-double-array ] bi
  88     multipoint-m boa ;
  89
  90 TUPLE: polyline-m box parts points m-range m-array ;
  91
  92 : read-polyline-m ( -- polyline-m )
  93     read-box read-int read-int [ read-int-array ] dip
  94     [ read-points read-range ] [ read-double-array ] bi
  95     polyline-m boa ;
  96
  97 TUPLE: polygon-m box parts points m-range m-array ;
  98
  99 : read-polygon-m ( -- polyline-m )
 100     read-box read-int read-int [ read-int-array ] dip
 101     [ read-points read-range ] [ read-double-array ] bi
 102     polygon-m boa ;
 103
 104 TUPLE: point-z x y z m ;
 105
 106 : read-point-z ( -- point-z )
 107     read-double read-double read-double read-double point-z boa ;
 108
 109 TUPLE: multipoint-z box points z-range z-array m-range m-array ;
 110
 111 : read-multipoint-z ( -- multipoint-z )
 112     read-box read-int
 113     [ read-points read-range ]
 114     [ read-double-array read-range ]
 115     [ read-double-array ] tri multipoint-z boa ;
 116
 117 TUPLE: polyline-z box parts points z-range z-array m-range
 118 m-array ;
 119
 120 : read-polyline-z ( -- polyline-z )
 121     read-box read-int read-int [ read-int-array ] dip
 122     [ read-points read-range ]
 123     [ read-double-array read-range ]
 124     [ read-double-array ] tri polyline-z boa ;
 125
 126 TUPLE: polygon-z box parts points z-range z-array m-range
 127 m-array ;
 128
 129 : read-polygon-z ( -- polyline-z )
 130     read-box read-int read-int [ read-int-array ] dip
 131     [ read-points read-range ]
 132     [ read-double-array read-range ]
 133     [ read-double-array ] tri polygon-z boa ;
 134
 135 TUPLE: multipatch box parts points part-types z-range z-array
 136 m-range m-array ;
 137
 138 : read-multipatch ( -- multipatch )
 139     read-box read-int read-int
 140     [ [ read-int-array ] [ read-int-array ] bi ] dip
 141     [ read-points read-range ]
 142     [ read-double-array read-range ]
 143     [ read-double-array ] tri multipatch boa ;
 144
 145 : read-shape ( -- shape )
 146     4 read le> {
 147         { 0 [ null ] }
 148         { 1 [ read-point ] }
 149         { 3 [ read-polyline ] }
 150         { 5 [ read-polygon ] }
 151         { 8 [ read-multipoint ] }
 152         { 11 [ read-point-z ] }
 153         { 13 [ read-polyline-z ] }
 154         { 15 [ read-polygon-z ] }
 155         { 18 [ read-multipoint-z ] }
 156         { 21 [ read-point-m ] }
 157         { 23 [ read-polyline-m ] }
 158         { 25 [ read-polygon-m ] }
 159         { 28 [ read-multipoint-m ] }
 160         { 31 [ read-multipatch ] }
 161     } case ;
 162
 163 TUPLE: record number content-length shape ;
 164
 165 : read-record ( -- record/f )
 166     4 read [ be> 4 read be> read-shape record boa ] [ f ] if* ;
 167
 168 : read-records ( -- records )
 169     [ read-record dup ] [ ] produce nip ;
 170
 171 : read-shp ( -- header shapes )
 172     read-header read-records ;
 173
 174 : file>shp ( path -- header shapes )
 175     binary [ read-shp ] with-file-reader ;
 176
 177 TUPLE: index offset content-length ;
 178
 179 : read-index ( -- index/f )
 180     4 read [ be> 4 read be> index boa ] [ f ] if* ;
 181
 182 : read-indices ( -- indices )
 183     [ read-index dup ] [ ] produce nip ;
 184
 185 : read-shx ( -- header indices )
 186     read-header read-indices ;
 187
 188 : file>shx ( path -- header indices )
 189     binary [ read-shx ] with-file-reader ;