On 5/23/06, Luke J Crook <[EMAIL PROTECTED]> wrote:
I've added most of the useful functions and macros from CL-SDL to
lispbuilder-sdl in SVN. I have also included the CL-SDL license and
referenced those functions that were converted (see /documentation/README),
so hopefully the cl-sdl developers won't yell at me.
<snip>
If there are no problems reported then I guess we can make a release in the
next day or two.
I tested the latest revision (r140) with my game in progress.
The new version of get-pixel doesn't work (see below for a better bug
report :)),
it returns nil. Now, the old version worked perfectly.
The new get-pixel function:
<code>
(defun get-pixel(surface x y &key (check-lock-p t))
"Get the pixel at (x, y) as a Uint32 color value
NOTE: The surface must be locked before calling this.
Also NOTE: Have not tested 1,2,3 bpp surfaces, only 4 bpp"
(with-possible-lock-and-update (surface check-lock-p nil x y 1 1)
(let* ((format (cffi:foreign-slot-value surface 'SDL_Surface 'format))
(bpp (foreign-slot-value format 'SDL_PixelFormat 'BytesPerPixel))
(offset (+ (* y (foreign-slot-value surface 'SDL_Surface 'Pitch))
(* x bpp)))
(pixel-address (foreign-slot-value surface 'SDL_Surface 'Pixels)))
(cond
((= bpp 1)
(mem-aref pixel-address :unsigned-char offset))
((= bpp 2)
(mem-aref pixel-address :unsigned-short (/ offset 2)))
((= bpp 3)
; (if (eq SDL_BYTEORDER
SDL_BIG_ENDIAN) ; TODO
(error "3 byte per pixel surfaces not supported yet"))
((= bpp 4)
(mem-aref pixel-address :unsigned-int (/ offset 4)))))))
</code>
The problem is that with-possible-lock-and-update does not return
the return value of @,body, but rather its last form
(SDL_UnlockSurface ,surface),
which returns nil. This version of with-possible-lock-and-update will
do the trick:
<code>
(defmacro with-possible-lock-and-update ((surface check-lock-p
update-p x y w h) &body body)
(let ((locked-p (gensym "LOCKED-P"))
(exit (gensym "EXIT"))
(result (gensym "RESULT")))
`(let ((,locked-p nil)
(,result nil))
(block ,exit
(when ,check-lock-p
(when (must-lock-p ,surface)
(when (< (sdl:SDL_LockSurface ,surface)
0)
(return-from ,exit (values)))
(setf ,locked-p t)))
(setf ,result (progn ,@body))
(when ,locked-p
(SDL_UnlockSurface ,surface))
(when ,update-p
(update-surface ,surface :x ,x :y ,y :w ,w :y ,h))
,result
))))
</code>
Patch follows.
Index: sdl/util-sdl.lisp
===================================================================
--- sdl/util-sdl.lisp (revisjon 140)
+++ sdl/util-sdl.lisp (arbeidskopi)
@@ -52,8 +52,10 @@
;; cl-sdl "cl-sdl.lisp"
(defmacro with-possible-lock-and-update ((surface check-lock-p update-p x y w h) &body body)
(let ((locked-p (gensym "LOCKED-P"))
- (exit (gensym "EXIT")))
- `(let ((,locked-p nil))
+ (exit (gensym "EXIT"))
+ (result (gensym "RESULT")))
+ `(let ((,locked-p nil)
+ (,result nil))
(block ,exit
(when ,check-lock-p
(when (must-lock-p ,surface)
@@ -61,11 +63,12 @@
0)
(return-from ,exit (values)))
(setf ,locked-p t)))
- (progn ,@body)
+ (setf ,result (progn ,@body))
(when ,locked-p
(SDL_UnlockSurface ,surface))
(when ,update-p
(update-surface ,surface :x ,x :y ,y :w ,w :y ,h))
+ ,result
))))
(defmacro with-surface-lock(surface &body body)
_______________________________________________
application-builder mailing list
application-builder@lispniks.com
http://www.lispniks.com/mailman/listinfo/application-builder
