[the-feebs-war-cvs] r19 - definitions

[Gustavo Milare]

Author: gmilare
Date: Tue Aug  3 20:09:54 2010
New Revision: 19

Log:
Added fireball-guaranteed-lifetime support


Modified:
   definitions/rules.lisp
   system.lisp
   the-feebs-war.asd

Modified: definitions/rules.lisp
==============================================================================
--- definitions/rules.lisp	(original)
+++ definitions/rules.lisp	Tue Aug  3 20:09:54 2010
@@ -122,13 +122,19 @@
 (def-feeb-parm 'fireball-reflection-probability 2/3
   "Probability of the flame to reflect when encountering a wall.")
 
+(def-feeb-parm 'fireball-guaranteed-lifetime 3
+  "Number of turns that a fireball is guaranteed not to dissipate,
+unless it encounters a wall.")
+
 (defmethod make-move-choice ((fireball fireball))
   (cond
    ((wallp (get-forward-pos fireball))
     (if (chance (get-feeb-parm 'fireball-reflection-probability))
-	:turn-around
-      :dissipate))
-   ((chance (get-feeb-parm 'fireball-dissipation-probability))
+        :turn-around
+        :dissipate))
+   ((and (>= (object-lifetime fireball)
+             (get-feeb-parm 'fireball-guaranteed-lifetime))
+         (chance (get-feeb-parm 'fireball-dissipation-probability)))
     :dissipate)
    (t :move-forward)))
 

Modified: system.lisp
==============================================================================
--- system.lisp	(original)
+++ system.lisp	Tue Aug  3 20:09:54 2010
@@ -27,9 +27,10 @@
 ;;; This class is used by the system
 
 (defclass object ()
-  ((direction :accessor object-direction :initarg :direction)
+  ((direction  :accessor object-direction  :initarg :direction :initform 0)
    (x-position :accessor object-x-position :initarg :x-position)
-   (y-position :accessor object-y-position :initarg :y-position)))
+   (y-position :accessor object-y-position :initarg :y-position)
+   (lifetime   :accessor object-lifetime   :initarg :lifetime)))
 
 (defclass feeb (object)
   (;; These are structures accessible from behavior functions.
@@ -244,3 +245,5 @@
 
   ) ; end of make-move generic function
 
+(defmethod make-move :after (object move)
+  (incf (object-lifetime object)))

Modified: the-feebs-war.asd
==============================================================================
--- the-feebs-war.asd	(original)
+++ the-feebs-war.asd	Tue Aug  3 20:09:54 2010
@@ -1,4 +1,4 @@
-;;; -*- Common Lisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 
 (defpackage :feebs-system
   (:use :cl :asdf))