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