utilities.lisp

   1
   2 (in-package :cl-devil)
   3
   4 (defun w-i-args-helper (args)
   5   (when args
   6     `((bind-image it)
   7       ,(cons
   8         (cond ((= 1 (length args)) 'il:load-image)
   9               ((= 3 (length args)) 'il:load-l)
  10               ((stringp (second args)) 'il:load)
  11               (t 'il:load-f))
  12         args))))
  13
  14 ;;; XXX I don't like the potential confusion between WITH-BOUND-IMAGE
  15 ;;; and WITH-IMAGES, but WITH-NEW-IMAGES and WITH-LOADED-IMAGES all
  16 ;;; give the wrong impression, alas.
  17 (defmacro with-images ((&rest images) &body body)
  18   "Generates an IL image for each of IMAGES, binding and loading if a parameter is supplied.  BODY is executed, and the images are freed thereafter."
  19   (let ((ids (gensym "IDS"))
  20         (count (length images)))
  21     `(cffi:with-foreign-object (,ids :uint ,count)
  22        (%gen-images ,count ,ids)
  23        (unwind-protect
  24             (let (,@(loop for x in images
  25                        for (var . args) = (if (listp x) x (list x))
  26                        for i from 0
  27                        collect `(,var (anaphora:aprog1 (cffi:mem-aref ,ids :uint ,i)
  28                                         ,@(w-i-args-helper args)))))
  29               ,@body)
  30          (il:delete-images ,count ,ids)))))
  31
  32 (defmacro with-init (&body body)
  33   `(progn (init)
  34           (unwind-protect (progn ,@body)
  35             (shutdown))))
  36
  37 (defun width-of (id)
  38   (bind-image id)
  39   (get-integer :image-width))
  40
  41 (defun height-of (id)
  42   (bind-image id)
  43   (get-integer :image-height))
  44
  45 (defun pixel-format-of (id)
  46   (bind-image id)
  47   (foreign-enum-keyword 'data-format (get-integer :image-format)))
  48
  49 (defun element-type-of (id)
  50   (bind-image id)
  51   (foreign-enum-keyword 'data-type (get-integer :image-type)))
  52
  53 (defun bytes-per-pixel-of (id)
  54   (bind-image id)
  55   (get-integer :image-bytes-per-pixel))
  56
  57 (defun copy-palette (dest src)
  58   (bind-image src)
  59   (let ((type (get-integer :palette-type))
  60         (ncols (get-integer :palette-num-cols))
  61         (bpp (get-integer :palette-bpp))
  62         (pointer (get-palette)))
  63     (bind-image dest)
  64     (register-palette pointer (* ncols bpp) type)))
  65
  66 (defun gen-images (n)
  67   (with-foreign-object (ids :uint n)
  68     (%gen-images n ids)
  69     (loop for i to n collect (mem-aref ids :uint i))))
  70
  71 (defmacro with-bound-image (id &body body)
  72   "Binds ID for the duration of BODY, returning to the previously bound image thereafter."
  73   (let ((old-image (gensym)))
  74     `(let ((,old-image (il:get-integer :cur-image)))
  75        (il:bind-image ,id)
  76        (unwind-protect (progn ,@body)
  77          (il:bind-image ,old-image)))))