Update of /project/corman-sdl/cvsroot/corman-sdl/engine
In directory common-lisp.net:/tmp/cvs-serv20122/engine
Modified Files:
engine.lisp
Log Message:
Date: Wed Apr 14 21:54:18 2004
Author: lcrook
Index: corman-sdl/engine/engine.lisp
diff -u corman-sdl/engine/engine.lisp:1.1 corman-sdl/engine/engine.lisp:1.2
--- corman-sdl/engine/engine.lisp:1.1 Tue Apr 13 13:09:39 2004
+++ corman-sdl/engine/engine.lisp Wed Apr 14 21:54:18 2004
@@ -15,6 +15,8 @@
;;;;; Link list functions
(defstruct (dl (:print-function print-dl))
+ "Linked list node
+ dl-prev, dl-data, dl-next"
prev data next)
(defun print-dl (dl stream depth)
@@ -27,6 +29,7 @@
lst))
(defun dl-insert (x lst)
+ "Insert the item into the list before the node"
(let ((elt (make-dl :data x :next lst)))
(when (dl-p lst)
(if (dl-prev lst)
@@ -36,6 +39,7 @@
elt))
(defun dl-append (x lst)
+ "Insert the item into the list after the node"
(let ((elt (make-dl :data x :prev lst)))
(when (dl-p lst)
(if (dl-next lst)
@@ -45,10 +49,12 @@
elt))
(defun dl-list (&rest args)
+ "Create a linked list from the arguments provided as input"
(reduce #'dl-insert args
:from-end t :initial-value nil))
(defun dl-remove (lst)
+ "Remove the node from the linked list"
(if (dl-prev lst)
(setf (dl-next (dl-prev lst)) (dl-next lst)))
(if (dl-next lst)
@@ -56,16 +62,27 @@
(dl-next lst))
(defun dl-nextnode (lst)
+ "Return the next node in the list
+ Returns two values,
+ The next node in the list when dl-next is not nil
+ A value indicating if the next node is returned, or nill if the last node in the list"
(if (null (dl-next lst))
(values lst nil)
(values (dl-next lst) t)))
(defun dl-prevnode (lst)
+ "Return the previous node in the list
+ Returns two values,
+ The previous node in the list if dl-prev is not nil
+ A value indicating if the previous node is returned, or nill if the first node in the list"
(if (null (dl-prev lst))
(values lst nil)
(values (dl-prev lst) t)))
(defun dl-find (dl func)
+ "Find the first node in the list where the test function returns true
+ Searches front to back, starting at dl, which may not necessarily be the
+ front of the list"
(let ((obj dl))
(loop
(when (null obj) (return nil))
@@ -99,13 +116,13 @@
(t
(setf (zlevel-end zlevel) (dl-append obj (zlevel-end zlevel))))))
-(defun add-level (objects level)
+(defun add-level (object level)
(cond
- ((null (zlevel-end zlevel))
- (setf (zlevel-end zlevel) (dl-list obj))
- (setf (zlevel-start zlevel) (zlevel-end zlevel)))
+ ((null (zlevel-end level))
+ (setf (zlevel-end level) (dl-list object))
+ (setf (zlevel-start level) (zlevel-end level)))
(t
- (setf (zlevel-end zlevel) (dl-append obj (zlevel-end zlevel))))))
+ (setf (zlevel-end level) (dl-append object (zlevel-end level))))))
(defun remove-from-level (zlevel obj)
(when (null (dl-next obj))
@@ -117,173 +134,55 @@
(defun new-zlevel (zorder)
(make-zlevel :zorder zorder))
-(defun new-find-zlevel (zorder)
- #'(lambda (dl)
- (cond
- ((equal (sprite-id (dl-data dl)) zorder)
- dl
- nil)))
-
-(defun find-zlevel (levels zorder)
- (if (null levels)
+(defun find-zlevel (level zorder)
+ (if (null level)
(values nil nil)
- (let ((obj objects))
+ (let ((obj level) (quit nil))
(loop
- (when (null obj) (return))
+ (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
- (setf obj (dl-next obj))))))))
-
-
-
-
-(defun add-zlevel (objects zlevel)
-
-
-
-
+ (if (null (dl-next obj))
+ (setf quit t)
+ (setf obj (dl-next obj)))))))))
+
+(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)))
(defun add-object (spr)
- (when (null objects)
- (setf objects (new-zlevel (sprite-id spr))))
- (let ((obj (dl-find objects (new-find-zlevel (sprite-id spr)))))
- (if obj
- (
-
+ (addto-level (dl-data (return-zlevel objects (sprite-zorder spr))) spr))
+
+
-(defun add-to (obj l)
- (nconc l (list obj)))
-(defstruct node
- (prev nil)
- (next nil)
- data)
-
-(defun insert (data zorder llist)
- (if (null llist)
- (make-node :data (cons zorder (add-to data nil)))
- (if (eql (first (node-data llist)) zorder)
- (add-to data (node-data llist))
- (if (> (first (node-data llist)) zorder)
- (let ((node (make-node
- :data (cons zorder (add-to data (node-data llist)))
- :next llist
- :prev (node-prev llist))))
- (setf (node-prev llist) node))
- (if (null (node-next llist))
- (let ((node (make-node
- :data (cons zorder (add-to data (node-data llist)))
- :prev llist)))
- (setf (node-next llist) node))
- (insert data zorder (node-next llist)))))))
-
-
-(setf a-list '(1 2 3 4 5))
-(setf b-list '(a b c d e))
-(setf (cdr a-list) b-list)
-(setf a-list nil)
-
-(cdr (car b-list))
-
-
-
-#|(defun insert-into (lst node &optional (func #'<))
- (if (null lst)
- (cons node nil)
- (if (funcall func (first lst) node)
- (progn
- (setf (cdr lst) (insert-into (rest lst) node func))
- lst)
- (cons node lst))))
-|#
-
-#|(defun insert (lst node zorder &optional (func #'<))
- (if (null lst)
- (cons (list zorder node) nil)
- (cond
- ((funcall func (first (first lst)) zorder)
- (setf (cdr lst) (insert (cdr lst) node zorder func))
- lst)
- ((= (first (first lst)) zorder)
- (setf (cdr (first lst)) (insert-into (cdr (first lst)) node func))
- lst)
- (t
- (cons (list zorder node) lst)))))
-
-(defun get-zorder (lst)
- (if (null lst)
- nil
- (first (first lst))))
-
-(defun insert (lst node zorder &optional (func #'<))
- (if (null lst)
- (cons (list zorder node) nil)
- (cond
- ((funcall func (get-zorder lst) zorder)
- (setf (cdr lst) (insert (cdr lst) node zorder func))
- lst)
- ((= (get-zorder lst) zorder)
- (setf (cdr (first lst)) (insert-into (cdr (first lst)) node func))
- lst)
- (t
- (cons (list zorder node) lst)))))
-|#
-(defun add-to (lst nodes)
- (cond
- ((and (null lst) (listp nodes))
- nodes)
- ((null lst)
- (cons nodes nil))
- (t
- (let ((l (last lst)))
- (if (listp nodes)
- (setf (cdr l) nodes)
- (setf (cdr l) (cons nodes nil)))))))
-
-
- ((listp nodes)
- (setf lst nodes))
- (t
- (cons (last lst) nodes))))
-(defun insert (lst zorder nodes)
- (if (null lst)
- (cons (list
- zorder
- (add-to nil nodes))
- nil)
- (cond
- ((< (get-zorder lst) zorder)
- (setf (cdr lst) (insert (cdr lst) zorder nodes))
- lst)
- ((= (get-zorder lst) zorder)
- (setf (cdr (first lst)) (add-to (cdr (first lst)) nodes))
- lst)
- (t
- (cons (list zorder (add-to nil nodes)) lst)))))
-;(1 a b c d)
-(setf b-list '(2 e f g h))
-(last b-list)
-(setf a-list nil)
-(setf a-list (insert a-list 1 '(200 300 100 400 500)))
-(setf a-list (insert a-list 1 2))
-(setf a-list (insert-into a-list 0 #'<))
-(untrace insert-into)
+
-a-list
(defclass engine ()
@@ -294,57 +193,6 @@
-(defclass sprites ()
- (
- (sprite-list :accessor sprites)))
-
-(defun get-zorder (slist)
- (if (null slist)
- nil
- (if (listp slist)
- (first slist))))
-
-(defun add-to (sprites sprite)
- (nconc sprites (list sprite)))
-
-(defun insert-at (slist s z)
- (cond
- ((null slist)
- (list (cons z (add-to nil s))))
- ((listp (first slist))
- (insert-at (first slist) s z))
- ((eql (first slist) z)
- (add-to slist s))
- ((< (first slist) z)
- (add-to (rest slist) s))))
-
-
-(defmethod add-sprite ((sp-list sprites) (s sprite))
- (let ((sprite-list (sprites sp-list)))
- (cond
- ((if (eql (z-order s) (z-order sprites))))
- ((null sprite-list)
- (setf sprite-list
- (cons
- (z-order s) sprite-list)
- s))))))
-
-
-(defmethod add-sprite ((sprites sp-list) (s sprite))
- (
-
-
-
-(defmethod set-videosurface ((e engine) s)
- (when (and
- (not (null s))
- (ct:cpointerp s))
- (setf (engine-surface e) s)))
-
-
-
-(defmethod add-sprite ((e engine) (s sprite))
- )
