www.artulab.com Git - guile-gdal/blob - gdal/extension.scm

   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)
   8   #:use-module (gdal))
   9
  10 ;;------------------------------------------------------------------------------
  11
  12 ;;; Helper Functions
  13
  14 ;;------------------------------------------------------------------------------
  15
  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)))
  26
  27 (define *buffer-refs*
  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)))
  37
  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!)))
  48
  49 ;;------------------------------------------------------------------------------
  50
  51 (define* (make-buffer x-size y-size buf-type
  52                              #:optional (h-band %null-pointer)
  53                              (x-off 0) (y-off 0))
  54     "Creates a raster buffer of SRFI-4 vector with internal properties for
  55 the use of extension functions.
  56
  57 Parameters:
  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.
  61
  62 Optional Parameters:
  63     h-band: a target band of GDALRasterBandH.
  64     x-off: the pixel offset to the top left corner of the region of the
  65 target band.
  66     y-off: the line offset to the top left corner of the region of the
  67 target band.
  68
  69 Note:
  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)
  80     bv))
  81
  82 (export make-buffer)
  83
  84 ;;------------------------------------------------------------------------------
  85
  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.
  90
  91 Parameters:
  92     data: data buffer to copy.
  93
  94 Optional Parameters:
  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)))
 101     (begin
 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))
 108         (if copy-data
 109           (for-each (lambda (offset) (buffer-set! bv offset
 110                                                     (buffer-ref data offset)))
 111                       (iota size)))
 112         bv)))
 113
 114 (export copy-buffer)
 115
 116 ;;------------------------------------------------------------------------------
 117
 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.
 120
 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.
 123
 124 Parameters:
 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.
 131
 132 Note:
 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)
 145     bv))
 146
 147 (export make-buffer-from-band)
 148
 149 ;;------------------------------------------------------------------------------
 150
 151 (define (make-buffer-all-from-band h-band buf-type)
 152     "Read entire region of image data for this band.
 153
 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.
 156
 157 Parameters:
 158     h-band: a handle representing GDALRasterBandH.
 159     buf-type: the type of the pixel values to be returned.
 160
 161 Note:
 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)
 176     bv))
 177
 178 (export make-buffer-all-from-band)
 179
 180 ;;------------------------------------------------------------------------------
 181
 182 (define (overwrite-buffer-in-band data)
 183     "Overwrite raster buffer in the associated band of the data.
 184
 185 If the access fails, it reports error. Otherwise it returns void.
 186
 187 Parameters:
 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))
 194
 195 (export overwrite-buffer-in-band)
 196
 197 ;;------------------------------------------------------------------------------
 198
 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))))
 209
 210 ;;------------------------------------------------------------------------------
 211
 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.
 215
 216 If the access fails, it reports error. Otherwise it returns void.
 217
 218 Parameters:
 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.
 223
 224 Optional Parameters:
 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))
 230            (geo-transform
 231             (get-geo-transform (get-band-dataset (%gdal-h-band% data))))
 232            (projection
 233             (get-projection-ref (get-band-dataset (%gdal-h-band% data)))))
 234         (begin
 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
 239                                                             (%gdal-x-off% data)
 240                                                             (%gdal-y-off% data)
 241                                                             ))
 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))))
 248
 249 (export write-buffer-to-file)
 250
 251 ;;------------------------------------------------------------------------------
 252
 253 (define (read-buffer-pixel data x-off y-off)
 254     "Read a pixel value of the the raster buffer.
 255
 256 Parameters:
 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)))
 263
 264 (export read-buffer-pixel)
 265
 266 ;;------------------------------------------------------------------------------
 267
 268 (define (for-each-pixel proc data)
 269     "Apply proc to each element in the buffer, discarding the returned value.
 270
 271 Parameters:
 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))))
 277
 278 (export for-each-pixel)
 279
 280 ;;------------------------------------------------------------------------------
 281
 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.
 284
 285 Parameters:
 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)))
 293     (begin
 294         (for-each (lambda (offset) (buffer-set! bv offset
 295                                     (proc (buffer-ref data offset))))
 296             (iota size))
 297         bv)))
 298
 299 (export map-pixel)
 300
 301 ;;------------------------------------------------------------------------------
 302
 303 (define (write-buffer-pixel! data x-off y-off value)
 304     "Write a pixel value in the raster buffer.
 305
 306 Parameters:
 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)))
 314
 315 (export write-buffer-pixel!)
 316
 317 ;;------------------------------------------------------------------------------
 318
 319 ;; TODO: copy the data into temp
 320 (define (buffer->stream data)
 321     "Creates a raster stream with the content of raster buffer.
 322
 323 Parameters:
 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)
 328                                      (if (= offset size)
 329                                        '()
 330                                        (cons (buffer-ref data offset)
 331                                              (1+ offset))))
 332                              0)))
 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))
 339     stream))
 340
 341 (export buffer->stream)
 342
 343 ;;------------------------------------------------------------------------------
 344
 345 (define (stream->buffer stream)
 346     "Creates a raster buffer with the content of raster stream.
 347
 348 Parameters:
 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)
 355                (index 0))
 356       (if (stream-null? rest)
 357         (begin
 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))
 364           data)
 365         (begin
 366          (buffer-set! data index (stream-car rest))
 367          (loop (stream-cdr rest) (1+ index)))))))
 368
 369 (export stream->buffer)
 370
 371 ;;------------------------------------------------------------------------------