# Diff of /main.lisp

revision 7 by gmilare, Sun Dec 30 01:30:32 2007 UTC revision 9 by gmilare, Sun Dec 30 22:43:46 2007 UTC
# Line 44  Line 44
44     during the game.")     during the game.")
45
46

47  ;;; Tests that behavior functions might use  ;;; Tests that behavior functions might use
48
49  (declare (inline feeb-image-p fireball-image-p))  (declare (inline feeb-image-p fireball-image-p))
# Line 82  They could have used (get-maze-map). Tho Line 81  They could have used (get-maze-map). Tho
81  of *maze-x-size* by *maze-y-size*. Each element of the  of *maze-x-size* by *maze-y-size*. Each element of the
82  array is one of these:  array is one of these:
83   :rock - a wall   :rock - a wall
84   :mushroom-place - here is a place where mushrooms can grow up   :mushroom-place - place where mushrooms can grow up
85   :feeb-entry-place - here is a place where a feeb can reincarnate   :feeb-entry-place -place where a feeb can reincarnate
86   nil - nothing special   nil - nothing special
87  Just remember that variables can change the behavior of this function,  Just remember that if *may-get-maze-map-p* is nil,
88  like *may-get-maze-map-p* which, if nil, makes this function return  this function return an array of nils"
an array of nils"
89    (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*))))    (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*))))
90      (dotimes (x *maze-x-size*)      (dotimes (x *maze-x-size*)
91        (dotimes (y *maze-y-size*)        (dotimes (y *maze-y-size*)
# Line 152  an array of nils" Line 150  an array of nils"
150
151  (defvar *feebs-to-be* nil)  (defvar *feebs-to-be* nil)
152
153  (defun define-feeb (name brain &optional graphics)  (defun define-feeb (name brain &key graphics (class 'feeb))
154    "Defines a feeb with name NAME, behavior function BRAIN.    "Defines a feeb with name NAME, behavior function BRAIN.
155  If there is another feeb with the same name, overwrites it  If there is another feeb with the same name, overwrites it
156  with a case sensitive test."  with a case sensitive test."
157    (when (find name *feebs-to-be* :key #'car    (when (find name *feebs-to-be* :key #'car
158                :test #'string= (delete-feeb name))                :test #'string= (delete-feeb name))
159        (warn "Feeb ~s already exists, deleting..." name))        (warn "Feeb ~s already exists, deleting..." name))
160    (push (list name brain graphs) *feebs-to-be*))    (push (list name brain graphics class) *feebs-to-be*))
161
162  (defun delete-feeb (name)  (defun delete-feeb (name)
163    "Deletes the feeb which has name NAME, causing it not to    "Deletes the feeb which has name NAME, causing it not to
# Line 179  when the game begins." Line 177  when the game begins."
177    (setf *feebs-to-be* nil))    (setf *feebs-to-be* nil))
178
179  (defun create-feebs ()  (defun create-feebs ()
180    (flet ((create-feeb (x-pos y-pos name brain graphs)    (flet ((create-feeb (x-pos y-pos name brain graphs class)
181             (let ((feeb (make-instance 'feeb             (let ((feeb (make-instance class
182                                        :name name                                        :name name
183                                        :brain brain                                        :brain brain
184                                        :direction (random 4)                                        :direction (random 4)
# Line 206  when the game begins." Line 204  when the game begins."
204
205  (let ((mushrooms 0))  (let ((mushrooms 0))
206
207  (defun number-of-mushrooms (n)    (defun number-of-mushrooms (n)
208    (setf *mushrooms-to-grow* n))      (setf *mushrooms-to-grow* n))
209
210  (defun play-one-turn ()    (defun play-one-turn ()
211    (setf mushrooms 0) ; restart the count      (setf mushrooms 0) ; restart the count
212    ;; This is defined by rules:      ;; This is defined by rules:
213    (start-turn)      (start-turn)
214    ;; Maybe grow up mushrooms:      ;; Maybe grow up mushrooms:
215    (let ((m-sites (sort *mushroom-sites*      (let ((m-sites (sort *mushroom-sites*
216                         #'(lambda (x y)                           #'(lambda (x y)
217                             (declare (ignore x y))                               (declare (ignore x y))
218                             (zerop (random 2))))))                               (zerop (random 2))))))
219      (dotimes (i mushrooms)        (dotimes (i mushrooms)
220        (let ((site (pop m-sites)))          (let ((site (pop m-sites)))
221          (create-mushroom (car site) (cdr site)))))            (create-mushroom (car site) (cdr site)))))
222    ;; Maybe rot some carcasses      ;; Maybe rot some carcasses
223    ;; FIXME: put this in rules.lisp with better code      ;; FIXME: Ugly code code, and
224    (loop for carc in *carcasses*      (loop for carc in *carcasses*
225          with ncarcasses do            with ncarcasses do
226      (if (rot-carcass-p (first carc))            (if (rot-carcass-p (first carc))
227          (delete-object :carcass (second carc) (third carc)))                (progn
228        (progn                  (delete-object :carcass (second carc) (third carc))
229          (push carc ncarcasses)                  (reincarnate-feeb (pop *dead-feebs*)))
230          (incf (first carc)))))              (progn
231    ;; Move some fireballs:                (push carc ncarcasses)
232                  (incf (first carc)))))
233        ;; Move some fireballs:
234    (dolist (fireball *fireballs-flying*)    (dolist (fireball *fireballs-flying*)
235      (move-object fireball (make-move-choice fireball)))      (move-object fireball (make-move-choice fireball)))
236        (progn    (progn
237          ;; Starve the feeb:      ;; Starve the feeb:
238          (when (<= (decf (feeb-energy-reserve feeb)) 0)      (when (<= (decf (feeb-energy-reserve feeb)) 0)
239            (destroy-object feeb :starve))        (destroy-object feeb :starve))
240          ;; Compute vision for the feeb:      ;; Compute vision for the feeb:
241          (compute-vision feeb)      (compute-vision feeb)
242          ;; Collect the feeb's move      ;; Collect the feeb's move
243          (setf (feeb-peeking feeb) nil)      (setf (feeb-peeking feeb) nil)
244          (move-object feeb (setf (feeb-last-move feeb)      (move-object feeb (setf (feeb-last-move feeb)
245                                  (make-move-choice feeb)))))))                              (make-move-choice feeb)))))))
246  )  )

Legend:
 Removed from v.7 changed lines Added in v.9