- corman-sdl-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[corman-sdl-cvs] CVS update: corman-sdl/ffi/opengl__h.lisp
by Luke J Crook 04 Jun '04

04 Jun '04

Update of /project/corman-sdl/cvsroot/corman-sdl/ffi In directory common-lisp.net:/tmp/cvs-serv31200/ffi Added Files: opengl__h.lisp Log Message: Date: Fri Jun 4 06:58:43 2004 Author: lcrook

1 0

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

04 May '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv25504/engine Modified Files: engine.lisp Log Message: Date: Tue May 4 02:00:53 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.7 corman-sdl/engine/engine.lisp:1.8 --- corman-sdl/engine/engine.lisp:1.7 Wed Apr 21 02:00:13 2004 +++ corman-sdl/engine/engine.lisp Tue May 4 02:00:53 2004 @@ -1,11 +1,5 @@ -;;; A bouncing ball example. -;;; Blits rectangles of random size to random positions on the screen -;;; Original work: "The Simple Direct Media Layer", Ernest S. Pazera -;;; ( http://www.gamedev.net/reference/programming/features/sdl2/page5.asp) -;;; Conversion by Luke J Crook, luke(a)balooga.com -;;; 12 June, 2003 -;;; Version 0.1 - +;;;;; Copyright (c) 2003-2004, Luke J Crook +;;;;; All rights reserved. (require 'sdl) (require 'sdl-util) (in-package :win)

1 0

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

04 May '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv29856/engine Modified Files: Tag: lush engine.lisp Log Message: Date: Tue May 4 01:55:25 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.5.2.1 corman-sdl/engine/engine.lisp:1.5.2.2 --- corman-sdl/engine/engine.lisp:1.5.2.1 Wed Apr 21 02:09:36 2004 +++ corman-sdl/engine/engine.lisp Tue May 4 01:55:25 2004 @@ -1,5 +1,11 @@ -;;;;; Copyright (c) 2003-2004, Luke J Crook -;;;;; All rights reserved. +;;; A bouncing ball example. +;;; Blits rectangles of random size to random positions on the screen +;;; Original work: "The Simple Direct Media Layer", Ernest S. Pazera +;;; ( http://www.gamedev.net/reference/programming/features/sdl2/page5.asp) +;;; Conversion by Luke J Crook, luke(a)balooga.com +;;; 12 June, 2003 +;;; Version 0.1 + (require 'sdl) (require 'sdl-util) (in-package :win)

1 0

[corman-sdl-cvs] CVS update: corman-sdl/ffi/sdl_h.lisp
by Luke J Crook 03 May '04

03 May '04

Update of /project/corman-sdl/cvsroot/corman-sdl/ffi In directory common-lisp.net:/tmp/cvs-serv13057/ffi Modified Files: Tag: lush sdl_h.lisp Log Message: Date: Mon May 3 16:25:28 2004 Author: lcrook Index: corman-sdl/ffi/sdl_h.lisp diff -u corman-sdl/ffi/sdl_h.lisp:1.1 corman-sdl/ffi/sdl_h.lisp:1.1.2.1 --- corman-sdl/ffi/sdl_h.lisp:1.1 Tue Apr 13 13:09:40 2004 +++ corman-sdl/ffi/sdl_h.lisp Mon May 3 16:25:28 2004 @@ -1,5 +1,5 @@ ;;;;; SDL bindings for Corman Lisp -;;;;; Version 0.6 +;;;;; Version 0.6.1 ;;;;; Author: Luke Crook ( luke(a)balooga.com ) ;;;;; SDL Version 1.2.6.0 ;;;;; Corman Lisp Version 2.5 @@ -16,11 +16,11 @@ ;;;;; #define SDL_NAME(X) SDL_##X ;;;;; ;;;;; "sdl_copying.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; Nothing to do. Complete. ;;;;; ;;;;; "sdl_types.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; NOTE: ;;;;; Unsure if the 64 bit type is correctly supported. ;;;;; No compile time assertions. (Not required). @@ -28,21 +28,18 @@ ;;;;; SDL_TABLESIZE(table) ;;;;; ;;;;; "sdl_version.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; Modifications: ;;;;; #define SDL_VERSION(X) changed to +SDL_VERSION+ because of possible ;;;;; name clash with the SDL_Version struct ;;;;; Complete. ;;;;; ;;;;; "sdl_syswm.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" -;;;;; NOTE: -;;;;; Commented out in SDL_h.lisp as the FFI definitions cause (ct:TRANSCRIBE_FILE) -;;;;; to fail. Manually copied into SDL.lisp +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; Complete. ;;;;; ;;;;; "sdl_rwops.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; TODO: ;;;;; //extern DECLSPEC SDL_RWops * SDL_RWFromFP(FILE *fp, int autoclose); ;;;;; //#define SDL_RWseek(ctx, offset, whence) (ctx)->seek(ctx, offset, whence) @@ -79,15 +76,15 @@ ;;;;; Uint32 buffer[4]; ;;;;; ;;;;; "sdl.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "sdl_main.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "sdl_error.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; NOTE: ;;;;; The Corman Lisp FFI does not easily support variable arguments. ;;;;; Therefore expect SDL_SetError to be supported around the '1st of Never @@ -95,11 +92,11 @@ ;;;;; SDLCALL SDL_SetError(const char *fmt, ...) ;;;;; ;;;;; "sdl_mutex.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete. ;;;;; ;;;;; "sdl_thread.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Use the threads package provided by Chris Double, or raw OS threads ;;;;; provided by Corman Lisp. Easier to use than SDL threads. ;;;;; NOTE: @@ -117,7 +114,7 @@ ;;;;; Use Corman / Chris Double's threads instead. ;;;;; ;;;;; "sdl_video.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; NOTE: ;;;;; SDL_SoftStretch - not yet in public API ;;;;; MODIFICATIONS: @@ -151,31 +148,31 @@ ;;;;; (added Uint32 TEMP;) ;;;;; ;;;;; "SDL_active.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "SDL_keysym.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "SDL_keyboard.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "SDL_mouse.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "SDL_joystick.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "SDL_quit.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Complete ;;;;; ;;;;; "SDL_events.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; NOTE: ;;;;; The C to Lisp translator does not support unions. And as I am too ;;;;; lazy to determine the exact largest size for the SDL_Event struct, @@ -185,7 +182,7 @@ ;;;;; Complete. ;;;;; ;;;;; "SDL_timer.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; TODO: ;;;;; AddTimer callback does not yet work. ;;;;; extern DECLSPEC SDL_TimerID SDL_AddTimer(Uint32 interval, SDL_NewTimerCallback callback, void *param); @@ -199,28 +196,28 @@ ;;;;; #define getenv(X) SDL_getenv(X)Nothing to do. Complete. ;;;;; ;;;;; "SDL_endian.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; Not yet implemented. ;;;;; ;;;;; "SDL_byteorder.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; NOTE: Hardwired Little endianess (Intel) ;;;;; Complete. ;;;;; ;;;;; "SDL_cdrom.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; MODIFICATIONS: ;;;;; Changed SDL_CDtrack track[SDL_MAX_TRACKS+1] to SDL_CDtrack track[100]; ;;;;; Complete. ;;;;; ;;;;; "SDL_audio.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $"; +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $"; ;;;;; TODO: ;;;;; typedef struct SDL_AudioCVT ;;;;; specifically: void (*filters[10])(struct SDL_AudioCVT *cvt, Uint16 format); ;;;;; ;;;;; "SDL_loadso.h" -;;;;; "@(#) $Id: sdl_h.lisp,v 1.1 2004/04/13 17:09:40 lcrook Exp $" +;;;;; "@(#) $Id: sdl_h.lisp,v 1.1.2.1 2004/05/03 20:25:28 lcrook Exp $" ;;;;; Complete. ;;;;; ;;;;; @@ -371,29 +368,27 @@ ;; "sdl_syswm.h" ;; -#! (:export t :library "SDL" :ignore "DECLSPEC" :pack 4 ) -//typedef unsigned int UINT; -//typedef UINT WPARAM; -//typedef LONG LPARAM; -//typedef HANDLE HGLRC; -//;;#LISP (ct:defctype HANDLE :handle) -//;;#LISP (ct:defctype HWND handle) -//;;#LISP (ct:defctype UINT :unsigned-long) -//;;#LISP (ct:defctype WPARAM UINT) -//;;#LISP (ct:defctype LPARAM :long) -//;;#LISP (ct:defctype HGLRC handle) +#! (:export t :library "KERNEL32") +typedef unsigned int UINT; !# +#! (:export t :library "KERNEL32") +typedef HANDLE HWND; +typedef UINT WPARAM; +//typedef LONG LPARAM; +typedef unsigned int LPARAM; +typedef HANDLE HGLRC; +!# -#| +#! (:export t :library "SDL") struct SDL_SysWMinfo; -typedef struct SDL_SysWMinfo SDL_SysWMinfo; -|# +//typedef struct SDL_SysWMinfo SDL_SysWMinfo; +!# ;; For some reason, (ct:transcribe-file) chokes on the following ;; two structs. -#| + #! (:export t :library "SDL" :ignore "DECLSPEC" :pack 4 ) struct SDL_SysWMmsg { SDL_version version; @@ -402,18 +397,21 @@ WPARAM wParam; /* WORD message parameter */ LPARAM lParam; /* LONG message parameter */ }; +!# -typedef struct { +#! (:export t :library "SDL" :ignore "DECLSPEC" :pack 4 ) +typedef struct SDL_SysWMinfo { SDL_version version; HWND window; /* The Win32 display window */ HGLRC hglrc; /* The OpenGL context, if any */ } SDL_SysWMinfo; !# + #! (:export t :library "SDL" :ignore "DECLSPEC" :pack 4 ) extern DECLSPEC int SDL_GetWMInfo(SDL_SysWMinfo *info); !# -|# + ;; "sdl_rwops.h" ;; @@ -821,7 +819,7 @@ (ct:cref SDL_Surface surface flags) (logior SDL_HWSURFACE SDL_ASYNCBLIT SDL_RLEACCEL)))) (values 1) - (values 0)))) + (values 0))))) !# #! (:library "SDL" :export t :ignore "DECLSPEC") @@ -2131,3 +2129,11 @@ !# (provide :sdl) + + +;;(ccl:set-current-directory "C:/Documents and Settings/00u4440/My Documents/dev/corman-sdl/ffi") +;;(ccl:set-current-directory "F:/Documents and Settings/Crook/My Documents/dev/corman-sdl/ffi") + +;;(require :MEM-C-FUNCS) +;;(ct:transcribe-file "sdl_h.lisp" "sdl.lisp" :common-lisp-user nil) +;;(ct:transcribe-file "sdl_h.lisp" "sdl.lisp" :rm nil)

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp
by Luke J Crook 21 Apr '04

21 Apr '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv32166/engine Modified Files: Tag: lush engine.lisp Log Message: Date: Wed Apr 21 02:09:36 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.5 corman-sdl/engine/engine.lisp:1.5.2.1 --- corman-sdl/engine/engine.lisp:1.5 Tue Apr 20 05:28:13 2004 +++ corman-sdl/engine/engine.lisp Wed Apr 21 02:09:36 2004 @@ -1,11 +1,5 @@ -;;; A bouncing ball example. -;;; Blits rectangles of random size to random positions on the screen -;;; Original work: "The Simple Direct Media Layer", Ernest S. Pazera -;;; ( http://www.gamedev.net/reference/programming/features/sdl2/page5.asp) -;;; Conversion by Luke J Crook, luke(a)balooga.com -;;; 12 June, 2003 -;;; Version 0.1 - +;;;;; Copyright (c) 2003-2004, Luke J Crook +;;;;; All rights reserved. (require 'sdl) (require 'sdl-util) (in-package :win)

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp
by Luke J Crook 21 Apr '04

21 Apr '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv32202/engine Modified Files: engine.lisp Log Message: Date: Wed Apr 21 02:00:13 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.6 corman-sdl/engine/engine.lisp:1.7 --- corman-sdl/engine/engine.lisp:1.6 Wed Apr 21 01:58:13 2004 +++ corman-sdl/engine/engine.lisp Wed Apr 21 02:00:13 2004 @@ -1,3 +1,11 @@ +;;; A bouncing ball example. +;;; Blits rectangles of random size to random positions on the screen +;;; Original work: "The Simple Direct Media Layer", Ernest S. Pazera +;;; ( http://www.gamedev.net/reference/programming/features/sdl2/page5.asp) +;;; Conversion by Luke J Crook, luke(a)balooga.com +;;; 12 June, 2003 +;;; Version 0.1 + (require 'sdl) (require 'sdl-util) (in-package :win)

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp
by Luke J Crook 21 Apr '04

21 Apr '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv19832/engine Modified Files: engine.lisp Log Message: Date: Wed Apr 21 01:58:13 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.5 corman-sdl/engine/engine.lisp:1.6 --- corman-sdl/engine/engine.lisp:1.5 Tue Apr 20 05:28:13 2004 +++ corman-sdl/engine/engine.lisp Wed Apr 21 01:58:13 2004 @@ -1,11 +1,3 @@ -;;; A bouncing ball example. -;;; Blits rectangles of random size to random positions on the screen -;;; Original work: "The Simple Direct Media Layer", Ernest S. Pazera -;;; ( http://www.gamedev.net/reference/programming/features/sdl2/page5.asp) -;;; Conversion by Luke J Crook, luke(a)balooga.com -;;; 12 June, 2003 -;;; Version 0.1 - (require 'sdl) (require 'sdl-util) (in-package :win)

1 0

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

21 Apr '04

Update of /project/corman-sdl/cvsroot/corman-sdl/ffi In directory common-lisp.net:/tmp/cvs-serv28576/ffi Modified Files: sdl-util.lisp Log Message: Date: Tue Apr 20 21:23:07 2004 Author: lcrook Index: corman-sdl/ffi/sdl-util.lisp diff -u corman-sdl/ffi/sdl-util.lisp:1.1 corman-sdl/ffi/sdl-util.lisp:1.2 --- corman-sdl/ffi/sdl-util.lisp:1.1 Tue Apr 13 13:09:40 2004 +++ corman-sdl/ffi/sdl-util.lisp Tue Apr 20 21:23:07 2004 @@ -11,7 +11,7 @@ (in-package :sdl) (export '(for while aif fformat to-radian to-degree calculate-timescale get-timescale display flip with-locksurface - DisplayFormat set-flags init-sdl set-videomode destruct-sdl geterror with-events with-init loadbmp + DisplayFormat set-flags init-sdl set-videomode new-screen destruct-sdl geterror with-events with-init loadbmp get-key new-event new-rect push-quitevent getvideoinfo listmodes videomodeok add-surface get-surface calculate-timescale init-success pixelformat fill-display clear-display blit-to-display blit-to-surface fill-surface update-display set-colorkey clear-colorkey is-key moveby-rectangle moveto-rectangle @@ -133,6 +133,14 @@ (if (ct:cpointer-null surface) (set-display nil) (set-display surface)))) + +(defun new-screen (width height &key (bpp 0) (flags sdl:SDL_SWSURFACE)) + "A synonym for set-videomode. + Sets the videomode. + Returns a new SDL_Surface if successful. + Returns NIL if failed. + Use the function (DISPLAY) to retrieve the SDL_Surface returned by NEW SCREEN." + (set-videomode width height :bpp bpp :flags flags)) (defun destruct-sdl () "Shuts down SDL using SDL_Quit"

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp
by Luke J Crook 20 Apr '04

20 Apr '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv25748/engine Modified Files: engine.lisp Log Message: Date: Tue Apr 20 05:28:13 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.4 corman-sdl/engine/engine.lisp:1.5 --- corman-sdl/engine/engine.lisp:1.4 Mon Apr 19 21:07:55 2004 +++ corman-sdl/engine/engine.lisp Tue Apr 20 05:28:13 2004 @@ -104,7 +104,15 @@ -(defvar objects nil) +(let ((bitplanes nil)) + (defun bitplanes () + bitplanes) + (defun first-bitplane () + (if (null (dl-prev bitplanes)) + bitplanes + (setf bitplanes (dl-prev bitplanes)))) + (defun set-bitplane (bitplane) + (setf bitplanes bitplane))) (defclass sprite () ( @@ -140,11 +148,10 @@ (defun find-bitplane (zorder bitplanes) (let ((bp bitplanes) (quit nil)) - (sdl:fformat "bp == ~A, zorder == ~A~%" bp zorder) (loop (when (equal quit t) (return (values bp 'n))) (if (> zorder (get-zorder bp)) ; if test > current - (when (null (dl-next bp)) + (if (null (dl-next bp)) (setf quit t) ; end of list when next is null (setf bp (dl-next bp))) ; next node (if (equal zorder (get-zorder bp)) @@ -153,21 +160,23 @@ (defun return-bitplane (zorder bitplanes) (when (null bitplanes) - (setf objects (dl-list (new-bitplane zorder))) - (setf bitplanes objects)) + (set-bitplane (dl-list (new-bitplane zorder))) + (setf bitplanes (bitplanes))) (multiple-value-bind (bitplane pos) (find-bitplane zorder bitplanes) (cond ((equal pos 'c) (values (dl-data bitplane))) ((equal pos 'p) - (values (dl-data (dl-insert (new-bitplane zorder) bitplane)))) + (setf bitplane (dl-insert (new-bitplane zorder) bitplane)) + (first-bitplane) + (values (dl-data bitplane))) ((equal pos 'n) (values (dl-data (dl-append (new-bitplane zorder) bitplane))))))) (defun add-object (spr) (addto-bitplane - (return-bitplane (sprite-zorder spr) objects) + (return-bitplane (sprite-zorder spr) (bitplanes)) spr))

1 0

[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp
by Luke J Crook 20 Apr '04

20 Apr '04

Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv28960/engine Modified Files: engine.lisp Log Message: Date: Mon Apr 19 21:07:56 2004 Author: lcrook Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.3 corman-sdl/engine/engine.lisp:1.4 --- corman-sdl/engine/engine.lisp:1.3 Mon Apr 19 04:20:15 2004 +++ corman-sdl/engine/engine.lisp Mon Apr 19 21:07:55 2004 @@ -113,7 +113,6 @@ (y :accessor sprite-y :initform 0 :initarg :y) (zorder :accessor sprite-zorder :initform 0 :initarg :zorder))) - (defun addto-bitplane (bitplane obj) (cond ((null (bitplane-end bitplane)) @@ -133,46 +132,43 @@ (make-bitplane :zorder zorder)) (defun get-zorder (obj) - (if (bitplane-p obj) - (bitplane-zorder obj) - (if (dl-p obj) + (cond + ((bitplane-p obj) + (bitplane-zorder obj)) + ((dl-p obj) (bitplane-zorder (dl-data obj))))) -(defun find-bitplane (bitplane zorder) - (let ((bp bitplane) (quit nil)) +(defun find-bitplane (zorder bitplanes) + (let ((bp bitplanes) (quit nil)) + (sdl:fformat "bp == ~A, zorder == ~A~%" bp zorder) (loop - (when (equal quit t) (return (values bp nil))) - (cond - ((equal zorder (get-zorder bp)) - (return (values bp t))) - ((< zorder (get-zorder bp)) - (if (null (dl-next bp)) - (setf quit t) - (setf bp (dl-next bp)))) - (t - (return (values bp nil))) - (t - (if (null (dl-next bp)) - (setf quit t) - (setf bp (dl-next bp)))))))) - -(defun return-zlevel (objects zorder) - "Returns the zlevel with the specified zorder. - zlevel may already exist or may be created it does not already exist" - (when (null objects) - (setf objects (dl-list (new-zlevel zorder)))) - (let ((obj nil) (found nil)) - (multiple-value-bind (obj found) - (find-zlevel objects zorder) - (cond - (found - obj) - ((null found) - (dl-append (new-zlevel zorder) obj)))) - (values obj))) + (when (equal quit t) (return (values bp 'n))) + (if (> zorder (get-zorder bp)) ; if test > current + (when (null (dl-next bp)) + (setf quit t) ; end of list when next is null + (setf bp (dl-next bp))) ; next node + (if (equal zorder (get-zorder bp)) + (return (values bp 'c)) ; test == curent, return + (return (values bp 'p))))))) ; test < current, return + +(defun return-bitplane (zorder bitplanes) + (when (null bitplanes) + (setf objects (dl-list (new-bitplane zorder))) + (setf bitplanes objects)) + (multiple-value-bind (bitplane pos) (find-bitplane zorder bitplanes) + (cond + ((equal pos 'c) + (values (dl-data bitplane))) + ((equal pos 'p) + (values (dl-data (dl-insert (new-bitplane zorder) bitplane)))) + ((equal pos 'n) + (values (dl-data (dl-append (new-bitplane zorder) bitplane))))))) + (defun add-object (spr) - (addto-level (dl-data (return-zlevel objects (sprite-zorder spr))) spr)) + (addto-bitplane + (return-bitplane (sprite-zorder spr) objects) + spr))

1 0