Author: gmilare
Date: Thu Jan 3 21:20:39 2008
New Revision: 13
Modified:
brains.lisp
extra.lisp
feebs.asd
feebs.tex
graphics.lisp
images.lisp
main.lisp
mazes.lisp
package.lisp
rules.lisp
system.lisp
Log:
Version 0.1.0
Documentation updated.
The program is object-oriented, so it is possible to add / change rules without changing
the internal code.
Parameters are not global variables anymore, but accessed by (get-feeb-parm) and (change-feeb-parm), for in-game-security reasons.
Created imagify function to transform feebs and fireballs into images. This way, if a feeb store the values given in vision and proximity, its contents won't represent the real state in game.
Modified: brains.lisp
==============================================================================
--- brains.lisp (original)
+++ brains.lisp Thu Jan 3 21:20:39 2008
@@ -29,30 +29,30 @@
(let ((stuff (my-square proximity)))
(cond ((and (member :mushroom stuff :test #'eq)
(< (energy-reserve status)
- (- *maximum-energy* 20)))
+ (- (get-feeb-parm 'maximum-energy) 20)))
:eat-mushroom)
((member :carcass stuff :test #'eq)
:eat-carcass)
((and (ready-to-fire status)
(> (energy-reserve status) 30)
(dotimes (index (min (line-of-sight status) 5))
- (let ((feeb (car (member-if #'feeb-image-p (svref vision index)))))
+ (let ((feeb (find-if #'feeb-image-p (svref vision index))))
(if (and feeb
(not (eq (feeb-image-facing feeb)
(facing status))))
(return t)))))
:flame)
- ((and (not (eq (left-square proximity) :rock))
+ ((and (not (wallp (left-square proximity)))
(or (member :mushroom (left-square proximity))
(> 3 (random 10))))
:turn-left)
- ((and (not (eq (right-square proximity) :rock))
+ ((and (not (wallp (right-square proximity)))
(or (member :mushroom (right-square proximity))
(> 3 (random 10))))
:turn-right)
((and (> (line-of-sight status) 0)
(not (dotimes (index (min (line-of-sight status) 7))
- (if (member-if #'fireball-image-p (svref vision index))
+ (if (find #'fireball-image-p (svref vision index))
(return t)))))
:move-forward)
(t
Modified: extra.lisp
==============================================================================
--- extra.lisp (original)
+++ extra.lisp Thu Jan 3 21:20:39 2008
@@ -52,10 +52,10 @@
;;; Directional arithmetic.
-(defun left-of (facing)
+(defun right-of (facing)
(mod (+ facing 3) 4))
-(defun right-of (facing)
+(defun left-of (facing)
(mod (+ facing 1) 4))
(defun behind (facing)
@@ -96,7 +96,7 @@
(defun wallp (thing)
(the boolean
- (eq :rock thing)))
+ (eq :rock (car thing))))
(defun chance (ratio)
(< (random (denominator ratio)) (numerator ratio)))
Modified: feebs.asd
==============================================================================
--- feebs.asd (original)
+++ feebs.asd Thu Jan 3 21:20:39 2008
@@ -7,20 +7,21 @@
(defsystem the-feebs-war
:description "The Feebs War is a continuation of Planet of the Feebs."
- :version "1.0"
+ :version "0.1"
:author "Gustavo Henrique Milar� <gugamilare(a)gmail.com>"
:licence "GPL"
-; :depends-on (pal)
+; :depends-on (lispbuilder-sdl lispbuilder-sdl-image lispbuilder-sdl-gfx)
:components
(;; source
(:cl-source-file "package")
- (:cl-source-file "system" :depends-on ("package"))
- (:cl-source-file "main" :depends-on ("system"))
+ (:cl-source-file "extra" :depends-on ("package"))
+ (:cl-source-file "system" :depends-on ("package" "extra"))
+ (:cl-source-file "images" :depends-on ("system"))
+ (:cl-source-file "main" :depends-on ("images" "system"))
(:cl-source-file "rules" :depends-on ("main"))
- (:cl-source-file "extra")
- (:cl-source-file "mazes")
+ (:cl-source-file "mazes" :depends-on ("package"))
(:cl-source-file "brains" :depends-on ("extra"))
(:file "graphics" :depends-on ("main"))
Modified: feebs.tex
==============================================================================
--- feebs.tex (original)
+++ feebs.tex Thu Jan 3 21:20:39 2008
@@ -103,7 +103,7 @@
and there are no CMUCL's event handler. This way, the code is more
portable and graphics can be improved. Just creating some image
files of a feeb and your feeb is much more personalized!
-\item Every element of the map (except walls) is a list, so the brain of
+\item Every element of the map (including walls) is a list, so the brain of
a feeb doesn't need to test all the time if the element is an atom
or a list (wich, in my opinion, is really boring, unlispy and unnecessary
in this case). That was only a reason to duplicate code and work,
@@ -118,7 +118,7 @@
\item It is possible now to extend the rules: the code is object oriented and
new rules, special moves, change the behavior of flames, etc, can be done
by adding new classes and/or methods. This manual is just the beginning!
-\end{itemize}
+end{itemize}
\section{The Game}
@@ -306,11 +306,11 @@
wich are 0, 1, 2 and 3 respectivelly.
\par\end{flushleft}
\item [{\textsf{\textbf{(x-position}\emph{~status}\textbf{)}}}] \begin{flushleft}
-The horizontal position of the feeb, increasing to east.
+The horizontal position of the feeb, starting with 0 and increasing to east.
If \textsf{\textbf{'sense-location-p}} is nil, it returns nil instead.
\par\end{flushleft}
\item [{\textsf{\textbf{(y-position}\emph{~status}\textbf{)}}}] \begin{flushleft}
-The vertical position of the feeb, increasing to north.
+The vertical position of the feeb, starting with 0 and increasing to south.
If \textsf{\textbf{'sense-location-p}} is nil, it returns nil instead.
\par\end{flushleft}
\item [{\textsf{\textbf{(peeking}\emph{~status}\textbf{)}}}] \begin{flushleft}
@@ -323,7 +323,7 @@
\item [{\textsf{\textbf{(line-of-sight}\emph{~status}\textbf{)}}}] \begin{flushleft}
Indicates the amount of valid entries in \textsf{\emph{vision}}. It actually
means that \textsf{\textbf{(aref}\emph{~vision~}\textbf{(line-of-sight}\emph{~status}\textbf{))}}
-will return \textsf{\textbf{:rock}}.
+will return \textsf{\textbf{'(:rock)}}.
\par\end{flushleft}
\item [{\textsf{\textbf{(ready-to-fire}\emph{~status}\textbf{)}}}] \begin{flushleft}
If \textsf{\textbf{T}} indicates that the feeb is ready to fire.
@@ -368,12 +368,13 @@
\textsf{\textbf{(aref}\emph{~vision~}1\textbf{)}}
will return the contents of the next square, and so on. As said before,
\textsf{\textbf{(aref}\emph{~vision~}\textbf{(line-of-sight}\emph{~status}\textbf{))}}
-will be the first :rock encountered. All subsequents square, like
+will be the first \textsf{\textbf{'(:rock)}} encountered. All subsequents square, like
\textsf{\textbf{(aref}\emph{~vision~}\textbf{(+}~1~\textbf{(line-of-sight}\emph{~status}\textbf{)))}},
will be garbage and should not be used.
\end{lyxlist}
The contents of one square returned by any of these calls is either
-:rock or a list of elements, or \textsf{\textbf{()}} if the
+a list of elements, a wall \textsf{\textbf{'(:rock)}} (i.e. a list with
+one element, a \textsf{\textbf{:rock}}) or \textsf{\textbf{()}} if the
square is empty. Each element of the square is one of these:
\begin{itemize}
@@ -385,8 +386,7 @@
in the square of the feeb (i.e. in \textsf{\textbf{(my-square}}\textsf{\emph{~proximity}}\textsf{\textbf{)}}),
the call \textsf{\textbf{:eat-carcass}} will make the feeb eat it.
\item \textsf{\textbf{:mushroom}}. Analogous to \textsf{\textbf{:carcass}}.
-A mushroom appears randomly in places (mushroom patchs) previouly
-marked in the map.
+A mushroom appears randomly in places previously marked in the map.
\end{itemize}
\subsubsection{Feebs and fireballs images}
@@ -394,9 +394,9 @@
Both fireballs and feebs that are given to the brain function are
not the real ones, but just images with contents that the brain function
can access. It is allowed to keep and change its contents because they
-doesn't represent anything.
+won't be used internally.
-These are the fields available:
+These are the accessors available (they read and change the fiels):
\begin{lyxlist}{00.00.0000}
\item [{\textsf{\textbf{(feeb-image-name}~feeb-image\textbf{)}}}] \begin{flushleft}
@@ -412,7 +412,7 @@
not.
\par\end{flushleft}
\item [{\textsf{\textbf{(fireball-image-direction}~fireball-image\textbf{)}}}] \begin{flushleft}
-The direction that the fireball image is going to.
+The direction where the fireball image is going to.
\par\end{flushleft}
\end{lyxlist}
@@ -426,17 +426,17 @@
Note that feebs that are not peeking, mushrooms and carcasses are
\emph{not} be detected by these vectors. Also, if there is a feeb
-peeking to the opposite side, it won't be detected either. These are
-the possible returns of the elements in \textsf{\textbf{vision-left}}
-and \textsf{\textbf{vision-right}}:
+peeking to the opposite side, it won't be detected either. The
+elements in \textsf{\textbf{vision-left}} and \textsf{\textbf{vision-right}}
+are lists containing these elements:
\begin{lyxlist}{00.00.0000}
\item [{\textsf{\textbf{:peek-letf}}}] This means that in that square there
is a feeb peeking to (its) left.
\item [{\textsf{\textbf{:peek-right}}}] This means that in that square
there is a feeb peeking to (its) right.
-\item [{\textsf{\textbf{nil}}}] This square is empty.
-\item [{\textsf{\textbf{:rock}}}] This square is just a wall.
+\item [{\textsf{\textbf{:rock}}}] This square is just a wall. In this case,
+this is the only element in the square.
\end{lyxlist}
\subsection{Extra functions provided}
@@ -452,9 +452,15 @@
It is possible to change the layout of the map by calling
\textsf{\textbf{(change-layout}~new-layout\textbf{)}}.
There are a few predefined mazes that are in variables \textsf{\textbf{{*}maze-0{*}}}
-throw \textsf{\textbf{{*}maze-5{*}}}. If you want to create a new
-map, you can start by an empty template of any size provided by
-\textsf{\textbf{(make-template}~x-size~y-size~\textbf{:density}~density\textbf{)}}.
+(which is set by default) throw \textsf{\textbf{{*}maze-5{*}}}.
+In a layout, `X' represents a wall, `e' represents a feeb entry point
+(there will be as many entry points as feebs in the maze at the same time),
+`m' represents a mushroom site and ` ' is a blank space.
+
+If you want to create a new map, you can start by an empty template
+of any size that is provided by \textsf{\textbf{(make-template}~x-size~y-size\textbf{)}},
+or you can get a reandom map calling
+\textsf{\textbf{(generate-maze}~x-size~y-size~\textbf{:density}~density\textbf{)}}
The density is a number, recomended to be between 0.25 and 0.45,
which tells the portion of the maze should be blank spaces.
The function quits after a while if it doesn't meet this portion. See
@@ -483,7 +489,7 @@
\subsection{Starting the game}
-The game loop is started by calling (feebs).
+The game loop is started by calling \textsf{\textbf{(simple-play)}}.
@@ -506,11 +512,12 @@
what is really in the maze, but only the possible ways.
To get the map, one can call \textsf{\textbf{(get-maze-map)}}. This
-function will return \textsf{\textbf{nil}} if parameter \textsf{\textbf{'may-get-maze-map-p}}
-is also \textsf{\textbf{nil}}. Otherwise, the map returned is an array,
-so that calling \textsf{\textbf{(aref}~map~x~y\textbf{)}}
-will get the contents in the euclidean position (x,y) . The contents
-of a cell could be one of these:
+function will return \textsf{\textbf{nil}} if parameter
+\textsf{\textbf{'may-get-maze-map-p}} is also \textsf{\textbf{nil}}.
+Otherwise, the map returned is an array, so that calling
+\textsf{\textbf{(aref}~map~x~y\textbf{)}} will get the contents
+in the position (x,y) (like euclidean but inverting the y axis).
+The contents of a cell could be one of these:
\begin{lyxlist}{00.00.0000}
\item [{\textsf{\textbf{:mushroom-place}}}] A mushroom patch, i.e. when
@@ -522,6 +529,9 @@
the previous.
\end{lyxlist}
+This map can safelly be used since \textsf{\textbf{(get-maze-map)}} makes
+a new copy every time it is called.
+
\subsection{Timing}
There are also some timing atributes that can be given to the game.
@@ -537,7 +547,7 @@
\item [{\textsf{\textbf{'slow-feeb-noop-factor}}}] 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 by a reference time.
+by all the feebs in the current turn or divided by a reference time.
\item [{\textsf{\textbf{'reference-time}}}] Time taken by reference
if non-nil.
\item [{\textsf{\textbf{'points-for-slow-down}}}] Points earned when
Modified: graphics.lisp
==============================================================================
--- graphics.lisp (original)
+++ graphics.lisp Thu Jan 3 21:20:39 2008
@@ -35,10 +35,11 @@
(cond
((wallp elt)
(list " XX"))
- ((feeb-image-p (car elt))
+ ((feeb-p (car elt))
(list "F~1d~a"
+ (position (feeb-name (car elt)) *feebs* :key #'feeb-name)
(print-direction (feeb-facing (car elt)))))
- ((fireball-image-p (car elt))
+ ((fireball-p (car elt))
(list " *~a" (print-direction (fireball-direction (car elt)))))
((eq (car elt) :mushroom)
(list " mm"))
@@ -52,11 +53,16 @@
(change-layout layout))
(make-auto-feebs (- 10 (length *feebs-to-be*)))
(initialize-feebs)
- (loop repeat *game-length* do
- (play-one-turn) (print-map) (sleep 0.7) (format t "~%~%"))
- (format t "Fim de jogo!!~%~%Pontua��es:~%~%")
+ (start-round)
+ (loop do
+ (play-one-turn)
+ (print-map)
+ (sleep 0.7)
+ (format t "~%~%")
+ (if (finish-game-p) (return)))
+ (format t "Game Over!!~%~%Scores:~%~%")
(dolist (feeb *feebs*)
- (format t "~a: ~d~%" (feeb-name feeb) (feeb-score feeb))))
+ (format t "~a: ~d~%" (feeb-name feeb) (feeb-score feeb))))
#|
Modified: images.lisp
==============================================================================
--- images.lisp (original)
+++ images.lisp Thu Jan 3 21:20:39 2008
@@ -27,6 +27,24 @@
;;; -*- Vision Calculation -*-
+(defstruct feeb-image
+ name facing peeking)
+
+(defstruct fireball-image
+ direction)
+
+(defstruct (proximity
+ (:conc-name nil))
+ my-square
+ rear-square
+ left-square
+ right-square)
+
+(defun rcurry (func &rest args)
+ #'(lambda (x)
+ (apply func x args)))
+
+
;;; Computes what the feeb is seeing
(defun compute-vision (feeb)
@@ -41,19 +59,17 @@
(y (feeb-y-position feeb)))
;; First fill in proximity info.
(setf (my-square proximity)
- (imagify feeb (aref *maze* x y) 'proximity)
+ (mapcar (rcurry #'imagify feeb :proximity)
+ (aref *maze* x y))
(left-square proximity)
- (imagify feeb
- (aref *maze* (+ x (left-dx facing)) (+ y (left-dy facing)))
- :proximity)
+ (mapcar (rcurry #'imagify feeb :proximity)
+ (aref *maze* (+ x (left-dx facing)) (+ y (left-dy facing))))
(right-square proximity)
- (imagify feeb
- (aref *maze* (+ x (right-dx facing)) (+ y (right-dy facing)))
- :proximity)
+ (mapcar (rcurry #'imagify feeb :proximity)
+ (aref *maze* (+ x (right-dx facing)) (+ y (right-dy facing))))
(rear-square proximity)
- (imagify feeb
- (aref *maze* (+ x (behind-dx facing)) (+ y (behind-dy facing)))
- :proximity))
+ (mapcar (rcurry #'imagify feeb :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)))
@@ -72,50 +88,61 @@
(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) :rock
- (aref vision-left index) :unknown
- (aref vision-right index) :unknown
- (line-of-sight status) index))
- (setf (aref vision index) (imagify feeb (aref *maze* x y) :vision)
+ (setf (aref vision index) (list :rock)
+ (aref vision-left index) (list :unknown)
+ (aref vision-right index) (list :unknown)
+ (feeb-line-of-sight feeb) index))
+ (setf (aref vision index)
+ (mapcar (rcurry #'imagify feeb :vision)
+ (aref *maze* x y))
(aref vision-left index)
- (imagify feeb
- (aref *maze* left-wall-x left-wall-y)
- :left-vision)
+ (mapcar (rcurry #'imagify feeb :left-vision)
+ (aref *maze* left-wall-x left-wall-y))
(aref vision-right index)
- (imagify feeb
- (aref *maze* right-wall-x right-wall-y)
- :right-vision)))))
+ (mapcar (rcurry #'imagify feeb :right-vision)
+ (aref *maze* right-wall-x right-wall-y))))))
-(defstruct feeb-image
- name facing peeking)
-
-(defstruct fireball-image
- direction)
;;; This transforms what the feeb is seeing;
-(defgeneric imagify (feeb thing type)
+(defgeneric imagify (feeb type thing)
(:documentation "Defines how FEEB sees or feels THING.
TYPE could be :vision, :left-vision :right-vision or :proximity")
- (:method (feeb thing type)
+ (:method (thing feeb type)
thing)
- (:method (feeb (thing feeb)
- (type (or (eql :vision) (eql :proximity))))
+ (:method ((thing feeb) feeb (type (eql :vision)))
+ (make-feeb-image :name (feeb-name thing)
+ :facing (feeb-facing thing)
+ :peeking (feeb-peeking thing)))
+
+ (:method ((thing feeb) feeb (type (eql :proximity)))
(make-feeb-image :name (feeb-name thing)
- :facing (feeb-facing feeb)
- :peeking (feeb-peeking feeb)))
+ :facing (feeb-facing thing)
+ :peeking (feeb-peeking thing)))
- (:method (feeb (thing fireball)
- (type (or (eql :vision) (eql :proximity))))
+ (:method ((thing fireball) feeb (type (eql :vision)))
(make-fireball-image :direction (fireball-direction thing)))
- (:method (feeb thing
- (or (eql :left-vision) (eql :right-vision)))
- nil)
+ (:method ((thing fireball) feeb (type (eql :proximity)))
+ (make-fireball-image :direction (fireball-direction thing)))
+
+ (:method (thing feeb (type (eql :left-vision)))
+ (if (eq :rock thing)
+ :rock))
+
+ (:method (thing feeb (type (eql :right-vision)))
+ (if (eq :rock thing)
+ :rock))
- (:method (feeb (thing feeb)
- (or (eql :left-vision) (eql :right-vision)))
- (and (feeb-image-p thing)
- (= facing (feeb-image-facing thing))
- (feeb-image-peeking thing))))
+ (:method ((thing feeb) feeb (type (eql :left-vision)))
+ (and (feeb-p thing)
+ (= (feeb-facing feeb) (left-of (feeb-facing thing)))
+ (feeb-peeking thing)))
+
+ (:method ((thing feeb) feeb (type (eql :right-vision)))
+ (and (feeb-p thing)
+ (= (feeb-facing feeb) (right-of (feeb-facing thing)))
+ (feeb-peeking thing)))
+
+) ; end of imagify generic function
Modified: main.lisp
==============================================================================
--- main.lisp (original)
+++ main.lisp Thu Jan 3 21:20:39 2008
@@ -21,15 +21,6 @@
(in-package :feebs)
-;; These are defined provisorily here
-;; the definitive version is in rules.lisp
-
-(defun rot-carcass-p (time)
- t)
-
-(defun finish-game-p ()
- nil)
-
;;; Parameters
@@ -43,12 +34,13 @@
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)
- (gethash name parameters))
+ (car (gethash name parameters)))
- (defun change-parameter (name value)
+ (defun change-feeb-parm (name value)
(unless *playing-feeb*
(setf (car (gethash name parameters)) value)))
@@ -65,29 +57,24 @@
;;; 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.")
-;;; Tests that behavior functions might use
-
-;; (declare (inline feeb-image-p fireball-image-p))
-
-;; (defun feeb-image-p (thing)
-;; (typep thing 'feeb))
-
-;; (defun fireball-image-p (thing)
-;; (typep thing 'fireball))
-
-
;;; 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"
+*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:
@@ -127,48 +114,44 @@
*number-of-mushroom-sites* 0
*number-of-entry-points* 0)
(do ((rows *layout* (cdr rows))
- (i (1- *maze-y-size*) (1- i))) ; inverting the y axis
+ (y (1- *maze-y-size*) (1- y))) ; inverting the y axis
((null rows))
(let ((str (car rows)))
- (dotimes (j (length str))
- (setf (aref *maze* j i) nil
- (aref *fake-maze* j i) nil)
- (case (schar str j)
+ (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* j i) :rock
- (aref *maze* j i) :rock))
+ (setf (aref *fake-maze* x y) :rock
+ (aref *maze* x y) (list :rock)))
(#\*
- (setf (aref *fake-maze* j i) :mushroom-place)
+ (setf (aref *fake-maze* x y) :mushroom-place)
(incf *number-of-mushroom-sites*)
- (push (make-pos j i) *mushroom-sites*))
+ (push (cons x y) *mushroom-sites*))
(#\e
- (setf (aref *fake-maze* j i)
+ (setf (aref *fake-maze* x y)
:feeb-entry-place)
(incf *number-of-entry-points*)
- (push (make-pos j i) *entry-points*))
+ (push (cons x y) *entry-points*))
(#\space nil)
(t
- (error "Unknown spec in maze: ~C." (schar str j))))))))
+ (error "Unknown spec in maze: ~C." (schar str x))))))))
+
+(eval-when (:load-toplevel)
+ (init-maze))
(defun initialize-feebs ()
- (setf *mushrooms-alive* *number-of-mushrooms*
- *dead-feebs* nil
- *fireballs-flying* nil
- *continue* t
- *mushroom-sites* nil
- *entry-points* nil
- *carcasses* nil
- *static-parameters*
- (loop for (symbol . value) in (list-parameter-settings)
- collect value))
+ (setf *feebs* ()
+ *dead-feebs* ()
+ *fireballs-flying* ()
+ *mushroom-sites* ()
+ *carcasses* ()
+ *playing-feeb* nil)
+ (init-maze)
(create-feebs)) ; The feebs are defined here
-;;; Setting up the feebs.
-
-(defvar *feebs* nil)
-
;;; Define-Feeb builds a list of feebs to create. Create-Feebs actually
;;; builds the feebs on this list.
@@ -179,16 +162,19 @@
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*))
+ :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=)))
+ (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
@@ -208,18 +194,17 @@
:graphics graphs
:x-position x-pos
:y-position y-pos)))
- (push feeb *feebs*)
(if (and x-pos y-pos)
(create-object feeb x-pos y-pos)
(push feeb *dead-feebs*)))))
- (let ((entries (sort *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)))))
+ (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))))))
@@ -234,14 +219,15 @@
;; This is defined by rules:
(start-turn) ; possible call to number-of-mushrooms
;; Maybe grow up mushrooms:
- (let ((m-sites (sort *mushroom-sites*
+ (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 (member #'fireball-p)
- (create-mushroom (car site) (cdr site))))))
+ (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)))
@@ -254,14 +240,15 @@
(push carc *carcasses*))))
;; Move some fireballs:
(dolist (fireball *fireballs-flying*)
- (move-object fireball (make-move-choice fireball)))
+ (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 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*)
@@ -269,6 +256,6 @@
;; binds the variable to the current playing feeb
(dolist (feeb *feebs*)
;; Collect the feeb's move
- (move-object feeb (feeb-last-move feeb))))
+ (make-move feeb (feeb-last-move feeb))))
) ; end of let ((mushrooms 1))
Modified: mazes.lisp
==============================================================================
--- mazes.lisp (original)
+++ mazes.lisp Thu Jan 3 21:20:39 2008
@@ -226,15 +226,8 @@
(defun make-template (x-size y-size)
"Prints map template of the requested size.
Use this to create new mazes."
- (dotimes (i y-size)
- (format t "~@?~a~@?~%"
- (if (zerop i)
- "~4t'(\""
- "~6t\"")
- (make-string x-size :initial-element #\X)
- (if (= i y-size)
- "\")"
- "\""))))
+ (loop repeat y-size collect
+ (make-string x-size :initial-element #\X)))
(defun density (maze xs ys)
(let ((sum 0))
@@ -373,8 +366,8 @@
corridor-y-avg corridor-y-max))
(if y1 (bound-random y1 corridor-y-min
corridor-y-avg corridor-y-max)))
- (real-dens ))
- ((or (>= real density)
+ (real-dens (density map x-size y-size)))
+ ((or (>= real-dens density)
(> i (* density x-size y-size))) ; quits after trying TOO MUCH
(values (translate map x-size y-size) real-dens))
(if x1
Modified: package.lisp
==============================================================================
--- package.lisp (original)
+++ package.lisp Thu Jan 3 21:20:39 2008
@@ -33,37 +33,7 @@
(defpackage :feebs
(:use :common-lisp)
;; Export everything we want the players to get their hands on.
- (:export *game-length*
-
- ;; Strategic quantities
- *points-for-killing* *points-for-dying*
- *flame-energy* *mushroom-energy* *carcass-energy*
- *maximum-energy*
- *starting-energy*
-
- ;; Game quantities
- *maze-x-size*
- *maze-y-size*
- *number-of-mushrooms*
-
- ;; Probabilities
- *fireball-guaranteed-lifetime*
- *fireball-dissipation-probability*
- *fireball-reflection-probability*
- *flame-no-recovery-time*
- *flame-recovery-probability*
-
- ;; Difficulty variables
- *slow-feeb-noop-switch*
- *slow-feeb-noop-factor*
- *sense-location-p*
-;; *sense-facing-p* ;; if this will be used, one must find a way to
-;; ;; a feeb detect other feeb's facing, and fireball's
-;; ;; direction, only relative to the feeb (in the brain call)
-;; ;; should not be so difficult
- *may-get-maze-map-p*
-
- ;; Slots accessors
+ (:export ;; Slots accessors
name facing
x-position y-position peeking line-of-sight
energy-reserve
@@ -82,6 +52,38 @@
get-feeb-parm change-feeb-parm
list-parameter-settings
+ game-length
+
+ ;; Pontuation
+ points-for-killing points-for-dying
+ points-for-slow-down
+
+ ;; Energy
+ flame-energy mushroom-energy carcass-energy
+ maximum-energy
+ starting-energy
+ carcass-rot-probability
+ carcass-guaranteed-lifetime
+
+ ;; Game quantities
+ maze-x-size
+ maze-y-size
+ number-of-mushrooms
+
+ ;; Probabilities
+ fireball-guaranteed-lifetime
+ fireball-dissipation-probability
+ fireball-reflection-probability
+ flame-no-recovery-time
+ flame-recovery-probability
+
+ ;; Difficulty variables
+ slow-feeb-noop-switch
+ slow-feeb-noop-factor
+ reference-time
+ sense-location-p
+ may-get-maze-map-p
+
;; Settings
define-feeb delete-feeb
feebs
@@ -92,7 +94,8 @@
north south east west
;; Some layouts (can be find in mazes.lisp)
- *maze-1* *maze-2* *maze-3* *maze-4* *maze-5*
+ *maze-0* *maze-1* *maze-2*
+ *maze-3* *maze-4* *maze-5*
make-template generate-maze
;; Graphics
@@ -117,6 +120,7 @@
(in-package :feebs)
+
;;; Directions
(deftype direction ()
@@ -133,9 +137,6 @@
(defvar *number-of-mushroom-sites* 0)
(defvar *feeb-parameters* nil)
-;;; These are for security
-
-(defvar *static-parameters* nil)
;;; Setting up the maze.
@@ -147,7 +148,7 @@
(defvar *maze* nil)
(defvar *fake-maze* nil)
-(defparameter *layout*
+(defparameter *maze-0*
'("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
"Xe * XXXXXXX XXXXXXXXXX"
"XXXXX XXXXXXX XXXXXXX * XXXXX"
@@ -181,35 +182,33 @@
"XXXXX XXXXXXXXXXXXX X"
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"))
+(defparameter *layout* *maze-0*)
;;; Map size
-(def-feeb-parm 'maze-x-size 32
- "Horizontal size of the maze.")
-
-(def-feeb-parm 'maze-y-size 32
- "Vertical size of the maze.")
-
(defvar *maze-x-size* 32)
(defvar *maze-y-size* 32)
;;; Quantities during the game
-(defvar *mushroom-sites*)
-(defvar *entry-points*)
-(defvar *number-of-entry-points*)
-(defvar *mushrooms-alive*)
+(defvar *mushroom-sites* ())
+(defvar *entry-points* ())
+(defvar *number-of-entry-points* 0)
+
;;; Elements in the maze
-(defvar *fireballs-flying*)
-(defvar *dead-feebs*)
-(defvar *carcasses*)
+(defvar *feebs* ())
+(defvar *dead-feebs* ())
+(defvar *fireballs-flying* ())
+(defvar *carcasses* ())
+
;;; Current feeb playing
-(defvar *playing-feeb*)
+(defvar *playing-feeb* nil)
+(defvar *feebs-to-be* ())
(defmacro aif (test then &optional else)
`(let ((it ,test))
Modified: rules.lisp
==============================================================================
--- rules.lisp (original)
+++ rules.lisp Thu Jan 3 21:20:39 2008
@@ -32,7 +32,6 @@
"Maximum number of mushrooms created each turn.")
(let (turn-number total-time)
- ;; Function redefinitions
(defun start-round ()
(setf turn-number 0))
@@ -73,7 +72,7 @@
;;; Being Born / Reincarnating
(def-feeb-parm 'starting-energy 50
- "Smallest amount of energy a feeb will start with.")
+ "Amount of energy a feeb will start with.")
(defmethod create-object :before ((feeb feeb) x y)
(setf (feeb-energy-reserve feeb)
@@ -92,16 +91,16 @@
"How many points some feeb earn for killing someone.")
(defmethod destroy-object :before ((feeb feeb) (fireball fireball))
- (unless (eq (fireball-owner fireball) feeb)
- (incf (feeb-score (fireball-owner fireball))
- (get-feeb-parm 'points-for-killing))))
+ (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.")
+ "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.")
@@ -136,7 +135,7 @@
;;; Feebs
-(deef-feeb-parm 'flame-no-recovery-time 2
+(def-feeb-parm 'flame-no-recovery-time 2
"Probability
of the feeb to recover the hability to throw a flame, after the apropriate
time.")
@@ -146,17 +145,19 @@
after the apropriate time.")
(defmethod make-move-choice :around ((feeb feeb))
- (inc-total-time
- (setf (feeb-time feeb)
- (+ (- (get-intenal-real-time))
- (progn
- (call-next-method)
- (get-intenal-real-time)))))
(unless (feeb-ready-to-fire feeb)
- (and (> (feeb-turns-since-flamed feebs)
+ (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))))
+ (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))
@@ -242,5 +243,5 @@
(defmethod make-move :around ((feeb feeb) (move (eql :flame)))
(when (>= (feeb-energy-reserve feeb) (get-feeb-parm 'flame-energy))
- (decf (feeb-energy-reserve) (get-feeb-parm 'flame-energy))
+ (decf (feeb-energy-reserve feeb) (get-feeb-parm 'flame-energy))
(call-next-method)))
Modified: system.lisp
==============================================================================
--- system.lisp (original)
+++ system.lisp Thu Jan 3 21:20:39 2008
@@ -33,19 +33,14 @@
(defclass feeb (object)
(;; These are structures accessible from behavior functions.
- ;; These (whose :reader start with feeb-image)
- ;; are intended to be accessed by other feebs
(name :accessor feeb-name :reader name :initarg :name)
- (direction :reader facing :initform (random 4))
- (peeking :accessor feeb-peeking :reader peeking)
-
- ;; These are intended to be accessed only by the feeb itself
+ (direction :reader facing :initform (random 4) :accessor feeb-facing)
+ (peeking :accessor feeb-peeking :reader peeking :initform nil)
(x-position :reader x-position :accessor feeb-x-position)
(y-position :reader y-position :accessor feeb-y-position)
(line-of-sight :accessor feeb-line-of-sight :reader line-of-sight
:initform 0)
- (energy-reserve :accessor feeb-energy-reserve :reader energy-reserve
- :initform *starting-energy*)
+ (energy-reserve :accessor feeb-energy-reserve :reader energy-reserve)
(ready-to-fire :accessor feeb-ready-to-fire :reader ready-to-fire
:initform t)
(aborted :accessor feeb-aborted :reader aborted)
@@ -57,9 +52,8 @@
(graphics :accessor feeb-graphics :initarg :graphics)
(time :accessor feeb-time :initform 0)
(last-score :accessor feeb-last-score :initform 0)
- (last-kills :accessor feeb-last-kills :initform 0)
+ (kill-counter :accessor feeb-kill-counter :initform 0)
(score :accessor feeb-score :initform 0)
- (kills :accessor feeb-kills :initform 0)
(turns-since-flamed :accessor feeb-turns-since-flamed :initform 0)
(proximity :accessor feeb-proximity :initform (make-proximity))
(vision :accessor feeb-vision
@@ -94,14 +88,10 @@
t))
(defun delete-object (thing x y)
- (when (eq thing :mushroom)
- (decf *mushrooms-alive*))
(setf (aref *maze* x y)
(delete thing (aref *maze* x y))))
(defun place-object (thing x j)
- (when (eq thing :mushroom)
- (incf *mushrooms-alive*))
(push thing (aref *maze* x j)))
(defun change-object-pos (obj x y)
@@ -123,29 +113,28 @@
;;; --**-- System Rules --**--
-;;; -*- General Rules -*-
-
-;; These will be redefined by rules
-
-(defun start-turn ()
- t)
-
-(defun start-round ()
- t)
-
-
;;; -*- Being Born and Dying -*-
;;; Creating
-(defgeneric create-object (object x-pos y-pos &key &allow-other-keys)
+(defgeneric create-object (object x-pos y-pos)
+ (:documentation "Creates OBJECT and places it in position (X-POS,Y-POS)
+in the maze, except for fireballs, which are placed only the next turn.")
(:method (object x-pos y-pos)
- (change-object-pos object x-pos y-pos))
+ (place-object object x-pos y-pos)
+ (setf (object-x-position object) x-pos
+ (object-y-position object) y-pos))
+
(:method ((feeb feeb) x-pos y-pos)
- (setf (feeb-dead-p feeb) nil
- (feeb-last-move feeb) :dead)
- (pushnew feeb *feebs*)))
+ (setf (feeb-last-move feeb) :dead)
+ (push feeb *feebs*)
+ (call-next-method))
+
+ (:method ((fireball fireball) x-pos y-pos)
+ (push fireball *fireballs-flying*)
+ (setf (object-x-position object) x-pos
+ (object-y-position object) y-pos))) ; don't place it yet, only after first move
;;; Reincarnating
@@ -155,15 +144,25 @@
;;; Dying
-(defgeneric destroy-object (object cause &key &allow-other-keys)
+(defgeneric destroy-object (object cause)
+ (:documentation "Called when CAUSE destroys OBJECT.
+CAUSE could be :starve or a fireball (for feebs)
+or :dissipate (for fireballs)."
+ (:method (object cause)
+ (delete-object object (object-x-position object)
+ (object-y-position object)))
+
+ (:method ((fireball fireball) cause)
+ (setf *fireballs-flying*
+ (delete fireball *fireballs-flying*))
+ (call-next-method))
+
(:method ((feeb feeb) cause)
(setf *dead-feebs* (nconc *dead-feebs* (list feeb))
- (feeb-dead-p feeb) t
*feebs* (delete feeb *feebs*))
(let* ((x (feeb-x-position feeb))
(y (feeb-y-position feeb)))
(push (list 0 x y) *carcasses*)
- (delete-object (feeb-image feeb) x y)
(place-object :carcass x y))
(call-next-method)))
@@ -177,7 +176,7 @@
(:documentation "Lets object make its move choice.")
(:method ((feeb feeb))
(funcall (feeb-brain feeb)
- (feeb-status feeb)
+ feeb
(feeb-proximity feeb)
(feeb-vision feeb)
(feeb-vision-left feeb)
@@ -198,6 +197,10 @@
(setf (object-direction object)
(right-of (object-direction object))))
+ (:method (object (move (eql :turn-left)))
+ (setf (object-direction object)
+ (left-of (object-direction object))))
+
(:method (object (move (eql :turn-around)))
(setf (object-direction object)
(behind (object-direction object))))
@@ -205,21 +208,18 @@
(:method (object (move (eql :move-forward)))
(multiple-value-bind (stuff new-x new-y)
(get-forward-pos object)
- (when (wallp stuff)
- (return-from make-move nil))
- (change-object-pos object new-x new-y)))
+ (unless (wallp stuff)
+ (change-object-pos object new-x new-y))))
(:method ((fireball fireball) (move (eql :dissipate)))
- (destroy-object fireball))
+ (destroy-object fireball :dissipate))
(:method ((feeb feeb) (move (eql :flame)))
- (let ((x (feeb-x-position feeb))
- (y (feeb-y-position feeb))
- (fireball
- (make-instace 'fireball (feeb-facing feeb)
- feeb x y (forward-dx facing)
- (forward-dy facing))))
- (push fireball *fireballs-flying*)))
+ (setf (feeb-turns-since-flamed feeb) 0)
+ (create-object
+ (make-instance 'fireball :direction (feeb-facing feeb)
+ :owner feeb)
+ (feeb-x-position feeb) (feeb-y-position feeb)))
(:method ((feeb feeb) (move (eql :eat-mushroom)))
(let ((x (feeb-x-position feeb))
@@ -229,14 +229,16 @@
t)))
(:method ((feeb feeb) (move (eql :eat-carcass)))
- (when (find :carcass (aref *maze* (feeb-x-position feeb)
- (feeb-y-position feeb)))
- t))
-
- (:method ((feeb feeb) (move (or (eql :peek-left) (eql :peek-right))))
- (multiple-value-bind (x y stuff)
- (get-forward-pos feeb)
- (unless (wallp stuff)
- (setf (feeb-peeking feeb) move))))
+ (when (find :carcass (aref *maze* (feeb-x-position feeb)
+ (feeb-y-position feeb)))
+ t))
+
+ (:method ((feeb feeb) (move (eql :peek-left)))
+ (unless (wallp (get-forward-pos feeb))
+ (setf (feeb-peeking feeb) move)))
+
+ (:method ((feeb feeb) (move (eql :peek-right)))
+ (unless (wallp (get-forward-pos feeb))
+ (setf (feeb-peeking feeb) move)))
) ; end of make-move generic function
