/[the-feebs-war]/system.lisp
ViewVC logotype

Diff of /system.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by gmilare, Sun Dec 30 22:43:46 2007 UTC revision 11 by gmilare, Mon Dec 31 21:35:35 2007 UTC
# Line 27  Line 27 
27  ;;; This class is used by the system  ;;; This class is used by the system
28    
29  (defclass object ()  (defclass object ()
30    ((direction :accessor object-direction)    ((direction :accessor object-direction :initarg :direction)
31     (x-position :accessor object-x-position)     (x-position :accessor object-x-position :initarg :x-position)
32     (y-position :accessor object-y-position)))     (y-position :accessor object-y-position :initarg :y-position)))
33    
34  (defclass feeb (object)  (defclass feeb (object)
35    (;; These are structures accessible from behavior functions.    (;; These are structures accessible from behavior functions.
36     ;; These (whose :reader start with feeb-image)     ;; These (whose :reader start with feeb-image)
37     ;; are intended to be accessed by other feebs     ;; are intended to be accessed by other feebs
38     (name :accessor feeb-name :reader name :initarg :name     (name :accessor feeb-name :reader name :initarg :name)
39           :reader feeb-image-name)     (direction :reader facing :initform (random 4))
40     (direction :reader facing :reader feeb-image-facing     (peeking :accessor feeb-peeking :reader peeking)
               :initform (random 4))  
    (peeking :accessor feeb-peeking :reader peeking  
             :reader feeb-image-peeking)  
41    
42       ;; These are intended to be accessed only by the feeb itself       ;; These are intended to be accessed only by the feeb itself
43     (x-position :reader x-position :initform 0 :initarg :x-position)     (x-position :reader x-position :accessor feeb-x-position)
44     (y-position :reader y-position :initform 0 :initarg :y-position)     (y-position :reader y-position :accessor feeb-y-position)
45     (line-of-sight :accessor feeb-line-of-sight :reader line-of-sight     (line-of-sight :accessor feeb-line-of-sight :reader line-of-sight
46                    :initform 0)                    :initform 0)
47     (energy-reserve :accessor feeb-energy-reserve :reader energy-reserve     (energy-reserve :accessor feeb-energy-reserve :reader energy-reserve
# Line 55  Line 52 
52     (last-move :accessor feeb-last-move :reader last-move     (last-move :accessor feeb-last-move :reader last-move
53                :initform :dead)                :initform :dead)
54    
55     ;; These are available for the system only     ;; These are available for the system
56     (brain :accessor feeb-brain :initarg :brain)     (brain :accessor feeb-brain :initarg :brain)
57     (graphics :accessor feeb-graphics :initarg :graphics)     (graphics :accessor feeb-graphics :initarg :graphics)
58     (time :accessor feeb-time :initform 0)     (time :accessor feeb-time :initform 0)
# Line 64  Line 61 
61     (score :accessor feeb-score :initform 0)     (score :accessor feeb-score :initform 0)
62     (kills :accessor feeb-kills :initform 0)     (kills :accessor feeb-kills :initform 0)
63     (dead-p :accessor feeb-dead-p)     (dead-p :accessor feeb-dead-p)
    (playing-p :accessor feeb-playing-p)  
64     (turns-since-flamed :accessor feeb-turns-since-flamed :initform 0)     (turns-since-flamed :accessor feeb-turns-since-flamed :initform 0)
65     (proximity :accessor feeb-proximity :initform (make-proximity))     (proximity :accessor feeb-proximity :initform (make-proximity))
66     (vision :accessor feeb-vision     (vision :accessor feeb-vision
# Line 74  Line 70 
70     (vision-right :accessor feeb-vision-right     (vision-right :accessor feeb-vision-right
71             :initform (make-array (list (max *maze-y-size* *maze-x-size*))))))             :initform (make-array (list (max *maze-y-size* *maze-x-size*))))))
72    
73    (defclass fireball (object)
74      ((owner :accessor fireball-owner :initarg :owner)
75       (x-position :accessor fireball-x-position)
76       (y-position :accessor fireball-y-position)
77       (direction :accessor fireball-direction)))
78    
79    (declaim
80     (inline fireball-p feeb-p))
81    
82    (defun fireball-p (x)
83      (typep x 'fireball))
84    
85    (defun feeb-p (x)
86      (typep x 'feeb))
87    
88  ;;; These make sure that these accessors are just available  ;;; These make sure that these accessors are just available
89  ;;; for the feeb itself  ;;; for the feeb itself
90    
# Line 161  Line 172 
172    
173  ;;; -*- General Rules -*-  ;;; -*- General Rules -*-
174    
175  (defgeneric start-turn (&key &allow-other-keys)  ;; These will be redefined by rules
176    (:method () t))  
177    (defun start-turn ()
178      t)
179    
180    (defun start-round ()
181      t)
182    
183    
184    
# Line 202  Line 218 
218    
219    
220    
 ;;; -*- Vision Calculation -*-  
   
 ;;; Computes what the feeb is seeing  
   
 (defun compute-vision (feeb)  
   (let ((proximity (feeb-proximity feeb))  
         (vision (feeb-vision feeb))  
         (vision-left (feeb-vision-left feeb))  
         (vision-right (feeb-vision-right feeb))  
         (facing (feeb-facing feeb))  
         vision-dx  
         vision-dy  
         (x (feeb-x-position feeb))  
         (y (feeb-y-position feeb)))  
     ;; First fill in proximity info.  
     (setf (my-square proximity)  
            (aref *maze* x y)  
           (left-square proximity)  
            (aref *maze* (+ x (left-dx facing)) (+ y (left-dy facing)))  
           (right-square proximity)  
            (aref *maze* (+ x (right-dx facing)) (+ y (right-dy facing)))  
           (rear-square proximity)  
            (aref *maze* (+ x (behind-dx facing)) (+ y (behind-dy facing))))  
     ;; The vision vector starts in the square the feeb is facing.  
     (setf x (+ x (forward-dx facing))  
           y (+ y (forward-dy facing)))  
     ;; Figure out which direction to scan in.  
     (case (feeb-peeking feeb)  
       (:left (setf facing (left-of facing)))  
       (:right (setf facing (right-of facing))))  
     (setf vision-dx (forward-dx facing)  
           vision-dy (forward-dy facing))  
     ;; compute vision, vision-left and vision-right  
     (do* ((x x (+ x vision-dx))  
           (y y (+ y vision-dy))  
           (left-wall-x (+ x (left-dx facing)) (+ left-wall-x vision-dx))  
           (left-wall-y (+ y (left-dy facing)) (+ left-wall-y vision-dy))  
           (right-wall-x (+ x (right-dx facing)) (+ right-wall-x vision-dx))  
           (right-wall-y (+ y (right-dy facing)) (+ right-wall-y vision-dy))  
           (index 0 (1+ index)))  
          ((wallp (aref *maze* x y))  
           (setf (aref vision index) (aref *maze* x y)  
                 (aref vision-left index) :unknown  
                 (aref vision-right index) :unknown  
                 (line-of-sight status) index))  
       (setf (aref vision index) (aref *maze* x y)  
             (aref vision-left index)  
              (side-imagify (aref *maze* left-wall-x left-wall-y)  
                            (right-of facing))  
             (aref vision-right index)  
              (side-imagify (aref *maze* right-wall-x right-wall-y)  
                            (left-of facing))))))  
   
 ;;; Compute the info to be put into the vision-left and vision-right vectors.  
 ;;; A peeking feeb must be facing in the specified direction in order to count.  
   
 (defun side-imagify (stuff facing)  
   (if (wallp stuff)  
       stuff  
       (loop for thing in stuff  
             and elt = (and (feeb-image-p thing)  
                            (= facing (feeb-image-facing thing))  
                            (feeb-image-peeking thing))  
             if elt  
                return it)))  
   
   
   
221  ;;; -*- Movement -*-  ;;; -*- Movement -*-
222    
223  ;;; Lets the feeb make a choice  ;;; Lets the feeb make a choice
224    
225  (defgeneric make-move-choice (object &key &allow-other-keys)  (defgeneric make-move-choice (object)
226      (:documentation "Lets object make its move choice.")
227    
228    (:method ((feeb feeb))    (:method ((feeb feeb))
229      (funcall (feeb-brain feeb)      (funcall (feeb-brain feeb)
230               (feeb-status feeb)               (feeb-status feeb)
# Line 286  Line 236 
236  ;;; Moving  ;;; Moving
237    
238  (defgeneric make-move (object move)  (defgeneric make-move (object move)
239      (:documentation "Applies the move MOVE to OBJECT. The MOVE is
240    returned from MAKE-MOVE-CHOICE for the same object.")
241    
242    (:method (object (move (eql :turn-right)))    (:method (object (move (eql :turn-right)))
243      (setf (object-direction object)      (setf (object-direction object)
244            (right-of (object-direction object)))            (right-of (object-direction object)))
# Line 316  Line 269 
269  ;;; Feeb moves  ;;; Feeb moves
270    
271    (:method ((feeb feeb) (move (eql :move-forward)))    (:method ((feeb feeb) (move (eql :move-forward)))
272      (let ((thing (find-if #'fireball-image-p stuff)))      (let ((thing (find-if #'fireball-p stuff)))
273        (when thing (destroy-object feeb thing)        (when thing (destroy-object feeb thing)
274              (return-from make-move t)))              (return-from make-move t)))
275      (call-next-method))      (call-next-method))
# Line 325  Line 278 
278      (let ((x (feeb-x-position feeb))      (let ((x (feeb-x-position feeb))
279            (y (feeb-y-position feeb))            (y (feeb-y-position feeb))
280            (fireball            (fireball
281             (make-fireball-image (feeb-facing feeb)             (make-instace 'fireball (feeb-facing feeb)
282                                  feeb x y (forward-dx facing)                           feeb x y (forward-dx facing)
283                                  (forward-dy facing))))                           (forward-dy facing))))
284        (push fireball *fireballs-flying*)        (push fireball *fireballs-flying*)
285        t))        t))
286    
# Line 344  Line 297 
297        (when (member :carcass (aref *maze* x y))        (when (member :carcass (aref *maze* x y))
298          t)))          t)))
299    
300    (:method ((feeb feeb) (move (eql :peek-left)))    (:method ((feeb feeb) (move (or (eql :peek-left) (eql :peek-right))))
301      (multiple-value-bind (x y stuff)      (multiple-value-bind (x y stuff)
302          (get-forward-pos feeb)          (get-forward-pos feeb)
303        (unless (wallp stuff)        (unless (wallp stuff)
304          (setf (peeking feeb) move)))          (setf (feeb-peeking feeb) move)))
     t)  
305    
   (:method make-move ((feeb feeb) (move (eql :peek-right)))  
     (multiple-value-bind (x y stuff)  
         (get-forward-pos feeb)  
       (unless (wallp stuff)  
         (setf (peeking feeb) move)))  
     t)  
306    ) ; end of make-move generic function    ) ; end of make-move generic function

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

  ViewVC Help
Powered by ViewVC 1.1.5