;;; -*- Common Lisp -*-

#|  Copyright (c) 2007,2008 Gustavo Henrique Milar�

    This file is part of The Feebs War.

    The Feebs War is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 3 of the License, or
    (at your option) any later version.

    The Feebs War is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with The Feebs War.  If not, see <http://www.gnu.org/licenses/>.
|#


(in-package :the-feebs-war)



;;; -*- General Rules -*-

(def-feeb-parm 'game-length 320
  "Number of turns the game will last.")

(def-feeb-parm 'number-of-mushrooms 3
  "Maximum number of mushrooms created each turn.")

(let (turn-number total-time)

  (defun start-round ()
    (setf turn-number 0))

  (defun start-turn ()
    (incf turn-number)
    (setf total-time 0)
    (number-of-mushrooms
     (random (1+ (get-feeb-parm 'number-of-mushrooms)))))
  
  (defun finish-game-p ()
    (= (get-feeb-parm 'game-length) turn-number))

  (defun inc-total-time (time)
    (incf time total-time))

  (defun total-time ()
    total-time))

;;; Detecting if feeb is playing

(def-feeb-parm 'sense-location-p t
  "If nil, x-position and y-position will return nil when
   someone tries to invoke it. Otherwise return the position.")

(defmethod x-position :around ((fb feeb))
  (if (get-feeb-parm 'sense-location-p)
      (call-next-method)))

(defmethod y-position :around ((fb feeb))
  (if (get-feeb-parm 'sense-location-p)
      (call-next-method)))



;;; -*- Being Born and Dying -*-

;;; Being Born / Reincarnating

(def-feeb-parm 'starting-energy 50
  "Amount of energy a feeb will start with.")

(defmethod create-object :before ((feeb feeb) x y)
  (setf (feeb-energy-reserve feeb)
	 (get-feeb-parm 'starting-energy)
	(feeb-ready-to-fire feeb) t))

;;; Dying and Killing

(def-feeb-parm 'points-for-dying -3
  "How many points some feeb earn for dying (usually negative).")

(defmethod destroy-object :before ((feeb feeb) cause)
  (incf (feeb-score feeb) (get-feeb-parm 'points-for-dying)))

(def-feeb-parm 'points-for-killing 5
  "How many points some feeb earn for killing someone.")

(defmethod destroy-object :before ((feeb feeb) (fireball fireball))
  (let ((owner (fireball-owner fireball)))
    (unless (eq owner feeb)
      (incf (feeb-score owner) (get-feeb-parm 'points-for-killing))
      (incf (feeb-kill-counter owner)))))

;;; Carcasses:

(def-feeb-parm 'carcass-guaranteed-lifetime 5
  "Number of turns that a carcass will surely not rot.
After these turns, it can rot, depending on probabilities.")

(def-feeb-parm 'carcass-rot-probability 1/3
  "Probability of the carcass to rot, after the apropriate time.")

(defun rot-carcass-p (time)
  (and (> time (get-feeb-parm 'carcass-guaranteed-lifetime))
       (chance (get-feeb-parm 'carcass-rot-probability))))



;;; -*- Movement Choice -*-

;;; Fireballs:

(def-feeb-parm 'fireball-dissipation-probability 1/5
  "Probability of the flame to dissipate each turn after the
apropriate time.")

(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))
   ((and (>= (object-lifetime fireball)
             (get-feeb-parm 'fireball-guaranteed-lifetime))
         (chance (get-feeb-parm 'fireball-dissipation-probability)))
    :dissipate)
   (t :move-forward)))


;;; Feebs

(def-feeb-parm 'flame-no-recovery-time 2
  "Probability
of the feeb to recover the hability to throw a flame, after the apropriate
time.")

(def-feeb-parm 'flame-recovery-probability 1/3
  "Probability of the feeb to recover the hability to throw a flame,
after the apropriate time.")

(defmethod make-move-choice :around ((feeb feeb))
  (unless (feeb-ready-to-fire feeb)
    (and (> (feeb-turns-since-flamed feeb)
	    (get-feeb-parm 'flame-no-recovery-time))
	 (chance (get-feeb-parm 'flame-recovery-probability))
	 (setf (feeb-ready-to-fire feeb) t)))
  (let (choice)
    (inc-total-time
     (setf (feeb-time feeb)
	   (+ (- (get-internal-real-time))
	      (progn
		(setf choice (call-next-method))
		(get-internal-real-time)))))
    choice))



;;; -*- Moving -*-

;;; Fireball

(defmethod make-move :before ((fireball fireball) (move (eql :move-forward)))
  (multiple-value-bind (stuff x-pos y-pos)
      (get-forward-pos fireball)
    (dolist (thing stuff)
      (typecase thing
	(feeb (destroy-object thing fireball))
	((eql :mushroom)
	 (delete-object thing x-pos y-pos))))))


;;; Feebs

(def-feeb-parm 'slow-feeb-noop-switch nil
  "If is non-nil, there is a possibility that the move
of a feeb is aborted according to its function evaluation
time.")

(def-feeb-parm 'slow-feeb-noop-factor 1/4
  "The probability of the feeb to abort will be this factor
times the amount of time the feeb takes to have a decision,
divided by the total time taken by all the feebs in the
current turn, or divided by a reference time.")

(def-feeb-parm 'reference-time nil
  "Time taken by reference if non-nil. See slow-feeb-noop-factor.")

(def-feeb-parm 'points-for-slow-down -1
  "Points earned when a feeb's move is aborted due to slowness.")

(defmethod make-move :around ((feeb feeb) move)
  (if (get-feeb-parm 'slow-feeb-noop-switch)
      (if (chance (* (get-feeb-parm 'slow-feeb-noop-factor)
			 (/ (feeb-time feeb)
			    (or (get-feeb-parm 'reference-time)
				(total-time)))))
	  (prog1 nil ; in case that the move was eating something
	    (incf (feeb-score feeb) (get-feeb-parm 'points-for-slow-down)))
          (call-next-method))
      (call-next-method)))

(defmethod make-move :around ((feeb feeb) (move (eql :move-forward)))
  (aif (find-if #'fireball-p (get-forward-pos feeb))
       (if (call-next-method) ; was the move successfull?
           (destroy-object feeb it))
       (call-next-method)))

;;; Eating

(def-feeb-parm 'maximum-energy 100
  "The most energy a feeb can accumulate.")

(def-feeb-parm 'mushroom-energy 50
  "Amount of energy recovered when the feeb eats a mushroom.")

(defmethod make-move :around ((feeb feeb) (move (eql :eat-mushroom)))
  (when (call-next-method) ; was eating successfull?
    (setf (feeb-energy-reserve feeb)
	  (min (+ (feeb-energy-reserve feeb)
		  (get-feeb-parm 'mushroom-energy))
	       (get-feeb-parm 'maximum-energy)))))

(def-feeb-parm 'carcass-energy 30
  "Amount of energy recovered each turn that the feeb
eats a carcass.")

(defmethod make-move :around ((feeb feeb) (move (eql :eat-carcass)))
  (when (call-next-method)
    (setf (feeb-energy-reserve feeb)
	  (min (+ (feeb-energy-reserve feeb)
		  (get-feeb-parm 'carcass-energy))
	       (get-feeb-parm 'maximum-energy)))))

(def-feeb-parm 'flame-energy 10
  "Amount of energy lost after throwing a flame.")

(defmethod make-move :around ((feeb feeb) (move (eql :flame)))
  (when (and (feeb-ready-to-fire feeb)
             (>= (feeb-energy-reserve feeb) (get-feeb-parm 'flame-energy)))
    (setf (feeb-ready-to-fire feeb) nil)
    (decf (feeb-energy-reserve feeb) (get-feeb-parm 'flame-energy))
    (call-next-method)))