Update of /project/corman-sdl/cvsroot/corman-sdl/engine In directory common-lisp.net:/tmp/cvs-serv32714/engine
Modified Files: engine.lisp Log Message:
Date: Mon Apr 19 04:20:15 2004 Author: lcrook
Index: corman-sdl/engine/engine.lisp diff -u corman-sdl/engine/engine.lisp:1.2 corman-sdl/engine/engine.lisp:1.3 --- corman-sdl/engine/engine.lisp:1.2 Wed Apr 14 21:54:18 2004 +++ corman-sdl/engine/engine.lisp Mon Apr 19 04:20:15 2004 @@ -90,7 +90,13 @@ (return obj) (setf obj (dl-next obj))))))
-(defstruct (zlevel) + + + + + + +(defstruct (bitplane) zorder start end) @@ -108,47 +114,47 @@ (zorder :accessor sprite-zorder :initform 0 :initarg :zorder)))
-(defun addto-level (zlevel obj) - (cond - ((null (zlevel-end zlevel)) - (setf (zlevel-end zlevel) (dl-list obj)) - (setf (zlevel-start zlevel) (zlevel-end zlevel))) - (t - (setf (zlevel-end zlevel) (dl-append obj (zlevel-end zlevel)))))) - -(defun add-level (object level) +(defun addto-bitplane (bitplane obj) (cond - ((null (zlevel-end level)) - (setf (zlevel-end level) (dl-list object)) - (setf (zlevel-start level) (zlevel-end level))) + ((null (bitplane-end bitplane)) + (setf (bitplane-end bitplane) (dl-list obj)) + (setf (bitplane-start bitplane) (bitplane-end bitplane))) (t - (setf (zlevel-end level) (dl-append object (zlevel-end level)))))) + (setf (bitplane-end bitplane) (dl-append obj (bitplane-end bitplane))))))
-(defun remove-from-level (zlevel obj) +(defun removefrom-bitplane (bitplane obj) (when (null (dl-next obj)) - (setf (zlevel-end zlevel) (dl-prev obj))) + (setf (bitplane-end bitplane) (dl-prev obj))) (when (null (dl-prev obj)) - (setf (zlevel-start zlevel) (dl-next obj))) + (setf (bitplane-start bitplane) (dl-next obj))) (dl-remove obj))
-(defun new-zlevel (zorder) - (make-zlevel :zorder zorder)) +(defun new-bitplane (zorder) + (make-bitplane :zorder zorder))
-(defun find-zlevel (level zorder) - (if (null level) - (values nil nil) - (let ((obj level) (quit nil)) - (loop - (when (equal quit t) (values obj nil)) - (cond - ((equal zorder (zlevel-zorder (dl-data obj))) - (return (values obj t))) - ((> zorder (zlevel-zorder (dl-data obj))) - (return (values obj nil))) - (t - (if (null (dl-next obj)) - (setf quit t) - (setf obj (dl-next obj))))))))) +(defun get-zorder (obj) + (if (bitplane-p obj) + (bitplane-zorder obj) + (if (dl-p obj) + (bitplane-zorder (dl-data obj))))) + +(defun find-bitplane (bitplane zorder) + (let ((bp bitplane) (quit nil)) + (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.