the-feebs-war-cvs

Download

the-feebs-war-cvs@common-lisp.net

January 2008

1 participants
2 discussions

[the-feebs-war-cvs] r13 -
by gmilare＠common-lisp.net 04 Jan '08

04 Jan '08

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

1 0

[the-feebs-war-cvs] r12 -
by gmilare＠common-lisp.net 02 Jan '08

02 Jan '08

Author: gmilare Date: Wed Jan 2 10:40:42 2008 New Revision: 12 Modified: feebs.tex main.lisp package.lisp rules.lisp system.lisp Log: Modified: feebs.tex ============================================================================== --- feebs.tex (original) +++ feebs.tex Wed Jan 2 10:40:42 2008 @@ -1,18 +1,3 @@ -\documentclass[english]{article} -\usepackage[T1]{fontenc} -\usepackage[latin1]{inputenc} -\IfFileExists{url.sty}{\usepackage{url}} - {\newcommand{\url}{\texttt}} - -\makeatletter -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Textclass specific LaTeX commands. -\newenvironment{lyxlist}[1] -{\begin{list}{} -{\settowidth{\labelwidth}{#1} - \setlength{\leftmargin}{\labelwidth} - \addtolength{\leftmargin}{\labelsep} - \renewcommand{\makelabel}[1]{##1\hfil}}} -{\end{list}} % Copyright (c) 2007 Gustavo Henrique Milar� % @@ -31,7 +16,21 @@ % 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/>. +\documentclass[english]{article} +\usepackage[T1]{fontenc} +\usepackage[latin1]{inputenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} +\makeatletter +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Textclass specific LaTeX commands. +\newenvironment{lyxlist}[1] +{\begin{list}{} +{\settowidth{\labelwidth}{#1} + \setlength{\leftmargin}{\labelwidth} + \addtolength{\leftmargin}{\labelsep} + \renewcommand{\makelabel}[1]{##1\hfil}}} +{\end{list}} \IfFileExists{url.sty}{\usepackage{url} @@ -110,12 +109,15 @@ in this case). That was only a reason to duplicate code and work, adding no results at all... \item Many functions and variables are changed and others were added -\item This document is more objective than the one provided with \textit{Planet +\item Documentation is more objective than the one provided with \textit{Planet of the Feebs}, and is fully compatible with the code. This way it is easier to understand the game. +\item Security is improved. Now it the behavior functions are allowed to store +and change structures and vectors passed to it. +The parameters can't be change by those functions while inside the game. \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. This manual -is just the beginning! +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} \section{The Game} @@ -162,18 +164,17 @@ \subsection{Throwing flame} -If a feeb decides to throw a flame, and if it is prepared to, it will -spend energy, and the next turn there will be a flame in the square -in front of the feeb. For a few turns, the feeb will not be able to -throw flames. The turn after the feeb throws the flame, it is able -to see its own flame exactly in front of it, so it shouldn't move -forward. Each turn, the flame moves forward destroing mushrooms and +If a feeb decides to throw a flame, if it is prepared to and has +enough energy, the next turn there will be a flame in the square +in front of the feeb, and it will see it, so the feeb shouldn't move +forward. For a few turns, the feeb will not be able to +throw flames. Each turn, the flame moves forward destroing mushrooms and killing feebs it encounters, transforming them into carcass. If there is a wall, the flame can reflect, and, if so, it will turn 180 degrees. Once a feeb is killed (or starves), in it's place in the maze there will appear -a carcass. The feeb goes to the end of the dead feebs line. After a while -the first feeb in line will reincarnate. So, dying is not so terrible. +a carcass. The feeb goes to the end of the dead feebs line. When the +carcass rots, the first feeb in line reincarnates. So, dying is not so terrible. These are the parameters related to flames: @@ -198,7 +199,8 @@ There are two kinds of food, carcasses and mushrooms. Carcasses usually give less energy than mushrooms, and may rot, but, while it does not -rot, a feeb can feed as long as it wishes. By eating food, the feeb +rot, a feeb can feed as long as it wishes. Mushrooms disapear after +being eaten. By eating food, the feeb will be able to recover energy, wich is important because, if a feeb stays with 0 or less units of energy, it starves. @@ -339,10 +341,12 @@ \subsubsection{Proximity and vision} The brain receives also information about what is near the feeb and -what the feeb sees. +what the feeb sees. We note that, contrary to \emph{Planet of the Feebs}, +it is safe to change anything inside these structures, so you are +alowed to keep them stored and to modify them as you wish. The structure \textsf{\emph{proximity}} has the contents of the squares -near the feeb, not affected by peeking, with these fields: +near the feeb (not affected by peeking) with these fields: \begin{lyxlist}{00.00.0000} \item [{\textsf{\textbf{(my-square}}\textsf{\emph{~proximity}}\textsf{\textbf{)}}}] \begin{flushleft} @@ -389,7 +393,8 @@ 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. +can access. It is allowed to keep and change its contents because they +doesn't represent anything. These are the fields available: Modified: main.lisp ============================================================================== --- main.lisp (original) +++ main.lisp Wed Jan 2 10:40:42 2008 @@ -27,11 +27,7 @@ (defun rot-carcass-p (time) t) -(defun reincarnate-feeb-p (feeb) - t) - (defun finish-game-p () - ;; This is a little dangerous... nil) @@ -53,7 +49,8 @@ (gethash name parameters)) (defun change-parameter (name value) - (setf (car (gethash name parameters)) value)) + (unless *playing-feeb* + (setf (car (gethash name parameters)) value))) (defmethod documentation (name (type (eql 'feeb-parameter))) (cdr (gethash name parameters))) @@ -244,11 +241,14 @@ (dotimes (i mushrooms) (let ((site (pop m-sites))) (unless (member #'fireball-p) - (create-mushroom (car site) (cdr site))))) + (create-mushroom (car site) (cdr site)))))) ;; Maybe rot some carcasses (dolist (carc (prog1 *carcasses* (setf *carcasses* nil))) - (unless (rot-carcass (first carc) (second carc) (third carc)) + (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*)))) @@ -256,22 +256,19 @@ (dolist (fireball *fireballs-flying*) (move-object fireball (make-move-choice fireball))) (dolist (feeb *feebs*) - (if (feeb-dead-p feeb) - ;; Reincarnate some feebs (if the rules allow it) - (reincarnate-feeb feeb) - (progn - ;; Starve the feeb: - (when (<= (decf (feeb-energy-reserve feeb)) 0) - (destroy-object feeb :starve)) - ;; Compute vision for the feeb: - (compute-vision feeb)))) + ;; Starve the feeb: + (when (<= (decf (feeb-energy-reserve feeb)) 0) + (destroy-object feeb :starve))) (dolist (*playing-feeb* *feebs*) - (unless (feeb-dead-p *playing-feeb*) - ;; Collect the feeb's move - (move-object *playing-feeb* - (prog1 - (setf (feeb-last-move *playing-feeb*) - (make-move-choice *playing-feeb*)) - (setf (feeb-peeking *playing-feeb*) nil)))))))) - -) ; end of let ((mushrooms 1)) + ;; Compute vision for the feeb: + (compute-vision 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 + (move-object feeb (feeb-last-move feeb)))) + + ) ; end of let ((mushrooms 1)) Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Wed Jan 2 10:40:42 2008 @@ -113,7 +113,7 @@ wallp chance ;; Graphics for alpha release - simple-play print-map)) + simple-play)) (in-package :feebs) Modified: rules.lisp ============================================================================== --- rules.lisp (original) +++ rules.lisp Wed Jan 2 10:40:42 2008 @@ -23,71 +23,78 @@ +;;; -*- 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) +(let (turn-number total-time) + ;; Function redefinitions + (defun start-round () - (setf turn-number 0) - (number-of-mushrooms - (random (1+ (get-feeb-parm 'number-of-mushrooms))))) + (setf turn-number 0)) (defun start-turn () - (incf turn-number)) + (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))) + (= (get-feeb-parm 'game-length) turn-number)) -(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.") + (defun inc-total-time (time) + (incf time total-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 by a reference time.") + (defun total-time () + total-time)) -(def-feeb-parm 'reference-time nil - "Time taken by reference if non-nil. See slow-feeb-noop-factor.") +;;; 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.") -;;; Scoring: +(defmethod x-position :around ((fb feeb)) + (if (get-feeb-parm 'sense-location-p) + (call-next-method))) -(def-feeb-parm 'points-for-killing 5 - "How many points some feeb earn for killing someone.") +(defmethod y-position :around ((fb feeb)) + (if (get-feeb-parm 'sense-location-p) + (call-next-method))) -(def-feeb-parm 'points-for-dying -3 - "How many points some feeb earn for dying (usually negative).") -(def-feeb-parm 'points-for-slow-down -1 - "Points earned when a feeb's move is aborted due to slowness.") +;;; -*- Being Born and Dying -*- -;;; Energies: +;;; Being Born / Reincarnating -(def-feeb-parm 'flame-energy 10 - "Amount of energy lost after throwing a flame.") +(def-feeb-parm 'starting-energy 50 + "Smallest amount of energy a feeb will start with.") -(def-feeb-parm 'mushroom-energy 50 - "Amount of energy recovered when the feeb eats a mushroom.") +(defmethod create-object :before ((feeb feeb) x y) + (setf (feeb-energy-reserve feeb) + (get-feeb-parm 'starting-energy) + (feeb-ready-to-fire feeb) t)) -(def-feeb-parm 'carcass-energy 30 - "Amount of energy recovered each turn that the feeb -eats a carcass.") +;;; Dying and Killing -(def-feeb-parm 'maximum-energy 100 - "The most energy a feeb can accumulate.") +(def-feeb-parm 'points-for-dying -3 + "How many points some feeb earn for dying (usually negative).") -(def-feeb-parm 'starting-energy 50 - "Smallest amount of energy a feeb will start with.") +(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)) + (unless (eq (fireball-owner fireball) feeb) + (incf (feeb-score (fireball-owner fireball)) + (get-feeb-parm 'points-for-killing)))) ;;; Carcasses: @@ -99,6 +106,13 @@ (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: @@ -109,6 +123,19 @@ (def-feeb-parm 'fireball-reflection-probability 2/3 "Probability of the flame to reflect when encountering 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)) + :dissipate) + (t :move-forward))) + + +;;; Feebs + (deef-feeb-parm 'flame-no-recovery-time 2 "Probability of the feeb to recover the hability to throw a flame, after the apropriate @@ -117,3 +144,103 @@ (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)) + (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) + (get-feeb-parm 'flame-no-recovery-time)) + (chance (get-feeb-parm 'flame-recovery-probability)) + (setf (feeb-ready-to-fire feeb) t)))) + + + +;;; -*- 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))) + (let ((thing (find-if #'fireball-p (get-forward-pos feeb)))) + (if thing + (destroy-object feeb thing) + (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 (>= (feeb-energy-reserve feeb) (get-feeb-parm 'flame-energy)) + (decf (feeb-energy-reserve) (get-feeb-parm 'flame-energy)) + (call-next-method))) Modified: system.lisp ============================================================================== --- system.lisp (original) +++ system.lisp Wed Jan 2 10:40:42 2008 @@ -60,7 +60,6 @@ (last-kills :accessor feeb-last-kills :initform 0) (score :accessor feeb-score :initform 0) (kills :accessor feeb-kills :initform 0) - (dead-p :accessor feeb-dead-p) (turns-since-flamed :accessor feeb-turns-since-flamed :initform 0) (proximity :accessor feeb-proximity :initform (make-proximity)) (vision :accessor feeb-vision @@ -85,53 +84,6 @@ (defun feeb-p (x) (typep x 'feeb)) -;;; These make sure that these accessors are just available -;;; for the feeb itself - -(defmethod name :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod facing :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod peeking :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod graphics :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod x-position :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod y-position :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod line-of-sight :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod energy-reserve :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod ready-to-fire :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod aborted :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - -(defmethod last-move :around ((fb feeb)) - (if (feeb-playing-p fb) - (call-next-method))) - ;;; Place and delete @@ -170,6 +122,7 @@ ;;; --**-- System Rules --**-- + ;;; -*- General Rules -*- ;; These will be redefined by rules @@ -188,28 +141,26 @@ (defgeneric create-object (object x-pos y-pos &key &allow-other-keys) (:method (object x-pos y-pos) - (change-object-pos object x-pos y-pos))) + (change-object-pos object x-pos y-pos)) + (:method ((feeb feeb) x-pos y-pos) + (setf (feeb-dead-p feeb) nil + (feeb-last-move feeb) :dead) + (pushnew feeb *feebs*))) ;;; Reincarnating -(defgeneric reincarnate-feeb (feeb &key &allow-other-keys) - (:method ((feeb feeb)) - (let ((pos (nth (random *number-of-entry-points*) *entry-points*))) - (change-object-pos feeb (car pos) (cdr pos))) - (setf (feeb-facing feeb) (random 4) - (feeb-dead-p feeb) nil - (feeb-ready-to-fire feeb) t - (feeb-energy-reserve feeb) *starting-energy* - (feeb-last-move feeb) :dead))) +(defun reincarnate-feeb (feeb) + (let ((pos (nth (random *number-of-entry-points*) *entry-points*))) + (create-object feeb (car pos) (cdr pos)))) ;;; Dying (defgeneric destroy-object (object cause &key &allow-other-keys) (:method ((feeb feeb) cause) (setf *dead-feebs* (nconc *dead-feebs* (list feeb)) - (feeb-dead-p feeb) t) - (let* ((status (feeb-status feeb)) - (x (feeb-x-position 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) @@ -218,13 +169,12 @@ -;;; -*- Movement -*- +;;; -*- Movement Choice -*- -;;; Lets the feeb make a choice +;;; Lets the feeb or fireball make a choice (defgeneric make-move-choice (object) (:documentation "Lets object make its move choice.") - (:method ((feeb feeb)) (funcall (feeb-brain feeb) (feeb-status feeb) @@ -233,46 +183,34 @@ (feeb-vision-left feeb) (feeb-vision-right feeb)))) -;;; Moving + + +;;; -*- Moving -*- (defgeneric make-move (object move) (:documentation "Applies the move MOVE to OBJECT. The MOVE is returned from MAKE-MOVE-CHOICE for the same object.") + (:method (object move) + nil) + (:method (object (move (eql :turn-right))) (setf (object-direction object) - (right-of (object-direction object))) - t) + (right-of (object-direction object)))) (:method (object (move (eql :turn-around))) (setf (object-direction object) - (behind (object-direction object))) - t) + (behind (object-direction object)))) (: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)) - t) - -;;; Fireball + (change-object-pos object new-x new-y))) - (:method ((fireball fireball) (move (eql :move-forward))) - (multiple-value-bind (stuff new-x new-y) - (get-forward-pos fireball) - (dolist (thing stuff) - (if (feeb-image-p thing) - (destroy-object feeb fireball))))) - -;;; Feeb moves - - (:method ((feeb feeb) (move (eql :move-forward))) - (let ((thing (find-if #'fireball-p stuff))) - (when thing (destroy-object feeb thing) - (return-from make-move t))) - (call-next-method)) + (:method ((fireball fireball) (move (eql :dissipate))) + (destroy-object fireball)) (:method ((feeb feeb) (move (eql :flame))) (let ((x (feeb-x-position feeb)) @@ -281,26 +219,24 @@ (make-instace 'fireball (feeb-facing feeb) feeb x y (forward-dx facing) (forward-dy facing)))) - (push fireball *fireballs-flying*) - t)) + (push fireball *fireballs-flying*))) (:method ((feeb feeb) (move (eql :eat-mushroom))) (let ((x (feeb-x-position feeb)) (y (feeb-y-position feeb))) - (when (member :mushroom (aref *maze* x y)) + (when (find :mushroom (aref *maze* x y)) (delete-object :mushroom x y) t))) (:method ((feeb feeb) (move (eql :eat-carcass))) - (let ((x (feeb-x-position feeb)) - (y (feeb-y-position feeb))) - (when (member :carcass (aref *maze* x y)) - t))) + (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))) + (setf (feeb-peeking feeb) move)))) ) ; end of make-move generic function

1 0