July 2004 - corman-sdl-cvs@common-lisp.net

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp corman-sdl/engine/use-engine.lisp
by Luke J Crook 13 Jul '04

13 Jul '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv7424/engine Modified Files: engine.lisp use-engine.lisp Log Message: Date: Tue Jul 13 07:43:49 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.10 corman-sdl/engine/engine.lisp:1.11 --- corman-sdl/engine/engine.lisp:1.10 Fri Jul 9 08:29:40 2004 +++ corman-sdl/engine/engine.lisp Tue Jul 13 07:43:49 2004 @@ -97,11 +97,15 @@ (defun bitplanes () bitplanes) (defun first-bitplane () - (if (null (dl-prev bitplanes)) - bitplanes - (setf bitplanes (dl-prev bitplanes)))) + (if (null bitplanes) + nil + (if (null (dl-prev bitplanes)) + bitplanes + (setf bitplanes (dl-prev bitplanes))))) (defun set-bitplane (bitplane) - (setf bitplanes bitplane))) + (setf bitplanes (dl-list bitplane))) + (defun remove-bitplanes () + (setf bitplanes nil))) (defclass sprite () @@ -114,7 +118,7 @@ (defun new-bitplane (zorder) (make-bitplane :zorder zorder)) -(defun addto-bitplane (bitplane obj) +(defun addto-bitplane (obj bitplane) (cond ((null (bitplane-end bitplane)) (setf (bitplane-end bitplane) (dl-list obj)) @@ -123,7 +127,7 @@ (setf (bitplane-end bitplane) (dl-append obj (bitplane-end bitplane)))))) ;Removes a node from the bitplane. -(defun remove-node-from-bitplane (bitplane obj) +(defun remove-node-from-bitplane (obj bitplane) (when (null (dl-next obj)) (setf (bitplane-end bitplane) (dl-prev obj))) (when (null (dl-prev obj)) @@ -131,14 +135,14 @@ (dl-remove obj)) ;Finds the node containing object, then calls remove-node-from-bitplane -(defun remove-from-bitplane (bitplane object) +(defun remove-from-bitplane (object bitplane) (let ((obj (dl-find (bitplane-start bitplane) #'(lambda (node) (if (equal (dl-data node) object) node nil))))) (when obj - (remove-node-from-bitplane bitplane obj)))) + (remove-node-from-bitplane obj bitplane)))) (defun get-zorder (obj) (cond @@ -149,40 +153,49 @@ ;Iterates through the list of bitplanes. ; Returns the bitplane, if bitplane == zorder. -; Returns the previous bitplane if bitplane < zorder +; Returns the previous bitplane if bitplanes > zorder ; Returns (defun find-bitplane (zorder bitplanes) - (let ((bp bitplanes) (quit nil)) - (loop - (when (equal quit t) (return (values bitplanes 'p))) - (cond - ((> zorder (get-zorder bp)) ; if test > current - (values (bp 'n))) ; end of list when next is null - ((equal zorder (get-zorder bp)) - (return (values bp 'c))) ; test == curent, return - ((null (dl-next bp)) - (setf quit t)))))) + (let ((zorder (get-zorder bitplane))) + (cond + ((null bitplanes) + nil) + ((null (dl-next bitplanes)) + (dl-append bitplane bitplanes)) + ((> (get-zorder bitplanes) zorder) + (dl-insert bitplane bitplanes)) + ((equal zorder (get-zorder bitplanes)) + nil) + (t + (add-bitplane bitplane (dl-nextnode bitplanes)))))) (defun add-bitplane (bitplane bitplanes) - (let ((bp bitplanes) (quit nil) (zorder (get-zorder bitplane))) - (loop - (when (equal quit t) (return (values bitplanes 'p))) - (cond - ((> zorder (get-zorder bitplanes)) ; if test > current - (dl-insert bitplane bitplanes)) - (values (bp 'n))) ; end of list when next is null - ((equal zorder (get-zorder bp)) - (return (values bp 'c))) ; test == curent, return - ((null (dl-next bp)) - (setf quit t)))))) - - + (let ((zorder (get-zorder bitplane))) + (cond + ((null bitplanes) + (set-bitplane bitplane)) + ((null (dl-next bitplanes)) + (dl-append bitplane bitplanes)) + ((equal zorder (get-zorder bitplanes)) + nil) + (t + (add-bitplane bitplane (dl-nextnode bitplanes)))))) + +(defun add-sprite-to-bitplane (sprite bitplanes) + (cond + ((null bitplanes) + (addto-bitplane sprite (add-bitplane (sprite-zorder sprite)))) + ((> (get-zorder bitplanes) (sprite-zorder sprite)) + (dl-insert bitplane bitplanes)) + ((null (dl-next bitplane)) + (dl-append bitplane bitplanes)) + (t + (add-sprite-to-bitplane bitplanes (dl-nextnode bitplanes))))) +(defun add-sprite (sprite) + (add-sprite-to-bitplane sprite (first-bitplane))) + - (if (equal zorder (get-zorder bp)) - (return (values bp 'c)) - (return (values bp 'p))))))) ; test < current, return - (defun return-bitplane (zorder bitplanes) (when (null bitplanes) (set-bitplane (dl-list (new-bitplane zorder))) Index: corman-sdl/engine/use-engine.lisp diff -u corman-sdl/engine/use-engine.lisp:1.2 corman-sdl/engine/use-engine.lisp:1.3 --- corman-sdl/engine/use-engine.lisp:1.2 Fri Jul 9 08:29:40 2004 +++ corman-sdl/engine/use-engine.lisp Tue Jul 13 07:43:49 2004 @@ -9,4 +9,10 @@ (bitplanes) -(remove-from-bitplane (bitplanes) 'obj-10) \ No newline at end of file +(remove-from-bitplane (bitplanes) 'obj-10) + +(add-bitplane (new-bitplane 5) (bitplanes)) +(add-bitplane (new-bitplane 7) (bitplanes)) +(add-bitplane (new-bitplane 7) (bitplanes)) +(first-bitplane) +(bitplanes) \ No newline at end of file

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp corman-sdl/engine/use-engine.lisp
by Luke J Crook 09 Jul '04

09 Jul '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv29312/engine Modified Files: engine.lisp use-engine.lisp Log Message: Date: Fri Jul 9 08:29:40 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.9 corman-sdl/engine/engine.lisp:1.10 --- corman-sdl/engine/engine.lisp:1.9 Thu Jul 8 02:00:12 2004 +++ corman-sdl/engine/engine.lisp Fri Jul 9 08:29:40 2004 @@ -84,10 +84,8 @@ (return obj) (setf obj (dl-next obj)))))) - - - - +;;;;; End: Link list functions +;;;;; (defstruct (bitplane) @@ -105,6 +103,7 @@ (defun set-bitplane (bitplane) (setf bitplanes bitplane))) + (defclass sprite () ( (id :accessor sprite-id :initform nil :initarg :id) @@ -147,17 +146,41 @@ (bitplane-zorder obj)) ((dl-p obj) (bitplane-zorder (dl-data obj))))) - + +;Iterates through the list of bitplanes. +; Returns the bitplane, if bitplane == zorder. +; Returns the previous bitplane if bitplane < zorder +; Returns (defun find-bitplane (zorder bitplanes) (let ((bp bitplanes) (quit nil)) (loop - (when (equal quit t) (return (values bp 'n))) - (if (> zorder (get-zorder bp)) ; if test > current - (if (null (dl-next bp)) - (setf quit t) ; end of list when next is null - (setf bp (dl-next bp))) ; next node + (when (equal quit t) (return (values bitplanes 'p))) + (cond + ((> zorder (get-zorder bp)) ; if test > current + (values (bp 'n))) ; end of list when next is null + ((equal zorder (get-zorder bp)) + (return (values bp 'c))) ; test == curent, return + ((null (dl-next bp)) + (setf quit t)))))) + +(defun add-bitplane (bitplane bitplanes) + (let ((bp bitplanes) (quit nil) (zorder (get-zorder bitplane))) + (loop + (when (equal quit t) (return (values bitplanes 'p))) + (cond + ((> zorder (get-zorder bitplanes)) ; if test > current + (dl-insert bitplane bitplanes)) + (values (bp 'n))) ; end of list when next is null + ((equal zorder (get-zorder bp)) + (return (values bp 'c))) ; test == curent, return + ((null (dl-next bp)) + (setf quit t)))))) + + + + (if (equal zorder (get-zorder bp)) - (return (values bp 'c)) ; test == curent, return + (return (values bp 'c)) (return (values bp 'p))))))) ; test < current, return (defun return-bitplane (zorder bitplanes) Index: corman-sdl/engine/use-engine.lisp diff -u corman-sdl/engine/use-engine.lisp:1.1 corman-sdl/engine/use-engine.lisp:1.2 --- corman-sdl/engine/use-engine.lisp:1.1 Thu Jul 8 02:00:12 2004 +++ corman-sdl/engine/use-engine.lisp Fri Jul 9 08:29:40 2004 @@ -1,23 +1,12 @@ ; Create a new level -(setf objects (add-level objects (new-zlevel 5))) -(dl-list (new-zlevel 5)) -objects +(set-bitplane (new-bitplane 5)) -(find-zlevel objects 5) +(addto-bitplane (bitplanes) 'obj-1) +(addto-bitplane (bitplanes) 'obj-2) +(addto-bitplane (bitplanes) 'obj-5) +(addto-bitplane (bitplanes) 'obj-10) -(setf level-1 (new-level 1)) +(bitplanes) -level-1 - -(addto-level level-1 'obj-3) -level-1 -(remove-from-level level-1 'obj-3) - - (dl-find (level-start level-1) - #'(lambda (node) - (if (equal (dl-data node) 'obj-4) - node - nil))) - -(dl-list 'obj-1 'obj-2) \ No newline at end of file +(remove-from-bitplane (bitplanes) 'obj-10) \ No newline at end of file

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/use-engine.lisp corman-sdl/engine/engine.lisp
by Luke J Crook 08 Jul '04

08 Jul '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv2445/engine Modified Files: engine.lisp Added Files: use-engine.lisp Log Message: Date: Thu Jul 8 02:00:13 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.8 corman-sdl/engine/engine.lisp:1.9 --- corman-sdl/engine/engine.lisp:1.8 Mon May 3 23:00:53 2004 +++ corman-sdl/engine/engine.lisp Thu Jul 8 02:00:12 2004 @@ -95,9 +95,6 @@ start end) - - - (let ((bitplanes nil)) (defun bitplanes () bitplanes) @@ -115,6 +112,9 @@ (y :accessor sprite-y :initform 0 :initarg :y) (zorder :accessor sprite-zorder :initform 0 :initarg :zorder))) +(defun new-bitplane (zorder) + (make-bitplane :zorder zorder)) + (defun addto-bitplane (bitplane obj) (cond ((null (bitplane-end bitplane)) @@ -123,15 +123,23 @@ (t (setf (bitplane-end bitplane) (dl-append obj (bitplane-end bitplane)))))) -(defun removefrom-bitplane (bitplane obj) +;Removes a node from the bitplane. +(defun remove-node-from-bitplane (bitplane obj) (when (null (dl-next obj)) (setf (bitplane-end bitplane) (dl-prev obj))) (when (null (dl-prev obj)) (setf (bitplane-start bitplane) (dl-next obj))) (dl-remove obj)) -(defun new-bitplane (zorder) - (make-bitplane :zorder zorder)) +;Finds the node containing object, then calls remove-node-from-bitplane +(defun remove-from-bitplane (bitplane object) + (let ((obj (dl-find (bitplane-start bitplane) + #'(lambda (node) + (if (equal (dl-data node) object) + node + nil))))) + (when obj + (remove-node-from-bitplane bitplane obj)))) (defun get-zorder (obj) (cond

1 0

[corman-sdl-cvs] CVS update: corman-sdl/ffi/engine.lisp
by Luke J Crook 08 Jul '04

08 Jul '04

Update of /project/corman-sdl/cvsroot/corman-sdl/ffi In directory common-lisp.net:/tmp/cvs-serv6276/ffi Modified Files: engine.lisp Log Message: Date: Thu Jul 8 01:48:34 2004 Author: lcrook Index: corman-sdl/ffi/engine.lisp diff -u corman-sdl/ffi/engine.lisp:1.1 corman-sdl/ffi/engine.lisp:1.2 --- corman-sdl/ffi/engine.lisp:1.1 Tue Apr 13 10:09:40 2004 +++ corman-sdl/ffi/engine.lisp Thu Jul 8 01:48:34 2004 @@ -73,15 +73,21 @@ (return obj) (setf obj (dl-next obj)))))) -(defstruct (zlevel) - zorder - start - end) - +;;;;; End: Link list functions +;;;;; +(defun create-display-list () + (let ((display-list nil)) + (defun init-display-list () + (setf display-list nil)) + (defun display-list () + display-list))) -(defvar objects nil) +(defstruct (level) + zorder + start + end) (defclass sprite () ( @@ -90,32 +96,46 @@ (y :accessor sprite-y :initform 0 :initarg :y) (zorder :accessor sprite-zorder :initform 0 :initarg :zorder))) +(defun new-level (zorder) + (make-level :zorder zorder)) -(defun addto-level (zlevel obj) +(defun addto-level (level object) (cond - ((null (zlevel-end zlevel)) - (setf (zlevel-end zlevel) (dl-list obj)) - (setf (zlevel-start zlevel) (zlevel-end zlevel))) + ((null (level-end level)) + (setf (level-end level) (dl-list object)) + (setf (level-start level) (level-end level))) (t - (setf (zlevel-end zlevel) (dl-append obj (zlevel-end zlevel)))))) + (setf (level-end level) (dl-append object (level-end level)))))) + +;Removes a node from the level. +(defun remove-node-from-level (level object) + (when (null (dl-next object)) + (setf (level-end level) (dl-prev object))) + (when (null (dl-prev object)) + (setf (level-start level) (dl-next object))) + (dl-remove object)) + +;Finds the node containing object, then calls remove-node-from-level +(defun remove-from-level (level object) + (let ((obj (dl-find (level-start level) + #'(lambda (node) + (if (equal (dl-data node) object) + node + nil))))) + (when obj + (remove-node-from-level level obj)))) -(defun add-level (objects level) +(defun add-level (level objects) (cond - ((null (zlevel-end zlevel)) - (setf (zlevel-end zlevel) (dl-list obj)) - (setf (zlevel-start zlevel) (zlevel-end zlevel))) + ((null objects) + (setf objects (dl-list level))) + ((null (level-end level)) + (setf (level-end level) (dl-list objects)) + (setf (level-start level) (level-end level))) (t - (setf (zlevel-end zlevel) (dl-append obj (zlevel-end zlevel)))))) + (setf (level-end level) (dl-append objects (level-end level)))))) -(defun remove-from-level (zlevel obj) - (when (null (dl-next obj)) - (setf (zlevel-end zlevel) (dl-prev obj))) - (when (null (dl-prev obj)) - (setf (zlevel-start zlevel) (dl-next obj))) - (dl-remove obj)) -(defun new-zlevel (zorder) - (make-zlevel :zorder zorder)) (defun new-find-zlevel (zorder) #'(lambda (dl)

1 0

[corman-sdl-cvs] CVS update: corman-sdl/examples/bouncing-ball_7.lisp corman-sdl/examples/random-rectangles_5.lisp
by Luke J Crook 02 Jul '04

02 Jul '04

Update of /project/corman-sdl/cvsroot/corman-sdl/examples In directory common-lisp.net:/tmp/cvs-serv30208/examples Modified Files: bouncing-ball_7.lisp random-rectangles_5.lisp Log Message: Date: Fri Jul 2 02:25:31 2004 Author: lcrook Index: corman-sdl/examples/bouncing-ball_7.lisp diff -u corman-sdl/examples/bouncing-ball_7.lisp:1.1 corman-sdl/examples/bouncing-ball_7.lisp:1.2 --- corman-sdl/examples/bouncing-ball_7.lisp:1.1 Tue Apr 13 10:09:40 2004 +++ corman-sdl/examples/bouncing-ball_7.lisp Fri Jul 2 02:25:31 2004 @@ -27,14 +27,14 @@ (return)) (setf tempBitmap (sdl:loadbmp "b-ball.bmp")) - (when (null tempBitmap) + (unless tempBitmap (sdl:fformat "ERROR: Cannot find \"b-ball.bmp\" in directory ~A~%" (ccl:get-current-directory)) (return)) ;Now we make all black pixels transparent.. ;First, set the color black (0, 0, 0) to be the transparent pixel using SDL_SetColorKey (sdl:set-colorkey tempBitmap 0 0 0 :accel t) - ;Now call (sdl:set-videomode) in order to convert the surface + ;Now call (sdl:displayformat) in order to convert the surface ;to native SDL format for fast blitting. (setf pBitmap (sdl:displayformat tempBitmap)) @@ -46,11 +46,11 @@ (sdl:with-events (:quit t) - (:keydown (state keysym) - (when (eql (sdl:get-key keysym) sdl:SDLK_ESCAPE) + (:keydown (state scancode key mod unicode) + (when (= key sdl:SDLK_ESCAPE) (sdl:push-quitevent))) (:idle - (sdl:clear-display 255 255 255) + (sdl:fill-display :r 255 :g 255 :b 255) (sdl:moveby-rectangle rcDst dx dy) (when (or (<= (sdl:rectangle-x rcDst) 0) (>= (sdl:rectangle-x rcDst) max-right)) @@ -58,7 +58,7 @@ (when (or (<= (sdl:rectangle-y rcDst) 0) (>= (sdl:rectangle-y rcDst) max-height)) (setf dy (- dy))) - (sdl:blit-to-display pBitmap rcDst) + (sdl:blit-to-display pBitmap :template rcDst) (sdl:Flip)))) (unless (sdl:init-success) @@ -75,4 +75,3 @@ ;;; Build the exe using... ;;; (SAVE-APPLICATION "bouncing-ball.exe" 'bouncing-ball :static t) -:c 1 \ No newline at end of file Index: corman-sdl/examples/random-rectangles_5.lisp diff -u corman-sdl/examples/random-rectangles_5.lisp:1.1 corman-sdl/examples/random-rectangles_5.lisp:1.2 --- corman-sdl/examples/random-rectangles_5.lisp:1.1 Tue Apr 13 10:09:40 2004 +++ corman-sdl/examples/random-rectangles_5.lisp Fri Jul 2 02:25:31 2004 @@ -33,11 +33,14 @@ ;(documentation 'sdl:with-events 'function) for a description of how to use it. (sdl:with-events (:quit t) + (:keydown (state scancode key mod unicode) + (when (= key sdl:SDLK_ESCAPE) + (sdl:push-quitevent))) (:idle ;Set up the random rectangle - (with-c-struct (x rectangle sdl:SDL_Rect) + (ct:with-c-struct (x rectangle sdl:sdl_rect) (setf - sdl::x (random width) + sdl::x (random width) sdl::y (random height) sdl::w (random (- width sdl::x)) sdl::h (random (- height sdl::y)))) @@ -45,7 +48,7 @@ ;'Render' the rectangle to the display by: ;Filling the display with a random color, ;using the [x,y,w,h] of the rectangle as a template - (sdl:fill-display (random 256) (random 256) (random 256) :rectangle rectangle) + (sdl:fill-display :r (random 256) :g (random 256) :b (random 256) :template rectangle) ;Use sdl:flip or sdl:update-display to update the screen. ; Here, sdl:flip updates the entire display whereas @@ -54,13 +57,11 @@ ;(sdl:Flip) - (sdl:update-display - (sdl:rectangle-x rectangle) (sdl:rectangle-y rectangle) - (sdl:rectangle-w rectangle) (sdl:rectangle-h rectangle))))) + (sdl:update-display :template rectangle))) ;sdl:init-success will check to see if sdl:with-init was initialized correctly. (unless (sdl:init-success) - (fformat "ERROR: sdl:with-init FAILED to initialize")))) + (fformat "ERROR: sdl:with-init FAILED to initialize"))))) ;;; Run the example using... ;;; (setf rects (mp:process-run-function "random-rects" #'random-rects))

1 0

[corman-sdl-cvs] CVS update: corman-sdl/ffi/sdl-util.lisp
by Luke J Crook 02 Jul '04

02 Jul '04

Update of /project/corman-sdl/cvsroot/corman-sdl/ffi In directory common-lisp.net:/tmp/cvs-serv26481/ffi Modified Files: sdl-util.lisp Log Message: Date: Fri Jul 2 02:24:59 2004 Author: lcrook Index: corman-sdl/ffi/sdl-util.lisp diff -u corman-sdl/ffi/sdl-util.lisp:1.2 corman-sdl/ffi/sdl-util.lisp:1.3 --- corman-sdl/ffi/sdl-util.lisp:1.2 Tue Apr 20 18:23:07 2004 +++ corman-sdl/ffi/sdl-util.lisp Fri Jul 2 02:24:59 2004 @@ -213,47 +213,54 @@ (ct:cref sdl:SDL_Surface surface sdl::format))) -(defun fill-surface (surface r g b &optional (a nil) &key (rectangle nil)) - "fill SURFACE R G B &optional A &key (RECTANGLE null) - Fill SURFACE with the specified color using the parameters R G B and the optional alpha component, A. - RECTANGLE is the fill template." - (if (null a) - (sdl:SDL_FillRect surface rectangle +(defun fill-surface (surface &key (r 0) (g 0) (b 0) (alpha nil) (template NULL)) + "fill SURFACE &key R G B ALPHA (template null) + Fill SURFACE with the specified color using the keyword parameters R G B and Alpha. + :template is the fill template." + (if ALPHA + (sdl:SDL_FillRect surface template (sdl:SDL_MapRGB (sdl:pixelformat surface) r g b)) - (sdl:SDL_FillRect surface rectangle - (sdl:SDL_MapRGBA (sdl:pixelformat surface) r g b a)))) + (sdl:SDL_FillRect surface template + (sdl:SDL_MapRGBA (sdl:pixelformat surface) r g b ALPHA)))) -(defun fill-display (r g b &key (rectangle nil)) - "fill-display R G B &key RECTANGLE +(defun fill-display (&key (r 0) (g 0) (b 0) (template NULL)) + "fill-display &key R G B template Fills the display with a color specified using the R G B parameters. - The optional RECTANGLE (SDL_Rect) defaults to NULL." - (sdl:SDL_FillRect (sdl:display) RECTANGLE + The keyword :template (SDL_Rect) defaults to NULL." + (sdl:SDL_FillRect (sdl:display) template (sdl:SDL_MapRGB (sdl:pixelformat (sdl:display)) r g b))) -(defun clear-display (&optional (r 0) (g 0) (b 0)) - "clear-display &optional R G B - Clears the whole display using the optional R G B parameters. Color defaults to black." +#|(defun clear-display (&key (r 0) (g 0) (b 0)) + "clear-display &key R G B + Clears the whole display using the keyword :R :G :B parameters. Color defaults to black." (sdl:SDL_FillRect (sdl:display) NULL (sdl:SDL_MapRGB (sdl:pixelformat (sdl:display)) r g b))) +|# -(defun update-display (&optional (x 0) (y 0) (w 0) (h 0)) - "update-display &optional X Y W H - Updates the screen using the optional co-orditates X Y W H. +(defun update-display (&key (x 0) (y 0) (w 0) (h 0) (template nil)) + "update-display &key X Y W H + Updates the screen using the keyword co-orditates :X :Y :W :H, or :template. Co-ordinates default to 0, therefore updating the entire screen." - (sdl:SDL_UpdateRect (sdl:display) x y w h)) + (if template + (sdl:SDL_UpdateRect (sdl:display) + (sdl:rectangle-x template) + (sdl:rectangle-y template) + (sdl:rectangle-w template) + (sdl:rectangle-h template)) + (sdl:SDL_UpdateRect (sdl:display) x y w h))) -(defun blit-to-display (source destination &key (rectangle NULL)) +(defun blit-to-display (source &key (template NULL)) "blit-to-display SOURCE DESTINATION Blits the SOURCE surface to the display using SDL_BlitSurface. DESTINATION is a SDL_Rect. Only the [x,y] co-ordinates are used to position the source on the display." - (sdl:SDL_BlitSurface source rectangle (sdl:display) destination)) + (sdl:blit-to-surface source (sdl:display) :destination-template template)) -(defun blit-to-surface (source destination-coords destination-surface &key (source-rect nil)) +(defun blit-to-surface (source destination &key (source-template NULL) (destination-template NULL)) "blit-to-surface SOURCE DESTINATION-COORDS DESTINATION-SURFACE &key SOURCE-RECT Blits the SOURCE surface to the DESTINATION-SURFACE using SDL_BlitSurface. DESTINATION is a SDL_Rect. Only the [x,y] co-ordinates are used to position the SOURCE on the DESTINATION-SURFACE. Use the optional SOURCE-RECT ( SDL_Rect ) to blit a portion of the SOURCE to the DESTINATION-SURFACE." - (sdl:SDL_BlitSurface source source-rect destination-surface destination-coords)) + (sdl:SDL_BlitSurface source source-template destination destination-template)) (defun set-colorkey (surface r g b &key (accel nil)) (if (or @@ -450,7 +457,10 @@ (funcall #'(lambda ,params ,@forms) (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::state) - (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym)))) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::scancode) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::sym) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::mod) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::unicode)))) (defun expand-keyup (sdl-event params forms) `((eql sdl:SDL_KEYUP @@ -460,7 +470,10 @@ (funcall #'(lambda ,params ,@forms) (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::state) - (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym)))) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::scancode) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::sym) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::mod) + (ct:cref sdl:SDL_keysym (ct:cref sdl:SDL_KeyboardEvent ,sdl-event sdl::keysym) sdl::unicode)))) (defun expand-mousemotion (sdl-event params forms) `((eql sdl:SDL_MOUSEMOTION

1 0