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