1 (define-module (gdal extension)
2 #:use-module (system foreign)
3 #:use-module (rnrs bytevectors)
4 #:use-module (srfi srfi-4 gnu)
5 #:use-module (ice-9 streams)
6 #:use-module (gdal config)
7 #:use-module (gdal internal)
10 ;;------------------------------------------------------------------------------
14 ;;------------------------------------------------------------------------------
16 (define *buffer-makers*
17 `((,GDT_BYTE . ,make-u8vector)
18 (,GDT_UINT16 . ,make-u16vector)
19 (,GDT_INT16 . ,make-s16vector)
20 (,GDT_UINT32 . ,make-u32vector)
21 (,GDT_INT32 . ,make-s32vector)
22 (,GDT_FLOAT32 . ,make-f32vector)
23 (,GDT_FLOAT64 . ,make-f64vector)
24 (,GDT_CFLOAT32 . ,make-c32vector)
25 (,GDT_CFLOAT64 . ,make-c64vector)))
28 `((,GDT_BYTE . ,u8vector-ref)
29 (,GDT_UINT16 . ,u16vector-ref)
30 (,GDT_INT16 . ,s16vector-ref)
31 (,GDT_UINT32 . ,u32vector-ref)
32 (,GDT_INT32 . ,s32vector-ref)
33 (,GDT_FLOAT32 . ,f32vector-ref)
34 (,GDT_FLOAT64 . ,f64vector-ref)
35 (,GDT_CFLOAT32 . ,c32vector-ref)
36 (,GDT_CFLOAT64 . ,c64vector-ref)))
38 (define *buffer-setters*
39 `((,GDT_BYTE . ,u8vector-set!)
40 (,GDT_UINT16 . ,u16vector-set!)
41 (,GDT_INT16 . ,s16vector-set!)
42 (,GDT_UINT32 . ,u32vector-set!)
43 (,GDT_INT32 . ,s32vector-set!)
44 (,GDT_FLOAT32 . ,f32vector-set!)
45 (,GDT_FLOAT64 . ,f64vector-set!)
46 (,GDT_CFLOAT32 . ,c32vector-set!)
47 (,GDT_CFLOAT64 . ,c64vector-set!)))
49 ;;------------------------------------------------------------------------------
51 (define* (make-buffer x-size y-size buf-type
52 #:optional (h-band %null-pointer)
54 "Creates a raster buffer of SRFI-4 vector with internal properties for
55 the use of extension functions.
58 x-size: the width of the region.
59 y-size: the height of the region.
60 buf-type: the type of the pixel values to be returned.
63 h-band: a target band of GDALRasterBandH.
64 x-off: the pixel offset to the top left corner of the region of the
66 y-off: the line offset to the top left corner of the region of the
70 Types GDT_CINT16 and GDT_CINT32 are not supported due to limitations in
71 SRFI-4 vectors. Use raster-io for reading these values."
72 (let* ((size (* x-size y-size))
73 (bv ((assv-ref *buffer-makers* buf-type) size)))
74 (set! (%gdal-h-band% bv) h-band)
75 (set! (%gdal-type% bv) buf-type)
76 (set! (%gdal-x-off% bv) x-off)
77 (set! (%gdal-y-off% bv) y-off)
78 (set! (%gdal-x-size% bv) x-size)
79 (set! (%gdal-y-size% bv) y-size)
84 ;;------------------------------------------------------------------------------
86 (define* (copy-buffer data #:optional (copy-data #t)
87 (buf-type (%gdal-type% data)))
88 "Copies a raster buffer of SRFI-4 vector with internal properties for
89 the use of extension functions.
92 data: data buffer to copy.
95 copy-data: copy pixel values. by default it's true.
96 buf-type: data type for the destination buffer."
97 (let* ((size (* (%gdal-x-size% data) (%gdal-y-size% data)))
98 (buffer-ref (assv-ref *buffer-refs* (%gdal-type% data)))
99 (buffer-set! (assv-ref *buffer-setters* buf-type))
100 (bv ((assv-ref *buffer-makers* buf-type) size)))
102 (set! (%gdal-h-band% bv) (%gdal-h-band% data))
103 (set! (%gdal-type% bv) buf-type)
104 (set! (%gdal-x-off% bv) (%gdal-x-off% data))
105 (set! (%gdal-y-off% bv) (%gdal-y-off% data))
106 (set! (%gdal-x-size% bv) (%gdal-x-size% data))
107 (set! (%gdal-y-size% bv) (%gdal-y-size% data))
109 (for-each (lambda (offset) (buffer-set! bv offset
110 (buffer-ref data offset)))
116 ;;------------------------------------------------------------------------------
118 (define (make-buffer-from-band h-band x-off y-off x-size y-size buf-type)
119 "Read a region of image data for this band.
121 Returns the raster buffer which is also SRFI-4 vector with internal properties
122 for the use of extension functions. If the access fails, it reports error.
125 h-band: a handle representing GDALRasterBandH.
126 x-off: the pixel offset to the top left corner of the region of the band.
127 y-off: the line offset to the top left corner of the region of the band.
128 x-size: the width of the region of the band.
129 y-size: the height of the region of the band.
130 buf-type: the type of the pixel values to be returned.
133 Types GDT_CINT16 and GDT_CINT32 are not supported due to limitations in
134 SRFI-4 vectors. Use raster-io for reading these values."
135 (let* ((size (* x-size y-size))
136 (bv ((assv-ref *buffer-makers* buf-type) size)))
137 (raster-io h-band GF_READ x-off y-off x-size y-size bv
138 x-size y-size buf-type 0 0)
139 (set! (%gdal-h-band% bv) h-band)
140 (set! (%gdal-type% bv) buf-type)
141 (set! (%gdal-x-off% bv) x-off)
142 (set! (%gdal-y-off% bv) y-off)
143 (set! (%gdal-x-size% bv) x-size)
144 (set! (%gdal-y-size% bv) y-size)
147 (export make-buffer-from-band)
149 ;;------------------------------------------------------------------------------
151 (define (make-buffer-all-from-band h-band buf-type)
152 "Read entire region of image data for this band.
154 Returns a raster buffer of SRFI-4 vector with internal properties for the use
155 of extension functions. If the access fails, it reports error.
158 h-band: a handle representing GDALRasterBandH.
159 buf-type: the type of the pixel values to be returned.
162 Types GDT_CINT16 and GDT_CINT32 are not supported due to limitations in
163 SRFI-4 vectors. Use raster-io for reading these values."
164 (let* ((x-size (get-raster-band-x-size h-band))
165 (y-size (get-raster-band-y-size h-band))
166 (size (* x-size y-size))
167 (bv ((assv-ref *buffer-makers* buf-type) size)))
168 (raster-io h-band GF_READ 0 0 x-size y-size bv
169 x-size y-size buf-type 0 0)
170 (set! (%gdal-h-band% bv) h-band)
171 (set! (%gdal-type% bv) buf-type)
172 (set! (%gdal-x-off% bv) 0)
173 (set! (%gdal-y-off% bv) 0)
174 (set! (%gdal-x-size% bv) x-size)
175 (set! (%gdal-y-size% bv) y-size)
178 (export make-buffer-all-from-band)
180 ;;------------------------------------------------------------------------------
182 (define (overwrite-buffer-in-band data)
183 "Overwrite raster buffer in the associated band of the data.
185 If the access fails, it reports error. Otherwise it returns void.
188 data: the raster buffer to be written."
189 (raster-io (%gdal-h-band% data) GF_WRITE (%gdal-x-off% data)
190 (%gdal-y-off% data) (%gdal-x-size% data)
191 (%gdal-y-size% data) data
192 (%gdal-x-size% data) (%gdal-y-size% data)
193 (%gdal-type% data) 0 0))
195 (export overwrite-buffer-in-band)
197 ;;------------------------------------------------------------------------------
199 (define (add-offset-to-geo-transform geo-transform x-off y-off)
200 (let ((t-0 (list-ref geo-transform 0))
201 (t-1 (list-ref geo-transform 1))
202 (t-2 (list-ref geo-transform 2))
203 (t-3 (list-ref geo-transform 3))
204 (t-4 (list-ref geo-transform 4))
205 (t-5 (list-ref geo-transform 5)))
206 (let ((ot-0 (+ t-0 (* x-off t-1) (* y-off t-2)))
207 (ot-3 (+ t-3 (* x-off t-4) (* y-off t-5))))
208 (list ot-0 t-1 t-2 ot-3 t-4 t-5))))
210 ;;------------------------------------------------------------------------------
212 (define* (write-buffer-to-file data driver-short-name
213 file-name #:key (no-data #f))
214 "Write raster buffer to a new file.
216 If the access fails, it reports error. Otherwise it returns void.
219 data: the raster buffer to be written.
220 driver-short-name: the short name of the driver, such as 'GTiff' as a
221 string or GDN_GTIFF as an enum (see GDN_*), being searched for.
222 file-name: the name of the dataset to create.
225 no-data: no data value."
226 (let* ((driver (get-driver-by-name driver-short-name))
227 (dataset (create-dataset driver file-name (%gdal-x-size% data)
228 (%gdal-y-size% data) 1 (%gdal-type% data)))
229 (h-band (get-raster-band dataset 1))
231 (get-geo-transform (get-band-dataset (%gdal-h-band% data))))
233 (get-projection-ref (get-band-dataset (%gdal-h-band% data)))))
235 (set-projection dataset projection)
236 (if no-data (set-raster-no-data-value h-band no-data))
237 (set-geo-transform dataset
238 (add-offset-to-geo-transform geo-transform
242 (raster-io h-band GF_WRITE 0
243 0 (%gdal-x-size% data)
244 (%gdal-y-size% data) data
245 (%gdal-x-size% data) (%gdal-y-size% data)
246 (%gdal-type% data) 0 0)
247 (close-dataset dataset))))
249 (export write-buffer-to-file)
251 ;;------------------------------------------------------------------------------
253 (define (read-buffer-pixel data x-off y-off)
254 "Read a pixel value of the the raster buffer.
257 data: the raster vector.
258 x-off: the pixel offset to the top left corner of the data.
259 y-off: the line offset to the top left corner of the data."
260 (let ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data)))
261 (offset (+ x-off (* y-off (%gdal-x-size% data)))))
262 (buffer-ref data offset)))
264 (export read-buffer-pixel)
266 ;;------------------------------------------------------------------------------
268 (define (for-each-pixel proc data)
269 "Apply proc to each element in the buffer, discarding the returned value.
272 proc: the producedure.
273 data: the raster vector."
274 (let ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data)))
275 (size (* (%gdal-x-size% data) (%gdal-y-size% data))))
276 (for-each (lambda (offset) (proc (buffer-ref data offset))) (iota size))))
278 (export for-each-pixel)
280 ;;------------------------------------------------------------------------------
282 (define* (map-pixel proc data #:key (buf-type (%gdal-type% data)))
283 "Apply proc to each element in the buffer and return a new buffer.
286 proc: the producedure.
287 data: the raster vector.
288 buf-type: data type of pixel values of the destination buffer."
289 (let ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data)))
290 (buffer-set! (assv-ref *buffer-setters* buf-type))
291 (size (* (%gdal-x-size% data) (%gdal-y-size% data)))
292 (bv (copy-buffer data #f buf-type)))
294 (for-each (lambda (offset) (buffer-set! bv offset
295 (proc (buffer-ref data offset))))
301 ;;------------------------------------------------------------------------------
303 (define (write-buffer-pixel! data x-off y-off value)
304 "Write a pixel value in the raster buffer.
307 data: the raster vector.
308 x-off: the pixel offset to the top left corner of the data.
309 y-off: the line offset to the top left corner of the data.
310 value: the pixel value."
311 (let ((buffer-set! (assv-ref *buffer-setters* (%gdal-type% data)))
312 (offset (+ x-off (* y-off (%gdal-x-size% data)))))
313 (buffer-set! data offset value)))
315 (export write-buffer-pixel!)
317 ;;------------------------------------------------------------------------------
319 ;; TODO: copy the data into temp
320 (define (buffer->stream data)
321 "Creates a raster stream with the content of raster buffer.
324 data: the raster buffer."
325 (let* ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data)))
326 (size (* (%gdal-x-size% data) (%gdal-y-size% data)))
327 (stream (make-stream (lambda (offset)
330 (cons (buffer-ref data offset)
333 (set! (%gdal-h-band% stream) (%gdal-h-band% data))
334 (set! (%gdal-type% stream) (%gdal-type% data))
335 (set! (%gdal-x-off% stream) (%gdal-x-off% data))
336 (set! (%gdal-y-off% stream) (%gdal-y-off% data))
337 (set! (%gdal-x-size% stream) (%gdal-x-size% data))
338 (set! (%gdal-y-size% stream) (%gdal-y-size% data))
341 (export buffer->stream)
343 ;;------------------------------------------------------------------------------
345 (define (stream->buffer stream)
346 "Creates a raster buffer with the content of raster stream.
349 stream: the raster stream."
350 (let* ((size (* (%gdal-x-size% stream) (%gdal-y-size% stream)))
351 (stream-type (%gdal-type% stream))
352 (data ((assv-ref *buffer-makers* stream-type) size))
353 (buffer-set! (assv-ref *buffer-setters* stream-type)))
354 (let loop ((rest stream)
356 (if (stream-null? rest)
358 (set! (%gdal-h-band% data) (%gdal-h-band% stream))
359 (set! (%gdal-type% data) (%gdal-type% stream))
360 (set! (%gdal-x-off% data) (%gdal-x-off% stream))
361 (set! (%gdal-y-off% data) (%gdal-y-off% stream))
362 (set! (%gdal-x-size% data) (%gdal-x-size% stream))
363 (set! (%gdal-y-size% data) (%gdal-y-size% stream))
366 (buffer-set! data index (stream-car rest))
367 (loop (stream-cdr rest) (1+ index)))))))
369 (export stream->buffer)
371 ;;------------------------------------------------------------------------------