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



;;; Parameters

(let ((parameters (make-hash-table :test 'eq)))

  (defun def-feeb-parm (name value &optional doc)
    (aif (gethash name parameters)
	 (progn
	   (warn "Change parameter ~a to ~a: ~
parameter already existed with value ~a." name value (car it))
	   (setf (gethash name parameters) (cons value (or doc (cdr it)))))
       (setf (gethash name parameters) (cons value doc)))
    (export name)
    name)

  (defun get-feeb-parm (name)
    (car (gethash name parameters)))

  (defun change-feeb-parm (name value)
    (unless *playing-feeb*
      (setf (car (gethash name parameters)) value)))

  (defmethod documentation (name (type (eql 'feeb-parameter)))
    (cdr (gethash name parameters)))
  
  (defun list-parameter-settings ()
    (let (params)
      (maphash #'(lambda (key value)
		   (push (list key (car value) (cdr value)) params))
	       parameters)
      params)))


;;; Characteristics of the maze:

(def-feeb-parm 'maze-x-size *maze-x-size*
  "Horizontal size of the maze.")

(def-feeb-parm 'maze-y-size *maze-y-size*
  "Vertical size of the maze.")

(def-feeb-parm 'may-get-maze-map-p t
  "Tells if the function (get-maze-map) returns the map layout
instead of nil during the game.")



;;; The maze

;;; Changing the maze
(defun change-layout (layout)
  "Changes the layout of the map. See variables
*maze-0* throw *maze-5* for examples (or options) of layouts."
  (when *feebs-to-be*
    (warn "There are some feebs that have already been defined.
They could have used (get-maze-map). Those are they:
~a." (loop for feeb in *feebs-to-be* collect (first feeb))))
  (let ((x (length layout))
	(y (length (car layout))))
    (loop for string in layout do
	  (if (/= (length string) y)
	      (error "Not all the strings in ~a have the same size." layout)))
    (setf *layout* layout
	  *maze-y-size* (change-feeb-parm 'maze-y-size y)
	  *maze-x-size*(change-feeb-parm 'maze-x-size x)))
  (init-maze))

(defun get-maze-map ()
  "Gets the current maze in the map. It returns an array
of *maze-x-size* by *maze-y-size*. Each element of the
array is one of these:
 :rock - a wall
 :mushroom-place - place where mushrooms can grow up
 :feeb-entry-place -place where a feeb can reincarnate
 nil - nothing special
Just remember that if *may-get-maze-map-p* is nil,
this function return nil."
  (and (get-feeb-parm 'may-get-maze-map-p)
       (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*))))
	 (dotimes (x *maze-x-size*)
	   (dotimes (y *maze-y-size*)
	     (setf (aref new-maze x y) (aref *fake-maze* x y))))
	 new-maze)))

(defun init-maze ()
  (setf *maze* (make-array (list *maze-x-size* *maze-y-size*))
	*fake-maze* (make-array (list *maze-x-size* *maze-y-size*))
	*entry-points* nil
	*mushroom-sites* nil
	*number-of-mushroom-sites* 0
	*number-of-entry-points* 0)
  (do ((rows *layout* (cdr rows))
       (y (1- *maze-y-size*) (1- y))) ; inverting the y axis
      ((null rows))
    (let ((str (car rows)))
      (dotimes (x (length str))
	(setf (aref *maze* x y) nil
	      (aref *fake-maze* x y) nil)
	(case (schar str x)
	  (#\X
	   (setf (aref *fake-maze* x y) :rock
		 (aref *maze* x y) (list :rock)))
	  (#\*
	   (setf (aref *fake-maze* x y) :mushroom-place)
	   (incf *number-of-mushroom-sites*)
	   (push (cons x y) *mushroom-sites*))
	  (#\e
	   (setf (aref *fake-maze* x y)
		       :feeb-entry-place)
	   (incf *number-of-entry-points*)
	   (push (cons x y) *entry-points*))
	  (#\space nil)
	  (t
	   (error "Unknown spec in maze: ~C." (schar str x))))))))

(eval-when (:load-toplevel)
  (init-maze))

(defun initialize-feebs ()
  (setf	*feebs* ()
	*dead-feebs* ()
	*fireballs-flying* ()
	*mushroom-sites* ()
	*carcasses* ()
	*playing-feeb* nil)
  (init-maze)
  (create-feebs)) ; The feebs are defined here



;;; Define-Feeb builds a list of feebs to create.  Create-Feebs actually
;;; builds the feebs on this list.

(defvar *feebs-to-be* nil)

(defun define-feeb (name brain &key graphics (class 'feeb))
  "Defines a feeb with name NAME, behavior function BRAIN.
If there is another feeb with the same name, overwrites it
with a case sensitive test."
  (when (find name *feebs-to-be* :key #'car
	      :test #'string=)
    (delete-feeb name)
    (warn "Feeb ~s already exists, deleting..." name))
  (push (list name brain graphics class) *feebs-to-be*)
  name)

(defun delete-feeb (name)
  "Deletes the feeb which has name NAME, causing it not to
be created when the game begins. Does not work for feebs
already in the game."
  (setf *feebs-to-be*
	(remove name *feebs-to-be* :key #'car :test #'string=))
  nil)

(defun list-of-feebs ()
  "Returns a copy of the list of feebs that will be created
when the game begins."
  (loop for (name . rest) in *feebs-to-be*
	collect name))

(defun delete-all-feebs ()
  "Deletes all feebs that are to be defined when the game begins."
  (setf *feebs-to-be* nil))

(defun create-feebs ()
  (flet ((create-feeb (x-pos y-pos name brain graphs class)
	   (let ((feeb (make-instance class
				      :name name
				      :brain brain
				      :graphics graphs
				      :x-position x-pos
				      :y-position y-pos)))
	     (if (and x-pos y-pos)
		 (create-object feeb x-pos y-pos)
	       (push feeb *dead-feebs*)))))
    (let ((entries (sort (copy-list *entry-points*) ; random positions
			 #'(lambda (x y)
			     (declare (ignore x y))
			     (zerop (random 2))))))
      (setf *feebs* nil)
      (dolist (feeb-spec *feebs-to-be*)
	(let ((pos (pop entries)))
	  (apply #'create-feeb (car pos) (cdr pos) feeb-spec))))))



;;; The Game

(let ((mushrooms 1))

  (defun number-of-mushrooms (n)
    (setf mushrooms n))

  (defun play-one-turn ()
    ;; This is defined by rules:
    (start-turn) ; possible call to number-of-mushrooms
    ;; Maybe grow up mushrooms:
    (let ((m-sites (sort (copy-list *mushroom-sites*)
			 #'(lambda (x y)
			     (declare (ignore x y))
			     (zerop (random 2))))))
      (dotimes (i mushrooms)
	(let ((site (pop m-sites)))
	  (unless (find-if #'fireball-p
			   (aref *maze* (car site) (cdr site)))
	    (create-mushroom (car site) (cdr site))))))
    ;; Maybe rot some carcasses
    (dolist (carc (prog1 *carcasses*
		    (setf *carcasses* nil)))
      (if (rot-carcass-p (first carc))
	  (progn
	    (delete-object :carcass (second carc) (third carc))
	    (reincarnate-feeb (pop *dead-feebs*)))
	(progn
	  (incf (first carc))
	  (push carc *carcasses*))))
    ;; Move some fireballs:
    (dolist (fireball *fireballs-flying*)
      (make-move fireball (make-move-choice fireball)))
    (dolist (feeb *feebs*)
      ;; Starve the feeb:
      (when (<= (decf (feeb-energy-reserve feeb)) 0)
	(destroy-object feeb :starve)))
    (dolist (*playing-feeb* *feebs*)
      ;; Compute vision for the feeb:
      (compute-vision *playing-feeb*)
      (incf (feeb-turns-since-flamed *playing-feeb*))
      ;; Lets the feeb make a choice
      (setf (feeb-last-move *playing-feeb*)
	     (make-move-choice *playing-feeb*)
	    (feeb-peeking *playing-feeb*) nil))
    ;; binds the variable to the current playing feeb
    (dolist (feeb *feebs*)
      ;; Collect the feeb's move
      (make-move feeb (feeb-last-move feeb))))

  ) ; end of let ((mushrooms 1))