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