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

[Luke J Crook]

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))