[corman-sdl-cvs] CVS update: corman-sdl/engine/engine.lisp corman-sdl/engine/use-engine.lisp

[Luke J Crook]

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