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))
  20         (count (length images)))
  21     `(cffi:with-foreign-object (,ids :uint ,count)
  22        (il: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
  46 (defun gen-images (n)
  47   (with-foreign-object (ids :uint n)
  48     (%gen-images n ids)
  49     (loop for i to n collect (mem-aref ids :uint i))))
  50
  51 (defmacro with-bound-image (id &body body)
  52   "Binds ID for the duration of BODY, returning to the previously bound image thereafter."
  53   (let ((old-image (gensym)))
  54     `(let ((,old-image (il:get-integer :cur-image)))
  55        (il:bind-image ,id)
  56        (unwind-protect (progn ,@body)
  57          (il:bind-image ,old-image)))))