vol-macros.lisp

   1 ;; macros to handle volumes
   2
   3 (in-package :vol)
   4
   5 (defmacro with-arrays (arrays &body body)
   6   "Provides a corresponding accessor for each array as a local macro,
   7 so that (ARRAY ...) corresponds to (AREF ARRAY ...)."
   8   `(macrolet ,(mapcar (lambda (array)
   9                         `(,array (&rest indices) `(aref ,',array ,@indices)))
  10                       arrays)
  11      ,@body))
  12
  13
  14 (defmacro do-region ((indices end &optional (start '(0 0 0))) &body body)
  15   "Write intertwined loops to traverse a vector, an image or a volume."
  16   (unless (and (= (length indices)
  17                   (length end)))
  18     (error "Number of indices and interval-ends are not equal."))
  19   (labels ((rec (ind end start acc) ;; several loops
  20              (if (null end)
  21                  acc
  22                  (rec (cdr ind) (cdr end) (cdr start)
  23                       `((loop for ,(car ind) from ,(car start)
  24                            below ,(car end) do ,@acc))))))
  25     (first (rec (reverse indices) ;; first index is outermost loop
  26                 (reverse end)
  27                 (reverse start) body))))
  28 #+nil
  29 (let ((sum 0))
  30   (do-region ((k j i) (4 4 5))
  31     (incf sum (+ k j i)))
  32   sum)
  33
  34
  35 (defmacro with-slice ((slice-array array slice-nr) &body body)
  36   "Returns SLICE-NRth slice of ARRAY as the 2D SLICE-ARRAY."
  37   (alexandria:with-gensyms (x y z)
  38     `(destructuring-bind (,z ,y ,x)
  39          (array-dimensions ,array)
  40        (when (or (< ,slice-nr 0) (<= ,z ,slice-nr))
  41          (error "slice-nr=~d out of range [0,~d]" ,slice-nr (1- ,z)))
  42        (let* ((,slice-array (make-array (list ,y ,x)
  43                                         :element-type '(unsigned-byte 8)
  44                                         :displaced-to ,array
  45                                         :displaced-index-offset (* ,slice-nr ,x ,y))))
  46          ,@body))))