[imago-devel] IMAGO images <-> SDL surfaces

[Vladimir Sedach]

Hello,

I've written a bit of code to shuffle between IMAGO images and SDL
surfaces. It should be fast enough to do manipulations on small
sprites in real-time on a reasonably fast machine. It only works on
RGB(A) images, since I found the overhead for extracting/packing
channels is too high. Blitting versions forthcoming when I need them
and figure out a good interface for specifying rectangles (for some
reason SDL's don't seem all that good to me).

(large-ish) screenshot:
http://members.shaw.ca/vsedach/imago_sdl_screen.png

Vladimir

PS - I think my version of with-surface-lock is more correct than the
one that comes with cl-sdl right now (sdl:with-locked-surface).

Here are the goodies:

(declaim (optimize (speed 3) (safety 0)))

(defmacro with-surface-lock (surface &body body)
  (let ((surf (gensym "surface-lock-")))
    `(let ((,surf ,surface))
       (when (/= 0 (sdl:lock-surface ,surf))
         (error "Couldn't lock SDL surface ~A" ,surf))
       (unwind-protect (progn , at body) (sdl:unlock-surface ,surf)))))

(defun convert-to-image (surface)
  "Given a 24 or 32-bit depth SDL surface, returns an IMAGO RGB image
of the same width and height and RGB pixel contents."
  (assert (or (= 24 (sdl:pixel-format-bits-per-pixel (sdl:surface-format
surface)))
              (= 32 (sdl:pixel-format-bits-per-pixel (sdl:surface-format
surface)))))
  (let* ((width (sdl:surface-w surface)) (height (sdl:surface-h surface))
         (image (make-instance 'imago:rgb-image :width width :height height))
         (image-array (imago:image-pixels image)))
    ;; Note that on 32 bit machines, width and height are 32 bit ints
    (declare (type fixnum width height) (type (simple-array (unsigned-byte
32) (* *)) image-array))
    (with-surface-lock surface
      (dotimes (y height)
        (declare (type fixnum y))
        (dotimes (x width)
          (declare (type fixnum x))
          (setf (aref image-array y x) (sdl:get-pixel surface x y)))))
    image))

(defmethod convert-to-surface ((image imago:rgb-image) &optional (depth 24))
  "Given an IMAGO RGB image, returns an SDL surface of <depth> bit color
depth and the same width and height."
  (let* ((width (imago:image-width image)) (height (imago:image-height
image))
         (image-array (imago:image-pixels image))
         (surface (sdl:create-rgb-surface sdl:+swsurface+ width height depth 0 0
0 0)))
    (declare (type fixnum width height) (type (simple-array (unsigned-byte
32) (* *)) image-array))
    (with-surface-lock surface
      (dotimes (y height)
        (declare (type fixnum y))
        (dotimes (x width)
          (declare (type fixnum x))
          (sdl:faster-draw-pixel surface x y (aref image-array y x)))))
    surface))