[ab] Fast pixel access

[Anthony Fairchild]

On 12/8/06, Justin Heyes-Jones <justinhj at gmail.com> wrote:
> I think it would be a good idea to add a fast pixel example to the examples.
>
> Something that demonstrates the different get and set pixel methods
> along with generate ones.
>

I agree.   I offer my latest rotation function as a an example.  I'm
not proud of the complexity so maybe others can offer suggestions to
make it smaller ;-)

(defun rotate-surface(surf degrees)
  "rotates a surface 0, 90, 180, or 270 degrees"
  (declare (type fixnum degrees)
           (optimize (speed 3)(safety 0)))
  ;;(assert (member degrees '(0 90 180 270)))
  (if (= 0 degrees)
        ;; in the case of 0 degrees, just return the surface
        surf
        ;; else do rotation
        (let* ((w (sdl:surf-w surf))
               (h (sdl:surf-h surf))
               (even (evenp (/ degrees 90)))
               (new-w (if even h w))
               (new-h (if even w h))
               (new-surf (sdl:create-surface new-w new-h :surface surf))
               (new-x (case degrees
                        (90  #'(lambda (x y)
                                 (declare (ignore x)(type fixnum x y))
                                 (+ (1- new-w) (- 0 y))))
                        (180 #'(lambda (x y)
                                 (declare (ignore y)(type fixnum x y))
                                 (+ (1- new-w) (- 0 x))))
                        (270 #'(lambda (x y)
                                 (declare (ignore x)(type fixnum x y))
                                 y))))
               (new-y (case degrees
                        (90  #'(lambda (x y)
                                 (declare (ignore y)(type fixnum x y))
                                       x))
                        (180 #'(lambda (x y)
                                 (declare (ignore x)(type fixnum x y))
                                 (+ (1- new-h) (- 0 y))))
                        (270 #'(lambda (x y)
                                 (declare (ignore y)(type fixnum x y))
                                 (+ (1- new-h) (- 0 x)))))))
          (sdl:with-possible-lock-and-update (:surface new-surf)
            (sdl:with-possible-lock-and-update (:surface surf)
              (let ((read-pix (sdl:generate-read-pixel surf))
                    (write-pix(sdl:generate-write-pixel new-surf)))
                (loop :for x :from 0 :to (1- w)
                   :do (loop :for y :from 0 :to (1- h)
                          :do (let ((pixel (funcall read-pix x y)))
                                (funcall write-pix
                                         (funcall new-x x y)
                                         (funcall new-y x y)
                                         pixel)))))))
          new-surf)))