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

[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

[the-feebs-war-cvs] r11 -
by gmilare＠common-lisp.net 31 Dec '07

31 Dec '07

Author: gmilare Date: Mon Dec 31 16:35:35 2007 New Revision: 11 Added: images.lisp rules.lisp Modified: feebs.tex main.lisp mazes.lisp package.lisp system.lisp Log: Modified: feebs.tex ============================================================================== --- feebs.tex (original) +++ feebs.tex Mon Dec 31 16:35:35 2007 @@ -60,10 +60,9 @@ \textit{The Feebs War} is a modified version of Planet of the Feebs \url{http://www.cliki.net/}, a game made for people learn and improve their lisp and code manipulation tecniques. The graphics are now displayed -using PAL \url{http://common-lisp.net/project/pal/}'s libraries, +using Lispbuilder \url{http://lispbuilder.sourceforge.net}'s libraries, so the problems with portability from CMUCL and X Window Sistem do -not exist anymore. Also the code is cleaner and simpler both to make -a feeb and to read the code. +not exist anymore. Also the code is cleaner and more extensible. \end{abstract} \tableofcontents{} @@ -72,16 +71,17 @@ The Feebs are intelligent and hostile creatures that live inside maze tunnels. They also have no mercy with each other, so they frequently -throw a letal flame from through their mouth, and, after that, they -can eat the carcass left. But throwing flames have an energy cost, -so they must keep tracking for food. +throw a letal flame from through their mouth, getting rid of their +opponent and eatting the carcass left. But throwing flames have an +energy cost, so they must keep tracking for food. This game is intended to help lisp newbies (or maybe a little more advanced lispers) to learn lisp. A player must create a function that receives what his/her feeb is seeing and feeling, and returns what it will do next. To create the better feeb, one can create variables to store data from previous moves (or not), and can also use all the -power of lisp to improve his/her creature. +power of lisp to improve his/her creature. But the most important +is to make good choices and be aware of danger! \subsection{Changes from \emph{Planet of the Feebs}} @@ -100,22 +100,22 @@ So, these are (some of) the changes: \begin{itemize} -\item The graphics are not based on X Window Sistem anymore, but on PAL, +\item The graphics are not based on X Window Sistem anymore, but on \textit{Lispbuilder}, and there are no CMUCL's event handler. This way, the code is more -portable and graphics can be improved without those hundreds of lines -that the original version has. Just creating some .bmp or .jpg files -of a feeb and your feeb is much more personalized! +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 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, adding no results at all... -\item Many functions and variables are changed and others were added. -\item Someone watching the game can control a Feeb with the keyboard, if -he/she wants to, and say when the game must finish. +\item Many functions and variables are changed and others were added \item This document 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 search for some information. +is easier to understand 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! \end{itemize} \section{The Game} @@ -130,27 +130,34 @@ After all feebs move, the flames thrown before also move (or dissipate), carcasses may rot and mushrooms may grow, accordingly to some rules. -To see what values are taken, one can use \textsf{\textbf{(list-parameter-settings)}}. -Using \textsf{\textbf{setf}} gives the possibility to change them -and \textsf{\textbf{documentation}} can be used to know them. Just -remember that every probability must be a rational number (like 1/2). -These parameters are just for one to know how the game is going to -be, but in the begining there is no need to explicitly use them when -creating the brain of a feeb. +The game rules are defined by parameters. These parameters can be read +by the command \textsf{\textbf{(get-feeb-parm~}'parameter\textbf{)}} +To see all parameters, values and also all the documentation, one can use +\textsf{\textbf{(list-parameter-settings)}}. Using +\textsf{\textbf{(change-feeb-parm}'parameter~value\textbf{)}} +gives the possibility to change them (but not during the game) and +\textsf{\textbf{(documentation~}'parameter~'feeb-parm\textbf{)}} +can be used to know them. Just remember that every probability +must be a rational number (like 1/2). + +But don't panic! These parameters are just for one to know how +the game is going to be, but in the begining there is no need +to explicitly use them when creating the brain of a feeb. +The best way to create a feeb is watching a game (among system feebs), +improving it (it is defined in file brains.lisp) a little more, +testing the changes... These are some global parameters: \begin{lyxlist}{00.00.0000} -\item [{\textsf{\textbf{{*}game-length{*}}}}] Number of turns the game -will last, or nil if there is a human player. -\item [{\textsf{\textbf{{*}points-for-killing{*}}}}] How many points some +\item [{\textsf{\textbf{'game-length}}}] Number of turns the game +will last. +\item [{\textsf{\textbf{'points-for-killing}}}] How many points some feeb earn for killing someone. -\item [{\textsf{\textbf{{*}points-for-dying{*}}}}] How many points some +\item [{\textsf{\textbf{'points-for-dying}}}] How many points some feeb earn for dying (usually negative). -\item [{\textsf{\textbf{{*}maze-x-size{*}}}}] Horizontal size of the maze. -\item [{\textsf{\textbf{{*}maze-y-size{*}}}}] Vertical size of the maze. -\item [{\textsf{\textbf{(get-maze-map)}}}] This command can be used to -get the map (see section \ref{sub:Map}). +\item [{\textsf{\textbf{'maze-x-size}}}] Horizontal size of the maze. +\item [{\textsf{\textbf{'maze-y-size}}}] Vertical size of the maze. \end{lyxlist} \subsection{Throwing flame} @@ -162,28 +169,27 @@ 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 killing feebs it encounters, transforming them into carcass. If there -is a wall, the flame can reflect, and will turn 180 degrees. +is a wall, the flame can reflect, and, if so, it will turn 180 degrees. -Once a feeb is killed, in it's place in the maze there will appear -a carcass. The feeb goes to the end of the killed feebs line. Whenever -a carcass rots, the first feeb in line will reincarnate. So, dying -is not so terrible. +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. These are the parameters related to flames: \begin{lyxlist}{00.00.0000} -\item [{\textsf{\textbf{{*}flame-energy{*}}}}] Amount of energy lost after +\item [{\textsf{\textbf{'flame-energy}}}] Amount of energy lost after throwing a flame. -\item [{\textsf{\textbf{{*}fireball-guaranteed-lifetime{*}}}}] Number of +\item [{\textsf{\textbf{'fireball-guaranteed-lifetime}}}] Number of turns that a fireball is guaranteed not to dissipate, unless it encounters a wall. -\item [{\textsf{\textbf{{*}fireball-dissipation-probability{*}}}}] Probability +\item [{\textsf{\textbf{'fireball-dissipation-probability}}}] Probability of the flame to dissipate each turn after the apropriate time. -\item [{\textsf{\textbf{{*}fireball-reflection-probability{*}}}}] Probability +\item [{\textsf{\textbf{'fireball-reflection-probability}}}] Probability of the flame to reflect when encountering a wall. -\item [{\textsf{\textbf{{*}flame-no-recovery-time{*}}}}] Number of turns +\item [{\textsf{\textbf{'flame-no-recovery-time}}}] Number of turns that a feeb cannot fire. -\item [{\textsf{\textbf{{*}flame-recovery-probability{*}}}}] Probability +\item [{\textsf{\textbf{'flame-recovery-probability}}}] Probability of the feeb to recover the hability to throw a flame, after the apropriate time. \end{lyxlist} @@ -199,38 +205,36 @@ These are the quantities: \begin{lyxlist}{00.00.0000} -\item [{\textsf{\textbf{{*}mushroom-energy{*}}}}] Amount of energy recovered +\item [{\textsf{\textbf{'mushroom-energy}}}] Amount of energy recovered when the feeb eats a mushroom. -\item [{\textsf{\textbf{{*}carcass-energy{*}}}}] Amount of energy recovered +\item [{\textsf{\textbf{'carcass-energy}}}] Amount of energy recovered each turn that the feeb eats a carcass. -\item [{\textsf{\textbf{{*}carcass-guaranteed-lifetime{*}}}}] Number of -turns that a carcass will surely stay there. After these turns, it +\item [{\textsf{\textbf{'carcass-guaranteed-lifetime}}}] Number of +turns that a carcass will surely not rot. After these turns, it can rot, depending on probabilities. -\item [{\textsf{\textbf{{*}carcass-rot-probability{*}}}}] Probability of +\item [{\textsf{\textbf{'carcass-rot-probability}}}] Probability of the carcass to rot, after the apropriate time. -\item [{\textsf{\textbf{{*}maximum-energy{*}}}}] Maximum amount of energy +\item [{\textsf{\textbf{'maximum-energy}}}] Maximum amount of energy that a feeb can have eating. -\item [{\textsf{\textbf{{*}starting-energy{*}}}}] Amount of energy a feeb +\item [{\textsf{\textbf{'starting-energy}}}] Amount of energy a feeb has when it reincarnates. -\item [{\textsf{\textbf{{*}number-of-mushrooms{*}}}}] Quantity of mushrooms +\item [{\textsf{\textbf{'number-of-mushrooms}}}] Quantity of mushrooms that exist in the maze. \end{lyxlist} \section{The Feeb} -A feeb needs four things: a name, a brain, an initialize function -(optional) and a set of graphics (optional). +A feeb needs four things: a name, a brain and a set of graphics (optional). \begin{itemize} \item The name, a string. \item The brain is a function that decides what the feeb will do next, based -on what it is seeing and feeling. -\item The initializer is invoked when the game is about to start, so it -can analyze the map, global parameters, and so on. +on what it is seeing and feeling. \item The set of graphics is an image file (of format BMP, JPEG, PNG, and any others that supported by SDL\_image). \end{itemize} -One can create a feeb calling \textsf{\textbf{(define-feeb~}}\textsf{name~brain~}\textsf{\textbf{:initializer}}\textsf{~prepare~}\textsf{\textbf{:graphics}}\textsf{~graphics}\textsf{\textbf{)}}. +One can create a feeb calling +\textsf{\textbf{(define-feeb}~name~brain~\textbf{:graphics}~graphics\textbf{)}}. If name is already used, a warning will be signaled, and the old feeb will be substituted. Calling \textsf{\textbf{(list-of-feebs)}} will return the list of the feebs (names only) that will be defined when @@ -261,21 +265,22 @@ \item [{\textsf{\textbf{:peek-left}}}] Peek to the left around a corner. The creature does note actually move, but, in the next turn, the creature will have the same vision that it would have if he had moved one step -foward and turned left. This is used so a feeb can analize a corridor +foward and turned left (and one step back because the feeb needs to see +what is actually in front of it). Peeking used so a feeb can analize a corridor before trespassing it. \item [{\textsf{\textbf{:peek-right}}}] Peek to the right around a corner, -analogous of \textsf{\textbf{:peek-left}}. +analogous to \textsf{\textbf{:peek-left}}. \item [{\textsf{\textbf{:eat-carcass}}}] Eat a carcass if there is any -available in the feeb's square. The amount of \textsf{\textbf{{*}carcass-energy{*}}} -is restored to the feeb's energy. +available in the feeb's square. The amount of the parameter +\textsf{\textbf{'carcass-energy}} is restored to the feeb's energy. \item [{\textsf{\textbf{:eat-mushroom}}}] Eat a mushroom if there is any -available in the feeb's square. The amount of \textsf{\textbf{{*}mushroom-energy{*}}} -is restored to the feeb's energy. +available in the feeb's square. The amount of the parameter +\textsf{\textbf{'mushroom-energy}} is restored to the feeb's energy. \end{lyxlist} \subsection{Information available} -The brain of a feeb mus take five arguments; I'll call them \textsf{\emph{status}}, +The brain of a feeb must take five arguments; I'll call them \textsf{\emph{status}}, \textsf{\emph{proximity}}, \textsf{\emph{vision}}, \textsf{\emph{vision-left}} and \textsf{\emph{vision-right}}. @@ -291,51 +296,43 @@ \begin{lyxlist}{00.00.0000} \item [{\textsf{\textbf{(name}}\textsf{\emph{~status}}\textsf{\textbf{)}}}] \begin{flushleft} -The -name of the feeb. +The name of the feeb. \par\end{flushleft} -\item [{\textsf{\textbf{(facing~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -Where -the feeb is facing, one of the constants provided: \textsf{\textbf{north}}, -\textsf{\textbf{south}}, \textsf{\textbf{east}} or \textsf{\textbf{west}}, +\item [{\textsf{\textbf{(facing}}\textsf{\emph{~status}}\textsf{\textbf{)}}}] \begin{flushleft} +Where the feeb is facing to, one of the constants provided: \textsf{\textbf{north}}, +\textsf{\textbf{east}}, \textsf{\textbf{south}} or \textsf{\textbf{west}}, wich are 0, 1, 2 and 3 respectivelly. \par\end{flushleft} -\item [{\textsf{\textbf{(x-position~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -The -horizontal position of the feeb, increasing to east. If \textsf{\textbf{{*}sense-location{*}}} -is nil, it returns nil instead. -\par\end{flushleft} -\item [{\textsf{\textbf{(y-position~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -The -vertical position of the feeb, increasing to north. If \textsf{\textbf{{*}sense-location{*}}} -is nil, it returns nil instead. -\par\end{flushleft} -\item [{\textsf{\textbf{(peeking~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -If -it is \textsf{\textbf{:left}} or \textsf{\textbf{:right}}, it means +\item [{\textsf{\textbf{(x-position}\emph{~status}\textbf{)}}}] \begin{flushleft} +The horizontal position of the feeb, 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. +If \textsf{\textbf{'sense-location-p}} is nil, it returns nil instead. +\par\end{flushleft} +\item [{\textsf{\textbf{(peeking}\emph{~status}\textbf{)}}}] \begin{flushleft} +If it is \textsf{\textbf{:peek-left}} or \textsf{\textbf{:peek-right}}, it means that the current \textsf{\emph{vision}} provided is result of a previous \textsf{\textbf{:peek-left}} or \textsf{\textbf{:peek-right}} command -of the same feeb. Otherwise, it is \textsf{\textbf{nil}}. +of the same feeb. Otherwise, it is \textsf{\textbf{nil}}. Note that +\textsf{\emph{proximity}} is \emph{not} affected. \par\end{flushleft} -\item [{\textsf{\textbf{(line-of-sight~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -Indicates -the amount of valid entries in \textsf{\emph{vision}}. It actually -means that \textsf{\textbf{(aref~}}\textsf{\emph{vision~}}\textsf{\textbf{(line-of-sight~}}\textsf{\emph{status}}\textsf{\textbf{))}} +\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}}. \par\end{flushleft} -\item [{\textsf{\textbf{(ready-to-fire~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -\textsf{\textbf{T}} -indicates that the feeb is ready to fire. \textsf{\textbf{Nil}} indicates -it is not. -\par\end{flushleft} -\item [{\textsf{\textbf{(aborted}}\textsf{\emph{~status}}\textsf{\textbf{)}}}] \begin{flushleft} -Related -with timing. Returns \textsf{\textbf{T}} if the last move of feeb -was aborted because of speed. -\par\end{flushleft} -\item [{\textsf{\textbf{(last-move~}}\textsf{\emph{status}}\textsf{\textbf{)}}}] \begin{flushleft} -The -feeb's previous move, or \textsf{\textbf{:dead}} if it has just reincarnated. +\item [{\textsf{\textbf{(ready-to-fire}\emph{~status}\textbf{)}}}] \begin{flushleft} +If \textsf{\textbf{T}} indicates that the feeb is ready to fire. +If \textsf{\textbf{Nil}} indicates it is not. +\par\end{flushleft} +\item [{\textsf{\textbf{(aborted}\emph{~status}\textbf{)}}}] \begin{flushleft} +Related with timing. Returns \textsf{\textbf{T}} if the last move of feeb +was aborted because of timing issues. +\par\end{flushleft} +\item [{\textsf{\textbf{(last-move}\emph{~status}\textbf{)}}}] \begin{flushleft} +The feeb's previous move, or \textsf{\textbf{:dead}} if it has just reincarnated. \par\end{flushleft} \end{lyxlist} @@ -345,45 +342,43 @@ what the feeb sees. The structure \textsf{\emph{proximity}} has the contents of the squares -near the feeb, 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} -Contents -of the feeb's current square. +\item [{\textsf{\textbf{(my-square}}\textsf{\emph{~proximity}}\textsf{\textbf{)}}}] \begin{flushleft} +Contents of the feeb's current square. \par\end{flushleft} -\item [{\textsf{\textbf{(left-square~}}\textsf{\emph{proximity}}\textsf{\textbf{)}}}] \begin{flushleft} -Contents -of the right square of the feeb. +\item [{\textsf{\textbf{(left-square}}\textsf{\emph{~proximity}}\textsf{\textbf{)}}}] \begin{flushleft} +Contents of the right square of the feeb. \par\end{flushleft} -\item [{\textsf{\textbf{(right-square~}}\textsf{\emph{proximity}}\textsf{\textbf{)}}}] \begin{flushleft} -Contents -of the left square of the feeb. +\item [{\textsf{\textbf{(right-square}}\textsf{\emph{~proximity}}\textsf{\textbf{)}}}] \begin{flushleft} +Contents of the left square of the feeb. \par\end{flushleft} \item [{\textsf{\textbf{(rear-square}}\textsf{\emph{~proximity}}\textsf{\textbf{)}}}] \begin{flushleft} -Contents -of the square behind the feeb. +Contents of the square behind the feeb. \par\end{flushleft} \item [{The}] vector \textsf{\emph{vision}} has the contents of the squares -that are in front of the feeb. For example, \textsf{\textbf{(aref~}}\textsf{\emph{vision~}}\textsf{0}\textsf{\textbf{)}} -will return the contents of the square in front of the feeb, \textsf{\textbf{(aref~}}\textsf{\emph{vision~}}\textsf{1}\textsf{\textbf{)}} +that are in front of the feeb. For example, +\textsf{\textbf{(aref}\emph{~vision~}0\textbf{)}} +will return the contents of the square in front of the feeb, +\textsf{\textbf{(aref}\emph{~vision~}1\textbf{)}} will return the contents of the next square, and so on. As said before, -\textsf{\textbf{(aref~}}\textsf{\emph{vision~}}\textsf{\textbf{(line-of-sight~}}\textsf{\emph{status}}\textsf{\textbf{))}} +\textsf{\textbf{(aref}\emph{~vision~}\textbf{(line-of-sight}\emph{~status}\textbf{))}} will be the first :rock encountered. All subsequents square, like -\textsf{\textbf{(aref~}}\textsf{\emph{vision~}}\textsf{\textbf{(+~}}\textsf{1~}\textsf{\textbf{(line-of-sight~}}\textsf{\emph{status}}\textsf{\textbf{)))}}, +\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 maybe \textsf{\textbf{nil}} if the +:rock or a list of elements, or \textsf{\textbf{()}} if the square is empty. Each element of the square is one of these: \begin{itemize} -\item \textbf{Feeb image.} One can call \textsf{\textbf{(feeb-image-p~}}\textsf{element}\textsf{\textbf{)}} +\item \textbf{Feeb image.} One can call \textsf{\textbf{(feeb-image-p}~element\textbf{)}} to see if element is a feeb image. -\item \textbf{Fireball image.} One can call \textsf{\textbf{(fireball-image-p~}}\textsf{element}\textsf{\textbf{)}} +\item \textbf{Fireball image.} One can call \textsf{\textbf{(fireball-image-p}~element\textbf{)}} to check if element is a fireball image. \item \textsf{\textbf{:carcass}}. If there is a \textsf{\textbf{:carcass}} -in the square of the feeb (i.e. in \textsf{\textbf{(my-square~}}\textsf{\emph{proximity}}\textsf{\textbf{)}}), +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 @@ -399,24 +394,20 @@ These are the fields available: \begin{lyxlist}{00.00.0000} -\item [{\textsf{\textbf{(feeb-image-name}}\textsf{~feeb-image}\textsf{\textbf{)}}}] \begin{flushleft} -The -name of the feeb. Maybe you can know it's weakpoints. -\par\end{flushleft} -\item [{\textsf{\textbf{(feeb-image-facing~}}\textsf{feeb-image}\textsf{\textbf{)}}}] \begin{flushleft} -The -facing of the feeb. This way the brain function can see if the feeb-image -either sees it or not. -\par\end{flushleft} -\item [{\textsf{\textbf{(feeb-image-peeking~}}\textsf{feeb-image}\textsf{\textbf{)}}}] \begin{flushleft} -Returns -\textsf{\textbf{:peek-left}} or \textsf{\textbf{:peek-right}} if the +\item [{\textsf{\textbf{(feeb-image-name}~feeb-image\textbf{)}}}] \begin{flushleft} +The name of the feeb. (Maybe you know it's weakpoints?) +\par\end{flushleft} +\item [{\textsf{\textbf{(feeb-image-facing}~feeb-image\textbf{)}}}] \begin{flushleft} +The facing of the feeb. This way the brain function can +see if the feeb-image either sees the feeb which is playing or not. +\par\end{flushleft} +\item [{\textsf{\textbf{(feeb-image-peeking}~feeb-image\textbf{)}}}] \begin{flushleft} +Returns \textsf{\textbf{:peek-left}} or \textsf{\textbf{:peek-right}} if the feeb is peeking to (its) left or right, or \textsf{\textbf{nil}} if not. \par\end{flushleft} -\item [{\textsf{\textbf{(fireball-image-direction~}}\textsf{fireball-image}\textsf{\textbf{)}}}] \begin{flushleft} -The -direction that the fireball image is going to. +\item [{\textsf{\textbf{(fireball-image-direction}~fireball-image\textbf{)}}}] \begin{flushleft} +The direction that the fireball image is going to. \par\end{flushleft} \end{lyxlist} @@ -424,8 +415,8 @@ \textsf{\emph{vision-left}} and \textsf{\emph{vision-right}} are vectors similar to vision, but they are less precise in the contents. Also -their valid contents are limited by \textsf{\textbf{(line-of-sight~}}\textsf{\emph{status}}\textsf{\textbf{)}}, -so \textsf{\textbf{(aref~}}\textsf{\emph{vision-left~}}\textsf{\textbf{(line-of-sight~}}\textsf{\emph{status}}\textsf{\textbf{))}}, +their valid contents are limited by \textsf{\textbf{(line-of-sight}~\emph{status}\textbf{)}}, +so \textsf{\textbf{(aref}~\emph{vision-left}~\textbf{(line-of-sight}~\emph{status}\textbf{))}}, for example, will return \textsf{\textbf{:unknown}}. Note that feebs that are not peeking, mushrooms and carcasses are @@ -451,6 +442,20 @@ code and know what they do. +\subsection{Changing the map layout} + +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{)}}. +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 +its documentation for more details and options. + + \subsection{Graphics} With this version of the game, it's possible to choose the graphics @@ -466,7 +471,7 @@ After creating the image file, you must call \textsf{\textbf{(create-graphics}}\textsf{~path-to-image-file}\textsf{\textbf{)}}. If you now how to work with sdl surfaces in lispbuilder, you may use the function with a surface instead of a image file; or you can call -\textsf{\textbf{(create-graphics~}}\textsf{path-to-image-file~nil}\textsf{\textbf{)}} +\textsf{\textbf{(create-graphics}~path-to-image-file~nil\textbf{)}} if the surface should not be freed after the call. The result must be the third argument given to define-feeb. @@ -476,11 +481,12 @@ The game loop is started by calling (feebs). + \section{Contests} I sugest that you see this chapter only after you have created at -least a basic brain feeb, wich is better than the (simple) provided -brain, and when you want to participate of a contest or a game with +least a basic brain feeb, which is better than the (simple) provided +brain, or if you want to participate of a contest or a game with your friends. @@ -495,18 +501,18 @@ 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 \textsf{\textbf{{*}may-get-maze-p{*}}} +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}}\textsf{~map~x~y}\textsf{\textbf{)}} +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: \begin{lyxlist}{00.00.0000} \item [{\textsf{\textbf{:mushroom-place}}}] A mushroom patch, i.e. when -a mushroom is eaten it can come out here. +a mushroom is reincarnate, it could reincarnate here. \item [{\textsf{\textbf{:feeb-entry-place}}}] A feeb entry, i.e. if a carcass rots a feeb can appear here. -\item [{\textsf{\textbf{:rock}}}] A wall. Feebs cannot come in this place. +\item [{\textsf{\textbf{:rock}}}] A wall. Feebs cannot come to this place. \item [{\textsf{\textbf{nil}}}] An {}``empty'' place, i.e. neither of the previous. \end{lyxlist} @@ -514,19 +520,23 @@ \subsection{Timing} There are also some timing atributes that can be given to the game. -If the feeb takes too long to make a decision, there is more probability +The more time the feeb takes make a decision, greater is the probability of its command to be aborted. -To make this available, someone must set these: +To make this available, someone must set these parameters: \begin{lyxlist}{00.00.0000} -\item [{\textsf{\textbf{{*}slow-feeb-noop-switch{*}}}}] If is non-nil, -there is a possibility that the move of a feeb is aborted according -to its function time. Not applied to the human controlled feeb. -\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 for the total time taken -by all the feebs in the current turn. +\item [{\textsf{\textbf{'slow-feeb-noop-switch}}}] If is non-nil, +there is a possibility that the move of a feeb is aborted according +to its function time. +\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. +\item [{\textsf{\textbf{'reference-time}}}] Time taken by reference +if non-nil. +\item [{\textsf{\textbf{'points-for-slow-down}}}] Points earned when +a feeb's move is aborted due to slowness. \end{lyxlist} \subsection{Sense of location} @@ -537,30 +547,25 @@ These are the parameters: \begin{lyxlist}{00.00.0000} -\item [{\textsf{\textbf{{*}sense-location-p{*}}}}] Tells if the actual -position of the feeb can be determinated accessing \textsf{\textbf{x-position}} -and \textsf{\textbf{y-position}}. +\item [{\textsf{\textbf{'sense-location-p}}}] If nil, +\textsf{\textbf{x-position}} and \textsf{\textbf{y-position}} +will return nil when someone tries to invoke it. +Otherwise return the position. \end{lyxlist} \subsection{Changing the rules} To change the rules of the contest, they must be changed before the feebs are defined, because in a feeb definition it could use the values -of the variables to make a global strategy, and change the strategies -after this could not be fair. +of the variables to make a global strategy. -All the parameters that can be listed using \textsf{\textbf{(list-parameter-settings)}} -can be changed using setf. Also, they all have documentation about -themselves, so feel free to use \textsf{\textbf{(documentation~}}\textsf{parameter~'variable}\textsf{\textbf{)}} +All the parameters, values and documentation that can be listed using +\textsf{\textbf{(list-parameter-settings)}} can be changed using +\textsf{\textbf{(change-feeb-parm name value)}}, which is deactivated +during the game. Also, they all have documentation about themselves, so feel free to use +\textsf{\textbf{(documentation~}}\textsf{'parameter~'feeb-parm}\textsf{\textbf{)}} and see what each parameter does. Documentation is available to external -functions too. - -It is possible to change the layout of the map by calling \textsf{\textbf{(change-layout}}\textsf{~new-layout}\textsf{\textbf{)}}. -There are a few predefined mazes that are \textsf{\textbf{{*}maze-0{*}}} -throw \textsf{\textbf{{*}maze-5{*}}}. If you want to create a new -map, take the template (commented) inside the same file, or create -maybe a bigger template (of any size, because the values of \textsf{\textbf{{*}maze-x-size{*}}} -and \textsf{\textbf{{*}maze-y-size{*}}} will be changed accordingly). +functions as well. \section{Reference} Added: images.lisp ============================================================================== --- (empty file) +++ images.lisp Mon Dec 31 16:35:35 2007 @@ -0,0 +1,121 @@ +;;; -*- Common Lisp -*- + +#| Copyright (c) 2007 Gustavo Henrique Milar� + + This file is part of The Feebs War. + + The Feebs War is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + The Feebs War is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. +|# + + +(in-package :feebs) + +;;; This file is an extension of system.lisp which handles vision + + + +;;; -*- Vision Calculation -*- + +;;; Computes what the feeb is seeing + +(defun compute-vision (feeb) + (let ((proximity (feeb-proximity feeb)) + (vision (feeb-vision feeb)) + (vision-left (feeb-vision-left feeb)) + (vision-right (feeb-vision-right feeb)) + (facing (feeb-facing feeb)) + vision-dx + vision-dy + (x (feeb-x-position feeb)) + (y (feeb-y-position feeb))) + ;; First fill in proximity info. + (setf (my-square proximity) + (imagify feeb (aref *maze* x y) 'proximity) + (left-square proximity) + (imagify feeb + (aref *maze* (+ x (left-dx facing)) (+ y (left-dy facing))) + :proximity) + (right-square proximity) + (imagify feeb + (aref *maze* (+ x (right-dx facing)) (+ y (right-dy facing))) + :proximity) + (rear-square proximity) + (imagify feeb + (aref *maze* (+ x (behind-dx facing)) (+ y (behind-dy facing))) + :proximity)) + ;; The vision vector starts in the square the feeb is facing. + (setf x (+ x (forward-dx facing)) + y (+ y (forward-dy facing))) + ;; Figure out which direction to scan in. + (case (feeb-peeking feeb) + (:peek-left (setf facing (left-of facing))) + (:peek-right (setf facing (right-of facing)))) + (setf vision-dx (forward-dx facing) + vision-dy (forward-dy facing)) + ;; compute vision, vision-left and vision-right + (do* ((x x (+ x vision-dx)) + (y y (+ y vision-dy)) + (left-wall-x (+ x (left-dx facing)) (+ left-wall-x vision-dx)) + (left-wall-y (+ y (left-dy facing)) (+ left-wall-y vision-dy)) + (right-wall-x (+ x (right-dx facing)) (+ right-wall-x vision-dx)) + (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) + (aref vision-left index) + (imagify feeb + (aref *maze* left-wall-x left-wall-y) + :left-vision) + (aref vision-right index) + (imagify feeb + (aref *maze* right-wall-x right-wall-y) + :right-vision))))) + +(defstruct feeb-image + name facing peeking) + +(defstruct fireball-image + direction) + +;;; This transforms what the feeb is seeing; + +(defgeneric imagify (feeb thing type) + (:documentation "Defines how FEEB sees or feels THING. +TYPE could be :vision, :left-vision :right-vision or :proximity") + (:method (feeb thing type) + thing) + + (:method (feeb (thing feeb) + (type (or (eql :vision) (eql :proximity)))) + (make-feeb-image :name (feeb-name thing) + :facing (feeb-facing feeb) + :peeking (feeb-peeking feeb))) + + (:method (feeb (thing fireball) + (type (or (eql :vision) (eql :proximity)))) + (make-fireball-image :direction (fireball-direction thing))) + + (:method (feeb thing + (or (eql :left-vision) (eql :right-vision))) + nil) + + (: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)))) Modified: main.lisp ============================================================================== --- main.lisp (original) +++ main.lisp Mon Dec 31 16:35:35 2007 @@ -21,38 +21,67 @@ (in-package :feebs) -;;; Some functions +;; These are defined provisorily here +;; the definitive version is in rules.lisp -(defmacro define-parameter (name &optional value doc) - `(progn - (defvar ,name ,value - ,@(if doc '(doc))) - (export ,name) - (pushnew ',name *feeb-parameters*))) - -(defun list-parameter-settings () - (let ((settings nil)) - (dolist (parm *feeb-parameters*) - (push (cons parm (symbol-value parm)) settings)) - settings)) +(defun rot-carcass-p (time) + t) + +(defun reincarnate-feeb-p (feeb) + t) + +(defun finish-game-p () + ;; This is a little dangerous... + nil) + + + +;;; Parameters + +(let ((parameters (make-hash-table :test 'eq))) + + (defun def-feeb-parm (name value &optional doc) + (aif (gethash name parameters) + (progn + (warn "Change parameter ~a to ~a: ~ +parameter already existed with value ~a." name value (car it)) + (setf (gethash name parameters) (cons value (or doc (cdr it))))) + (setf (gethash name parameters) (cons value doc))) + name) + + (defun get-feeb-parm (name) + (gethash name parameters)) + + (defun change-parameter (name value) + (setf (car (gethash name parameters)) value)) + + (defmethod documentation (name (type (eql 'feeb-parameter))) + (cdr (gethash name parameters))) + + (defun list-parameter-settings () + (let (params) + (maphash #'(lambda (key value) + (push (list key (car value) (cdr value)) params)) + parameters) + params))) ;;; Characteristics of the maze: -(define-parameter *may-get-maze-map-p* t - "Tells if the function (get-maze-map) returns the map layout of nil - during the game.") +(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)) +;; (declare (inline feeb-image-p fireball-image-p)) -(defun feeb-image-p (thing) - (typep thing 'feeb)) +;; (defun feeb-image-p (thing) +;; (typep thing 'feeb)) -(defun fireball-image-p (thing) - (typep thing 'fireball)) +;; (defun fireball-image-p (thing) +;; (typep thing 'fireball)) @@ -72,8 +101,8 @@ (if (/= (length string) y) (error "Not all the strings in ~a have the same size." layout))) (setf *layout* layout - *maze-y-size* y - *maze-x-size* x)) + *maze-y-size* (change-feeb-parm 'maze-y-size y) + *maze-x-size*(change-feeb-parm 'maze-x-size x))) (init-maze)) (defun get-maze-map () @@ -85,12 +114,13 @@ :feeb-entry-place -place where a feeb can reincarnate nil - nothing special Just remember that if *may-get-maze-map-p* is nil, -this function return an array of nils" - (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*)))) - (dotimes (x *maze-x-size*) - (dotimes (y *maze-y-size*) - (setf (aref new-maze x y) (aref *fake-maze* x y)))) - new-maze))) +this function return nil." + (and (get-feeb-parm 'may-get-maze-map-p) + (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*)))) + (dotimes (x *maze-x-size*) + (dotimes (y *maze-y-size*) + (setf (aref new-maze x y) (aref *fake-maze* x y)))) + new-maze))) (defun init-maze () (setf *maze* (make-array (list *maze-x-size* *maze-y-size*)) @@ -108,18 +138,15 @@ (aref *fake-maze* j i) nil) (case (schar str j) (#\X - (setf (aref *fake-maze* j i) - (and *may-get-maze-map-p* :rock) + (setf (aref *fake-maze* j i) :rock (aref *maze* j i) :rock)) (#\* - (setf (aref *fake-maze* j i) - (and *may-get-maze-map-p* :mushroom-place)) + (setf (aref *fake-maze* j i) :mushroom-place) (incf *number-of-mushroom-sites*) (push (make-pos j i) *mushroom-sites*)) (#\e (setf (aref *fake-maze* j i) - (and *may-get-maze-map-p* - :feeb-entry-place)) + :feeb-entry-place) (incf *number-of-entry-points*) (push (make-pos j i) *entry-points*)) (#\space nil) @@ -181,7 +208,6 @@ (let ((feeb (make-instance class :name name :brain brain - :direction (random 4) :graphics graphs :x-position x-pos :y-position y-pos))) @@ -202,15 +228,14 @@ ;;; The Game -(let ((mushrooms 0)) +(let ((mushrooms 1)) (defun number-of-mushrooms (n) - (setf *mushrooms-to-grow* n)) + (setf mushrooms n)) (defun play-one-turn () - (setf mushrooms 0) ; restart the count ;; This is defined by rules: - (start-turn) + (start-turn) ; possible call to number-of-mushrooms ;; Maybe grow up mushrooms: (let ((m-sites (sort *mushroom-sites* #'(lambda (x y) @@ -218,32 +243,35 @@ (zerop (random 2)))))) (dotimes (i mushrooms) (let ((site (pop m-sites))) - (create-mushroom (car site) (cdr site))))) + (unless (member #'fireball-p) + (create-mushroom (car site) (cdr site))))) ;; Maybe rot some carcasses - ;; FIXME: Ugly code code, and - (loop for carc in *carcasses* - with ncarcasses do - (if (rot-carcass-p (first carc)) - (progn - (delete-object :carcass (second carc) (third carc)) - (reincarnate-feeb (pop *dead-feebs*))) - (progn - (push carc ncarcasses) - (incf (first carc))))) + (dolist (carc (prog1 *carcasses* + (setf *carcasses* nil))) + (unless (rot-carcass (first carc) (second carc) (third carc)) + (progn + (incf (first carc)) + (push carc *carcasses*)))) ;; Move some fireballs: (dolist (fireball *fireballs-flying*) (move-object fireball (make-move-choice fireball))) (dolist (feeb *feebs*) - (unless (feeb-dead-p feeb) - ;; Starve the feeb: - (when (<= (decf (feeb-energy-reserve feeb)) 0) - (destroy-object feeb :starve)) - ;; Compute vision for the feeb: - (compute-vision feeb))) - (dolist (feeb *feebs*) - (unless (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)))) + (dolist (*playing-feeb* *feebs*) + (unless (feeb-dead-p *playing-feeb*) ;; Collect the feeb's move - (setf (feeb-peeking feeb) nil) - (move-object feeb (setf (feeb-last-move feeb) - (make-move-choice feeb)))))) -) \ No newline at end of file + (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)) Modified: mazes.lisp ============================================================================== --- mazes.lisp (original) +++ mazes.lisp Mon Dec 31 16:35:35 2007 @@ -316,7 +316,7 @@ #\X #\Space)))))) -;;; This one generates a almost ready-to-use map +;;; This one generates an almost ready-to-use map (defun generate-maze (x-size y-size &key (density 0.4) @@ -333,7 +333,8 @@ recomended to be between 0.25 and 0.45. The horizontal corridors will be between CORRIDOR-X-MIN and CORRIDOR-X-MAX around CORRIDOR-X-AVG, when -possible; similarly for vertical corridors." +possible; similarly for vertical corridors. +It returns two values, a layout like *maze-0* and its density." (if (or (< x-size 10) (< y-size 10)) (error "Too small - should be at least 10x10.")) ;; Certifying the values to be acceptable @@ -371,10 +372,11 @@ (y2 (if y1 (bound-random y1 corridor-y-min corridor-y-avg corridor-y-max)) (if y1 (bound-random y1 corridor-y-min - corridor-y-avg corridor-y-max)))) - ((or (>= (density map x-size y-size) density) + corridor-y-avg corridor-y-max))) + (real-dens )) + ((or (>= real density) (> i (* density x-size y-size))) ; quits after trying TOO MUCH - (translate map x-size y-size)) + (values (translate map x-size y-size) real-dens)) (if x1 (setf map (horiz-corridor map y x1 (bound x2 1 (- x-size 2))))) Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Mon Dec 31 16:35:35 2007 @@ -33,8 +33,7 @@ (defpackage :feebs (:use :common-lisp) ;; Export everything we want the players to get their hands on. - (:export *number-of-feebs* *game-length* - *number-of-auto-feebs* + (:export *game-length* ;; Strategic quantities *points-for-killing* *points-for-dying* @@ -48,8 +47,6 @@ *number-of-mushrooms* ;; Probabilities - *carcass-guaranteed-lifetime* - *carcass-rot-probability* *fireball-guaranteed-lifetime* *fireball-dissipation-probability* *fireball-reflection-probability* @@ -80,9 +77,12 @@ feeb-image-p feeb-image-name feeb-image-facing feeb-image-peeking fireball-image-p fireball-image-direction - - ;; Functions + + ;; Parameters + get-feeb-parm change-feeb-parm list-parameter-settings + + ;; Settings define-feeb delete-feeb feebs change-layout @@ -93,7 +93,7 @@ ;; Some layouts (can be find in mazes.lisp) *maze-1* *maze-2* *maze-3* *maze-4* *maze-5* - *maze-template* + make-template generate-maze ;; Graphics create-graphics @@ -119,6 +119,9 @@ ;;; Directions +(deftype direction () + `(integer 0 3)) + (defconstant north 0) (defconstant east 1) (defconstant south 2) @@ -178,10 +181,18 @@ "XXXXX XXXXXXXXXXXXX X" "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")) -(defparameter *maze-x-size* 32 - "Horizontal size of the maze") -(defparameter *maze-y-size* 32 - "Vertical size of the maze") + + +;;; 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 @@ -197,5 +208,13 @@ (defvar *dead-feebs*) (defvar *carcasses*) -(defvar *continue*) +;;; Current feeb playing +(defvar *playing-feeb*) +(defmacro aif (test then &optional else) + `(let ((it ,test)) + (if it ,then ,else))) + +(defmacro awhen (test &rest body) + `(let ((it ,test)) + (when it ,@body))) Added: rules.lisp ============================================================================== --- (empty file) +++ rules.lisp Mon Dec 31 16:35:35 2007 @@ -0,0 +1,119 @@ +;;; -*- Common Lisp -*- + +#| Copyright (c) 2007 Gustavo Henrique Milar� + + This file is part of The Feebs War. + + The Feebs War is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + The Feebs War is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. +|# + + +(in-package :feebs) + + + +(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) + (defun start-round () + (setf turn-number 0) + (number-of-mushrooms + (random (1+ (get-feeb-parm 'number-of-mushrooms))))) + + (defun start-turn () + (incf turn-number)) + + (defun finish-game-p () + (>= (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.") + +(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.") + +(def-feeb-parm 'reference-time nil + "Time taken by reference if non-nil. See slow-feeb-noop-factor.") + +(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: + +(def-feeb-parm 'points-for-killing 5 + "How many points some feeb earn for killing someone.") + +(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.") + + +;;; Energies: + +(def-feeb-parm 'flame-energy 10 + "Amount of energy lost after throwing a flame.") + +(def-feeb-parm 'mushroom-energy 50 + "Amount of energy recovered when the feeb eats a mushroom.") + +(def-feeb-parm 'carcass-energy 30 + "Amount of energy recovered each turn that the feeb +eats a carcass.") + +(def-feeb-parm 'maximum-energy 100 + "The most energy a feeb can accumulate.") + +(def-feeb-parm 'starting-energy 50 + "Smallest amount of energy a feeb will start with.") + +;;; Carcasses: + +(def-feeb-parm 'carcass-guaranteed-lifetime 5 + "Number of +turns that a carcass will surely not rot. After these turns, it +can rot, depending on probabilities.") + +(def-feeb-parm 'carcass-rot-probability 1/3 + "Probability of the carcass to rot, after the apropriate time.") + + +;;; Fireballs: + +(def-feeb-parm 'fireball-dissipation-probability 1/5 + "Probability of the flame to dissipate each turn after the +apropriate time.") + +(def-feeb-parm 'fireball-reflection-probability 2/3 + "Probability of the flame to reflect when encountering a wall.") + +(deef-feeb-parm 'flame-no-recovery-time 2 + "Probability +of the feeb to recover the hability to throw a flame, after the apropriate +time.") + +(def-feeb-parm 'flame-recovery-probability 1/3 + "Probability of the feeb to recover the hability to throw a flame, +after the apropriate time.") Modified: system.lisp ============================================================================== --- system.lisp (original) +++ system.lisp Mon Dec 31 16:35:35 2007 @@ -27,24 +27,21 @@ ;;; This class is used by the system (defclass object () - ((direction :accessor object-direction) - (x-position :accessor object-x-position) - (y-position :accessor object-y-position))) + ((direction :accessor object-direction :initarg :direction) + (x-position :accessor object-x-position :initarg :x-position) + (y-position :accessor object-y-position :initarg :y-position))) (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 - :reader feeb-image-name) - (direction :reader facing :reader feeb-image-facing - :initform (random 4)) - (peeking :accessor feeb-peeking :reader peeking - :reader feeb-image-peeking) + (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 - (x-position :reader x-position :initform 0 :initarg :x-position) - (y-position :reader y-position :initform 0 :initarg :y-position) + (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 @@ -55,7 +52,7 @@ (last-move :accessor feeb-last-move :reader last-move :initform :dead) - ;; These are available for the system only + ;; These are available for the system (brain :accessor feeb-brain :initarg :brain) (graphics :accessor feeb-graphics :initarg :graphics) (time :accessor feeb-time :initform 0) @@ -64,7 +61,6 @@ (score :accessor feeb-score :initform 0) (kills :accessor feeb-kills :initform 0) (dead-p :accessor feeb-dead-p) - (playing-p :accessor feeb-playing-p) (turns-since-flamed :accessor feeb-turns-since-flamed :initform 0) (proximity :accessor feeb-proximity :initform (make-proximity)) (vision :accessor feeb-vision @@ -74,6 +70,21 @@ (vision-right :accessor feeb-vision-right :initform (make-array (list (max *maze-y-size* *maze-x-size*)))))) +(defclass fireball (object) + ((owner :accessor fireball-owner :initarg :owner) + (x-position :accessor fireball-x-position) + (y-position :accessor fireball-y-position) + (direction :accessor fireball-direction))) + +(declaim + (inline fireball-p feeb-p)) + +(defun fireball-p (x) + (typep x 'fireball)) + +(defun feeb-p (x) + (typep x 'feeb)) + ;;; These make sure that these accessors are just available ;;; for the feeb itself @@ -161,8 +172,13 @@ ;;; -*- General Rules -*- -(defgeneric start-turn (&key &allow-other-keys) - (:method () t)) +;; These will be redefined by rules + +(defun start-turn () + t) + +(defun start-round () + t) @@ -202,79 +218,13 @@ -;;; -*- Vision Calculation -*- - -;;; Computes what the feeb is seeing - -(defun compute-vision (feeb) - (let ((proximity (feeb-proximity feeb)) - (vision (feeb-vision feeb)) - (vision-left (feeb-vision-left feeb)) - (vision-right (feeb-vision-right feeb)) - (facing (feeb-facing feeb)) - vision-dx - vision-dy - (x (feeb-x-position feeb)) - (y (feeb-y-position feeb))) - ;; First fill in proximity info. - (setf (my-square proximity) - (aref *maze* x y) - (left-square proximity) - (aref *maze* (+ x (left-dx facing)) (+ y (left-dy facing))) - (right-square proximity) - (aref *maze* (+ x (right-dx facing)) (+ y (right-dy facing))) - (rear-square 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))) - ;; Figure out which direction to scan in. - (case (feeb-peeking feeb) - (:left (setf facing (left-of facing))) - (:right (setf facing (right-of facing)))) - (setf vision-dx (forward-dx facing) - vision-dy (forward-dy facing)) - ;; compute vision, vision-left and vision-right - (do* ((x x (+ x vision-dx)) - (y y (+ y vision-dy)) - (left-wall-x (+ x (left-dx facing)) (+ left-wall-x vision-dx)) - (left-wall-y (+ y (left-dy facing)) (+ left-wall-y vision-dy)) - (right-wall-x (+ x (right-dx facing)) (+ right-wall-x vision-dx)) - (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) (aref *maze* x y) - (aref vision-left index) :unknown - (aref vision-right index) :unknown - (line-of-sight status) index)) - (setf (aref vision index) (aref *maze* x y) - (aref vision-left index) - (side-imagify (aref *maze* left-wall-x left-wall-y) - (right-of facing)) - (aref vision-right index) - (side-imagify (aref *maze* right-wall-x right-wall-y) - (left-of facing)))))) - -;;; Compute the info to be put into the vision-left and vision-right vectors. -;;; A peeking feeb must be facing in the specified direction in order to count. - -(defun side-imagify (stuff facing) - (if (wallp stuff) - stuff - (loop for thing in stuff - and elt = (and (feeb-image-p thing) - (= facing (feeb-image-facing thing)) - (feeb-image-peeking thing)) - if elt - return it))) - - - ;;; -*- Movement -*- ;;; Lets the feeb make a choice -(defgeneric make-move-choice (object &key &allow-other-keys) +(defgeneric make-move-choice (object) + (:documentation "Lets object make its move choice.") + (:method ((feeb feeb)) (funcall (feeb-brain feeb) (feeb-status feeb) @@ -286,6 +236,9 @@ ;;; 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 (eql :turn-right))) (setf (object-direction object) (right-of (object-direction object))) @@ -316,7 +269,7 @@ ;;; Feeb moves (:method ((feeb feeb) (move (eql :move-forward))) - (let ((thing (find-if #'fireball-image-p stuff))) + (let ((thing (find-if #'fireball-p stuff))) (when thing (destroy-object feeb thing) (return-from make-move t))) (call-next-method)) @@ -325,9 +278,9 @@ (let ((x (feeb-x-position feeb)) (y (feeb-y-position feeb)) (fireball - (make-fireball-image (feeb-facing feeb) - feeb x y (forward-dx facing) - (forward-dy facing)))) + (make-instace 'fireball (feeb-facing feeb) + feeb x y (forward-dx facing) + (forward-dy facing)))) (push fireball *fireballs-flying*) t)) @@ -344,17 +297,10 @@ (when (member :carcass (aref *maze* x y)) t))) - (:method ((feeb feeb) (move (eql :peek-left))) + (: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 (peeking feeb) move))) - t) + (setf (feeb-peeking feeb) move))) - (:method make-move ((feeb feeb) (move (eql :peek-right))) - (multiple-value-bind (x y stuff) - (get-forward-pos feeb) - (unless (wallp stuff) - (setf (peeking feeb) move))) - t) ) ; end of make-move generic function

1 0

[the-feebs-war-cvs] r10 -
by gmilare＠common-lisp.net 31 Dec '07

31 Dec '07

Author: gmilare Date: Sun Dec 30 19:21:19 2007 New Revision: 10 Modified: main.lisp mazes.lisp Log: Functions make-template, generate-maze added and tested. Modified: main.lisp ============================================================================== --- main.lisp (original) +++ main.lisp Sun Dec 30 19:21:19 2007 @@ -196,7 +196,7 @@ (setf *feebs* nil) (dolist (feeb-spec *feebs-to-be*) (let ((pos (pop entries)))) - (apply 'create-feeb (car pos) (cdr pos) feeb-spec)))) + (apply 'create-feeb (car pos) (cdr pos) feeb-spec))))) @@ -231,16 +231,19 @@ (push carc ncarcasses) (incf (first carc))))) ;; Move some fireballs: - (dolist (fireball *fireballs-flying*) - (move-object fireball (make-move-choice fireball))) - (progn - ;; Starve the feeb: - (when (<= (decf (feeb-energy-reserve feeb)) 0) - (destroy-object feeb :starve)) - ;; Compute vision for the feeb: - (compute-vision feeb) - ;; Collect the feeb's move - (setf (feeb-peeking feeb) nil) - (move-object feeb (setf (feeb-last-move feeb) - (make-move-choice feeb))))))) + (dolist (fireball *fireballs-flying*) + (move-object fireball (make-move-choice fireball))) + (dolist (feeb *feebs*) + (unless (feeb-dead-p feeb) + ;; Starve the feeb: + (when (<= (decf (feeb-energy-reserve feeb)) 0) + (destroy-object feeb :starve)) + ;; Compute vision for the feeb: + (compute-vision feeb))) + (dolist (feeb *feebs*) + (unless (feeb *feebs*) + ;; Collect the feeb's move + (setf (feeb-peeking feeb) nil) + (move-object feeb (setf (feeb-last-move feeb) + (make-move-choice feeb)))))) ) \ No newline at end of file Modified: mazes.lisp ============================================================================== --- mazes.lisp (original) +++ mazes.lisp Sun Dec 30 19:21:19 2007 @@ -236,21 +236,32 @@ "\")" "\"")))) -(defun density (maze) - (loop for line in maze summing - (float (/ (loop for elt across line counting - (char/= #\X elt)) - (length line) (length maze))))) - -(defun bound-random (min avg max) - (let ((sort (random 2.0))) - (round - (if (< sort 1.0) - (+ min (* sort (- avg min))) - (+ avg (* (1- sort) (- max avg))))))) +(defun density (maze xs ys) + (let ((sum 0)) + (dotimes (x xs) + (dotimes (y ys) + (if (not (aref maze x y)) + (incf sum)))) + (float (/ sum (* xs ys))))) + +(defun bound-random (start min avg max) + (+ start + (* (expt -1 (random 2)) + (let ((sort (random 2.0))) + (round + (if (< sort 1.0) + (+ min (* sort (- avg min))) + (+ avg (* (1- sort) (- max avg))))))))) + +(defun random-elt (seq) + (if seq + (elt seq (random (length seq))))) (defmacro ensure-bound (elt min max) - `(setf ,elt (max ,min (min ,max ,elt)))) + `(setf ,elt (bound ,elt ,min ,max))) + +(defun bound (elt min max) + (max min (min max elt))) (defun horiz-corridor (map y x1 x2) (do ((x x1 (if (< x1 x2) (1+ x) (1- x)))) @@ -270,11 +281,11 @@ (not (aref map (1- x) y)))) ; blank square to the left (return)) ; can't make a blank square here, stop (and (not (aref map x (1+ y))) ; blank square down - (if (or (and (not (aref map (1+ x) y)) ; blank square to the right - (not (aref map (1+ x) (1+ y)))) ; blank square down-right - (and (not (aref map (1- x) (1+ y))) ; blank square down-left - (not (aref map (1- x) y)))) ; blank square to the left - (return))) ; can't make a blank square here, stop + (or (and (not (aref map (1+ x) y)) ; blank square to the right + (not (aref map (1+ x) (1+ y)))) ; blank square down-right + (and (not (aref map (1- x) (1+ y))) ; blank square down-left + (not (aref map (1- x) y)))) ; blank square to the left + (return)) ; can't make a blank square here, stop (setf (aref map x y) nil)) map) @@ -296,38 +307,77 @@ (setf (aref map x y) nil)) map) +(defun translate (map xs ys) + (loop for y from (1- ys) downto 0 collect + (let ((str (make-string xs))) + (dotimes (x xs str) + (setf (aref str x) + (if (aref map x y) + #\X + #\Space)))))) + +;;; This one generates a almost ready-to-use map + (defun generate-maze (x-size y-size &key (density 0.4) (corridor-x-min 1) (corridor-x-max (- x-size 2)) - (corridor-x-avg (floor x-size 2)) + (corridor-x-avg (floor x-size 4)) (corridor-y-min 1) (corridor-y-max (- y-size 2)) - (corridor-y-avg (floor y-size 2))) + (corridor-y-avg (floor y-size 4))) "Generates a maze of size X-SIZE x Y-SIZE (at least 10x10) with no entry points and no mushroom sites. DENSITY decides aproximatelly the ratio (blank squares) / (total squares) recomended to be between 0.25 and 0.45. -The horizontal corridors will be between -CORRIDOR-X-MIN and CORRIDOR-X-MAX with average CORRIDOR-X-AVG; -similarly for vertical corridors." - (if (or (< x 10) (< y 10)) +The horizontal corridors will be between CORRIDOR-X-MIN +and CORRIDOR-X-MAX around CORRIDOR-X-AVG, when +possible; similarly for vertical corridors." + (if (or (< x-size 10) (< y-size 10)) (error "Too small - should be at least 10x10.")) ;; Certifying the values to be acceptable - (ensure-bound density 0.1 0.5) - (ensure-bound corridor-x-min 1 (- x-size 2)) - (ensure-bound corridor-x-avg 2 (- x-size 2)) - (ensure-bound corridor-x-max 3 (- x-size 2)) - (ensure-bound corridor-y-min 1 (- y-size 2)) - (ensure-bound corridor-y-avg 2 (- y-size 2)) - (ensure-bound corridor-y-max 3 (- y-size 2)) + (ensure-bound corridor-x-avg + (ensure-bound corridor-x-min 1 (- x-size 2)) + (ensure-bound corridor-x-max 3 (- x-size 2))) + (ensure-bound corridor-y-avg + (ensure-bound corridor-y-min 1 (- y-size 2)) + (ensure-bound corridor-y-max 3 (- y-size 2))) ;; Beginning with an array of walls (let ((map (make-array (list x-size y-size) :initial-element t :element-type 'boolean))) - (do* ((y 1 (1+ (random (- y-size 1)))) ; position of horizontal corridor - (x 1 (1+ (random (- x-size 1)))) ; position of vertical corridor - (x1 - (setf map (horiz-corridor - map 1 (1+ (random (- x-size 1))) \ No newline at end of file + (do* ((i 1 (1+ i)) + (y 1 y*) ; position of horizontal corridor + (y* (- y-size 2) (1+ (random (- y-size 2)))) + (x1 (1+ (random (- x-size 2))) ; start position of horiz corridor + x1*) + (x1* (1+ (random (- x-size 2))) + (random-elt + (loop for x from 1 to (- x-size 2) ; any blank space + if (not (aref map x y)) collect x))) ; in line + (x2 (if x1 (bound-random x1 corridor-x-min + corridor-x-avg corridor-x-max)) + (if x1 (bound-random x1 corridor-x-min + corridor-x-avg corridor-x-max))) + (x 1 x*) ; position of vertical corridor + (x* (- x-size 2) (1+ (random (- x-size 2)))) + (y1 (1+ (random (- y-size 2))) + y1*) + (y1* (1+ (random (- y-size 2))) + (random-elt + (loop for y from 1 to (- y-size 2) + if (not (aref map x y)) collect y))) + (y2 (if y1 (bound-random y1 corridor-y-min + corridor-y-avg corridor-y-max)) + (if y1 (bound-random y1 corridor-y-min + corridor-y-avg corridor-y-max)))) + ((or (>= (density map x-size y-size) density) + (> i (* density x-size y-size))) ; quits after trying TOO MUCH + (translate map x-size y-size)) + (if x1 + (setf map (horiz-corridor map y x1 + (bound x2 1 (- x-size 2))))) + (if y1 + (setf map (vert-corridor map x y1 + (bound y2 1 (- x-size 2))))))))

1 0

[the-feebs-war-cvs] r9 -
by gmilare＠common-lisp.net 30 Dec '07

30 Dec '07

Author: gmilare Date: Sun Dec 30 17:43:46 2007 New Revision: 9 Modified: feebs.asd main.lisp mazes.lisp system.lisp Log: Modified: feebs.asd ============================================================================== --- feebs.asd (original) +++ feebs.asd Sun Dec 30 17:43:46 2007 @@ -15,12 +15,12 @@ :components (;; source (:cl-source-file "package") - (:cl-source-file "rules" :depends-on ("package")) - (:cl-source-file "system" :depends-on ("rules")) - (:cl-source-file "main" :depends-on ("rules")) - (:cl-source-file "extra" :depends-on ("rules")) - - (:cl-source-file "mazes" :depends-on ("extra")) + (:cl-source-file "system" :depends-on ("package")) + (:cl-source-file "main" :depends-on ("system")) + (:cl-source-file "rules" :depends-on ("main")) + + (:cl-source-file "extra") + (:cl-source-file "mazes") (:cl-source-file "brains" :depends-on ("extra")) (:file "graphics" :depends-on ("main")) Modified: main.lisp ============================================================================== --- main.lisp (original) +++ main.lisp Sun Dec 30 17:43:46 2007 @@ -44,7 +44,6 @@ during the game.") - ;;; Tests that behavior functions might use (declare (inline feeb-image-p fireball-image-p)) @@ -82,12 +81,11 @@ of *maze-x-size* by *maze-y-size*. Each element of the array is one of these: :rock - a wall - :mushroom-place - here is a place where mushrooms can grow up - :feeb-entry-place - here is a place where a feeb can reincarnate + :mushroom-place - place where mushrooms can grow up + :feeb-entry-place -place where a feeb can reincarnate nil - nothing special -Just remember that variables can change the behavior of this function, -like *may-get-maze-map-p* which, if nil, makes this function return -an array of nils" +Just remember that if *may-get-maze-map-p* is nil, +this function return an array of nils" (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*)))) (dotimes (x *maze-x-size*) (dotimes (y *maze-y-size*) @@ -152,14 +150,14 @@ (defvar *feebs-to-be* nil) -(defun define-feeb (name brain &optional graphics) +(defun define-feeb (name brain &key graphics (class 'feeb)) "Defines a feeb with name NAME, behavior function BRAIN. If there is another feeb with the same name, overwrites it with a case sensitive test." (when (find name *feebs-to-be* :key #'car :test #'string= (delete-feeb name)) (warn "Feeb ~s already exists, deleting..." name)) - (push (list name brain graphs) *feebs-to-be*)) + (push (list name brain graphics class) *feebs-to-be*)) (defun delete-feeb (name) "Deletes the feeb which has name NAME, causing it not to @@ -179,8 +177,8 @@ (setf *feebs-to-be* nil)) (defun create-feebs () - (flet ((create-feeb (x-pos y-pos name brain graphs) - (let ((feeb (make-instance 'feeb + (flet ((create-feeb (x-pos y-pos name brain graphs class) + (let ((feeb (make-instance class :name name :brain brain :direction (random 4) @@ -206,41 +204,43 @@ (let ((mushrooms 0)) -(defun number-of-mushrooms (n) - (setf *mushrooms-to-grow* n)) + (defun number-of-mushrooms (n) + (setf *mushrooms-to-grow* n)) -(defun play-one-turn () - (setf mushrooms 0) ; restart the count - ;; This is defined by rules: - (start-turn) - ;; Maybe grow up mushrooms: - (let ((m-sites (sort *mushroom-sites* - #'(lambda (x y) - (declare (ignore x y)) - (zerop (random 2)))))) - (dotimes (i mushrooms) - (let ((site (pop m-sites))) - (create-mushroom (car site) (cdr site))))) - ;; Maybe rot some carcasses - ;; FIXME: put this in rules.lisp with better code - (loop for carc in *carcasses* - with ncarcasses do - (if (rot-carcass-p (first carc)) - (delete-object :carcass (second carc) (third carc))) - (progn - (push carc ncarcasses) - (incf (first carc))))) - ;; Move some fireballs: + (defun play-one-turn () + (setf mushrooms 0) ; restart the count + ;; This is defined by rules: + (start-turn) + ;; Maybe grow up mushrooms: + (let ((m-sites (sort *mushroom-sites* + #'(lambda (x y) + (declare (ignore x y)) + (zerop (random 2)))))) + (dotimes (i mushrooms) + (let ((site (pop m-sites))) + (create-mushroom (car site) (cdr site))))) + ;; Maybe rot some carcasses + ;; FIXME: Ugly code code, and + (loop for carc in *carcasses* + with ncarcasses do + (if (rot-carcass-p (first carc)) + (progn + (delete-object :carcass (second carc) (third carc)) + (reincarnate-feeb (pop *dead-feebs*))) + (progn + (push carc ncarcasses) + (incf (first carc))))) + ;; Move some fireballs: (dolist (fireball *fireballs-flying*) (move-object fireball (make-move-choice fireball))) - (progn - ;; Starve the feeb: - (when (<= (decf (feeb-energy-reserve feeb)) 0) - (destroy-object feeb :starve)) - ;; Compute vision for the feeb: - (compute-vision feeb) - ;; Collect the feeb's move - (setf (feeb-peeking feeb) nil) - (move-object feeb (setf (feeb-last-move feeb) - (make-move-choice feeb))))))) + (progn + ;; Starve the feeb: + (when (<= (decf (feeb-energy-reserve feeb)) 0) + (destroy-object feeb :starve)) + ;; Compute vision for the feeb: + (compute-vision feeb) + ;; Collect the feeb's move + (setf (feeb-peeking feeb) nil) + (move-object feeb (setf (feeb-last-move feeb) + (make-move-choice feeb))))))) ) \ No newline at end of file Modified: mazes.lisp ============================================================================== --- mazes.lisp (original) +++ mazes.lisp Sun Dec 30 17:43:46 2007 @@ -18,6 +18,7 @@ along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. |# +;;; The mazes were ;;; Created by Jim Healy, July 1987. ;;; ;;; ************************************************** @@ -219,44 +220,114 @@ "X e * X" "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")) -;;; Use this template to create new mazes. - -#| (defparameter *maze-template* - '("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")) |# - -;;; Or this function: +;;; Use this function to create new mazes +;;; of any size. (defun make-template (x-size y-size) - (loop repeat y-size collect - (make-string x-size :initial-element #\#))) + "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) + "\")" + "\"")))) + +(defun density (maze) + (loop for line in maze summing + (float (/ (loop for elt across line counting + (char/= #\X elt)) + (length line) (length maze))))) + +(defun bound-random (min avg max) + (let ((sort (random 2.0))) + (round + (if (< sort 1.0) + (+ min (* sort (- avg min))) + (+ avg (* (1- sort) (- max avg))))))) + +(defmacro ensure-bound (elt min max) + `(setf ,elt (max ,min (min ,max ,elt)))) + +(defun horiz-corridor (map y x1 x2) + (do ((x x1 (if (< x1 x2) (1+ x) (1- x)))) + ((= x x2)) + ;; we need to guarantee that everything in map is + ;; corridors, that is, can't have something like + ;; XXXXXXXX + ;; XXX X + ;; X XXX + ;; XXXXXXXX + ;; that big blank square isn't good due + ;; to the limited vision of the feebs + (and (not (aref map x (1- y))) ; blank square up + (or (and (not (aref map (1+ x) y)) ; blank square to the right + (not (aref map (1+ x) (1- y)))) ; blank square up-right + (and (not (aref map (1- x) (1- y))) ; blank square up-left + (not (aref map (1- x) y)))) ; blank square to the left + (return)) ; can't make a blank square here, stop + (and (not (aref map x (1+ y))) ; blank square down + (if (or (and (not (aref map (1+ x) y)) ; blank square to the right + (not (aref map (1+ x) (1+ y)))) ; blank square down-right + (and (not (aref map (1- x) (1+ y))) ; blank square down-left + (not (aref map (1- x) y)))) ; blank square to the left + (return))) ; can't make a blank square here, stop + (setf (aref map x y) nil)) + map) + +(defun vert-corridor (map x y1 y2) + (do ((y y1 (if (< y1 y2) (1+ y) (1- y)))) + ((= y y2)) + (and (not (aref map (1- x) y)) + (or (and (not (aref map x (1+ y))) + (not (aref map (1- x) (1+ y)))) + (and (not (aref map (1- x) (1- y))) + (not (aref map x (1- y))))) + (return)) + (and (not (aref map (1+ x) y)) + (if (or (and (not (aref map x (1+ y))) + (not (aref map (1+ x) (1+ y)))) + (and (not (aref map (1+ x) (1- y))) + (not (aref map x (1- y))))) + (return))) + (setf (aref map x y) nil)) + map) + +(defun generate-maze (x-size y-size + &key (density 0.4) + (corridor-x-min 1) + (corridor-x-max (- x-size 2)) + (corridor-x-avg (floor x-size 2)) + (corridor-y-min 1) + (corridor-y-max (- y-size 2)) + (corridor-y-avg (floor y-size 2))) + "Generates a maze of size X-SIZE x Y-SIZE (at least 10x10) +with no entry points and no mushroom sites. +DENSITY decides aproximatelly the ratio + (blank squares) / (total squares) +recomended to be between 0.25 and 0.45. +The horizontal corridors will be between +CORRIDOR-X-MIN and CORRIDOR-X-MAX with average CORRIDOR-X-AVG; +similarly for vertical corridors." + (if (or (< x 10) (< y 10)) + (error "Too small - should be at least 10x10.")) + ;; Certifying the values to be acceptable + (ensure-bound density 0.1 0.5) + (ensure-bound corridor-x-min 1 (- x-size 2)) + (ensure-bound corridor-x-avg 2 (- x-size 2)) + (ensure-bound corridor-x-max 3 (- x-size 2)) + (ensure-bound corridor-y-min 1 (- y-size 2)) + (ensure-bound corridor-y-avg 2 (- y-size 2)) + (ensure-bound corridor-y-max 3 (- y-size 2)) + ;; Beginning with an array of walls + (let ((map (make-array (list x-size y-size) + :initial-element t + :element-type 'boolean))) + (do* ((y 1 (1+ (random (- y-size 1)))) ; position of horizontal corridor + (x 1 (1+ (random (- x-size 1)))) ; position of vertical corridor + (x1 + (setf map (horiz-corridor + map 1 (1+ (random (- x-size 1))) \ No newline at end of file Modified: system.lisp ============================================================================== --- system.lisp (original) +++ system.lisp Sun Dec 30 17:43:46 2007 @@ -161,11 +161,8 @@ ;;; -*- General Rules -*- -(defmethod start-round () - t) - -(defmethod start-turn () - t) +(defgeneric start-turn (&key &allow-other-keys) + (:method () t)) @@ -173,32 +170,35 @@ ;;; Creating -(defmethod create-object (object x-pos y-pos) - (change-object-pos object x-pos y-pos)) +(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))) ;;; Reincarnating -(defmethod reincarnate-feeb ((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)) +(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))) ;;; Dying -(defmethod destroy-object ((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)) - (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)) +(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)) + (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))) @@ -274,84 +274,87 @@ ;;; Lets the feeb make a choice -(defmethod make-move-choice ((feeb feeb)) - (funcall (feeb-brain feeb) - (feeb-status feeb) - (feeb-proximity feeb) - (feeb-vision feeb) - (feeb-vision-left feeb) - (feeb-vision-right feeb))) +(defgeneric make-move-choice (object &key &allow-other-keys) + (:method ((feeb feeb)) + (funcall (feeb-brain feeb) + (feeb-status feeb) + (feeb-proximity feeb) + (feeb-vision feeb) + (feeb-vision-left feeb) + (feeb-vision-right feeb)))) ;;; Moving -(defmethod make-move (object (move (eql :turn-right))) - (setf (object-direction object) - (right-of (object-direction object))) - t) - -(defmethod make-move (object (move (eql :turn-around))) - (setf (object-direction object) - (behind (object-direction object))) - t) - -(defmethod make-move (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) +(defgeneric make-move (object move) + (:method (object (move (eql :turn-right))) + (setf (object-direction object) + (right-of (object-direction object))) + t) + + (:method (object (move (eql :turn-around))) + (setf (object-direction object) + (behind (object-direction object))) + t) + + (: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 -(defmethod make-move ((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))))) + (: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 -(defmethod make-move ((feeb feeb) (move (eql :move-forward))) - (let ((thing (find-if #'fireball-image-p stuff))) - (when thing (destroy-object feeb thing) - (return-from make-move t))) - (call-next-method)) - -(defmethod make-move ((feeb feeb) (move (eql :flame))) - (let ((x (feeb-x-position feeb)) - (y (feeb-y-position feeb)) - (fireball - (make-fireball-image (feeb-facing feeb) - feeb x y (forward-dx facing) - (forward-dy facing)))) - (push fireball *fireballs-flying*) - t)) - -(defmethod make-move ((feeb feeb) (move (eql :eat-mushroom))) - (let ((x (feeb-x-position feeb)) - (y (feeb-y-position feeb))) - (when (member :mushroom (aref *maze* x y)) - (delete-object :mushroom x y) - t))) - -(defmethod make-move ((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))) - -(defmethod make-move ((feeb feeb) (move (eql :peek-left))) - (multiple-value-bind (x y stuff) - (get-forward-pos feeb) - (unless (wallp stuff) - (setf (peeking feeb) move))) - t) - -(defmethod make-move ((feeb feeb) (move (eql :peek-right))) - (multiple-value-bind (x y stuff) - (get-forward-pos feeb) - (unless (wallp stuff) - (setf (peeking feeb) move))) - t) + (:method ((feeb feeb) (move (eql :move-forward))) + (let ((thing (find-if #'fireball-image-p stuff))) + (when thing (destroy-object feeb thing) + (return-from make-move t))) + (call-next-method)) + + (:method ((feeb feeb) (move (eql :flame))) + (let ((x (feeb-x-position feeb)) + (y (feeb-y-position feeb)) + (fireball + (make-fireball-image (feeb-facing feeb) + feeb x y (forward-dx facing) + (forward-dy facing)))) + (push fireball *fireballs-flying*) + t)) + + (: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)) + (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))) + + (:method ((feeb feeb) (move (eql :peek-left))) + (multiple-value-bind (x y stuff) + (get-forward-pos feeb) + (unless (wallp stuff) + (setf (peeking feeb) move))) + t) + + (:method make-move ((feeb feeb) (move (eql :peek-right))) + (multiple-value-bind (x y stuff) + (get-forward-pos feeb) + (unless (wallp stuff) + (setf (peeking feeb) move))) + t) + ) ; end of make-move generic function

1 0

[the-feebs-war-cvs] r8 - feebs
by gmilare＠common-lisp.net 30 Dec '07

30 Dec '07

Author: gmilare Date: Sat Dec 29 20:34:57 2007 New Revision: 8 Removed: feebs/ Log:

1 0

[the-feebs-war-cvs] r7 -
by gmilare＠common-lisp.net 30 Dec '07

30 Dec '07

Author: gmilare Date: Sat Dec 29 20:30:32 2007 New Revision: 7 Modified: brains.lisp extra.lisp feebs.asd feebs.tex graphics.lisp main.lisp mazes.lisp package.lisp system.lisp Log: Modified: brains.lisp ============================================================================== --- brains.lisp (original) +++ brains.lisp Sat Dec 29 20:30:32 2007 @@ -1,5 +1,24 @@ ;;; -*- Common Lisp -*- +#| Copyright (c) 2007 Gustavo Henrique Milar� + + This file is part of The Feebs War. + + The Feebs War is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + The Feebs War is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. +|# + + (in-package :feebs) @@ -43,4 +62,4 @@ (dotimes (i n) (define-feeb (format nil "System Feeb # ~d" i) - #'auto-brain))) \ No newline at end of file + #'auto-brain))) Modified: extra.lisp ============================================================================== --- extra.lisp (original) +++ extra.lisp Sat Dec 29 20:30:32 2007 @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. |# @@ -118,7 +118,7 @@ ((= ,count line-of-sight) ,@finalize) (declare (list ,v ,vl ,vr) - (fixnum ,count)) ; can be assumed fixnum unless you have a mega PC + (fixnum ,count)) (dolist (,vis ,v) ,@vis-body) (dolist (,vis-l ,vl) Modified: feebs.asd ============================================================================== --- feebs.asd (original) +++ feebs.asd Sat Dec 29 20:30:32 2007 @@ -5,12 +5,12 @@ (in-package :feebs-system) -(defsystem feebs - :description "The Feebs War is an extension of Planetof the Feebs" +(defsystem the-feebs-war + :description "The Feebs War is a continuation of Planet of the Feebs." :version "1.0" :author "Gustavo Henrique Milar� <gugamilare(a)gmail.com>" :licence "GPL" - :depends-on (lispbuilder-sdl lispbuilder-sdl-image) +; :depends-on (pal) :components (;; source Modified: feebs.tex ============================================================================== --- feebs.tex (original) +++ feebs.tex Sat Dec 29 20:30:32 2007 @@ -29,7 +29,7 @@ % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License -% along with this program. If not, see <http://www.gnu.org/licenses/>. +% along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. Modified: graphics.lisp ============================================================================== --- graphics.lisp (original) +++ graphics.lisp Sat Dec 29 20:30:32 2007 @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. |# (in-package :feebs) @@ -37,10 +37,9 @@ (list " XX")) ((feeb-image-p (car elt)) (list "F~1d~a" - (feeb-id (feeb-image-feeb (car elt))) - (print-direction (feeb-image-facing (car elt))))) + (print-direction (feeb-facing (car elt))))) ((fireball-image-p (car elt)) - (list " *~a" (print-direction (fireball-image-direction (car elt))))) + (list " *~a" (print-direction (fireball-direction (car elt))))) ((eq (car elt) :mushroom) (list " mm")) ((eq (car elt) :carcass) @@ -57,7 +56,7 @@ (play-one-turn) (print-map) (sleep 0.7) (format t "~%~%")) (format t "Fim de jogo!!~%~%Pontua��es:~%~%") (dolist (feeb *feebs*) - (format t "~a: ~d~%" (name (feeb-status feeb)) (score (feeb-status feeb))))) + (format t "~a: ~d~%" (feeb-name feeb) (feeb-score feeb)))) #| Modified: main.lisp ============================================================================== --- main.lisp (original) +++ main.lisp Sat Dec 29 20:30:32 2007 @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. |# @@ -23,9 +23,10 @@ ;;; Some functions -(defmacro define-parameter (name value doc) +(defmacro define-parameter (name &optional value doc) `(progn - (defvar ,name ,value ,doc) + (defvar ,name ,value + ,@(if doc '(doc))) (export ,name) (pushnew ',name *feeb-parameters*))) @@ -43,15 +44,6 @@ during the game.") -;;; Energies: - - -;;; Carcasses: - - -;;; Fireballs: - - ;;; Tests that behavior functions might use @@ -110,7 +102,7 @@ *number-of-mushroom-sites* 0 *number-of-entry-points* 0) (do ((rows *layout* (cdr rows)) - (i (1- *maze-y-size*) (1- i))) + (i (1- *maze-y-size*) (1- i))) ; inverting the y axis ((null rows)) (let ((str (car rows))) (dotimes (j (length str)) @@ -118,16 +110,18 @@ (aref *fake-maze* j i) nil) (case (schar str j) (#\X - (setf (aref *fake-maze* j i) (and *may-get-maze-map-p* :rock) + (setf (aref *fake-maze* j i) + (and *may-get-maze-map-p* :rock) (aref *maze* j i) :rock)) (#\* - (setf (aref *fake-maze* j i) (and *may-get-maze-map-p* - :mushroom-place)) + (setf (aref *fake-maze* j i) + (and *may-get-maze-map-p* :mushroom-place)) (incf *number-of-mushroom-sites*) (push (make-pos j i) *mushroom-sites*)) (#\e - (setf (aref *fake-maze* j i) (and *may-get-maze-map-p* - :feeb-entry-place)) + (setf (aref *fake-maze* j i) + (and *may-get-maze-map-p* + :feeb-entry-place)) (incf *number-of-entry-points*) (push (make-pos j i) *entry-points*)) (#\space nil) @@ -158,21 +152,19 @@ (defvar *feebs-to-be* nil) -(defun define-feeb (name brain &optional initializer graphs) +(defun define-feeb (name brain &optional graphics) "Defines a feeb with name NAME, behavior function BRAIN. -The INITIALIZER key option must be either a function that -will be called in the very start of the game, or nil. If there is another feeb with the same name, overwrites it -with a case sensitive test" +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 prepare graphs) *feebs-to-be*)) + (push (list name brain graphs) *feebs-to-be*)) (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 in -the game" +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=))) @@ -187,48 +179,68 @@ (setf *feebs-to-be* nil)) (defun create-feebs () - (let ((entries (sort *entry-points* #'(lambda (x y) - (declare (ignore x y)) - (zerop (random 2)))))) + (flet ((create-feeb (x-pos y-pos name brain graphs) + (let ((feeb (make-instance 'feeb + :name name + :brain brain + :direction (random 4) + :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 ((pos (pop entries)))) + (apply 'create-feeb (car pos) (cdr pos) feeb-spec)))) + + + +;;; The Game + +(let ((mushrooms 0)) +(defun number-of-mushrooms (n) + (setf *mushrooms-to-grow* n)) (defun play-one-turn () - ;; This is defined by rules + (setf mushrooms 0) ; restart the count + ;; This is defined by rules: (start-turn) - ;; Maybe grow up mushrooms + ;; Maybe grow up mushrooms: (let ((m-sites (sort *mushroom-sites* #'(lambda (x y) (declare (ignore x y)) (zerop (random 2)))))) - (dotimes (i *mushrooms-to-grow*) + (dotimes (i mushrooms) (let ((site (pop m-sites))) (create-mushroom (car site) (cdr site))))) - ;; Rot some carcasses: + ;; Maybe rot some carcasses + ;; FIXME: put this in rules.lisp with better code (loop for carc in *carcasses* with ncarcasses do - (unless (rot-carcass (second carc) (third carc) (first carc)) - (push carc ncarcasses) - (incf (first carc)) - (reincarnate-feeb (pop *dead-feebs*)))) + (if (rot-carcass-p (first carc)) + (delete-object :carcass (second carc) (third carc))) + (progn + (push carc ncarcasses) + (incf (first carc))))) ;; Move some fireballs: (dolist (fireball *fireballs-flying*) - (move-fireball fireball)) - ;; Playing with the feebs: - (dolist (feeb *feebs*) - (unless (feeb-dead-p feeb) - ;; Starve the feeb: - (when (<= (decf (feeb-energy-reserve feeb)) 0) - (kill-feeb feeb :starve)) - ;; Compute vision for the feeb: - (compute-vision feeb) - ;; Collect the feeb's move - (make-move-choice feeb))) - ;; Do all the feebs' moves. - (dolist (feeb *feebs*) - (unless (feeb-dead-p feeb) - (setf (feeb-peeking feeb) nil) - (move-feeb feeb (feeb-last-move feeb))))) + (move-object fireball (make-move-choice fireball))) + (progn + ;; Starve the feeb: + (when (<= (decf (feeb-energy-reserve feeb)) 0) + (destroy-object feeb :starve)) + ;; Compute vision for the feeb: + (compute-vision feeb) + ;; Collect the feeb's move + (setf (feeb-peeking feeb) nil) + (move-object feeb (setf (feeb-last-move feeb) + (make-move-choice feeb))))))) +) \ No newline at end of file Modified: mazes.lisp ============================================================================== --- mazes.lisp (original) +++ mazes.lisp Sat Dec 29 20:30:32 2007 @@ -1,17 +1,35 @@ ;;; -*- Common Lisp -*- -;;; Mazes for Planet of the Feebs. -;;; A somewhat educational simulation game. -;;; +#| Copyright (c) 2007 Gustavo Henrique Milar� + + This file is part of The Feebs War. + + The Feebs War is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + The Feebs War is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. +|# + ;;; Created by Jim Healy, July 1987. ;;; ;;; ************************************************** -;;; Maze guidelines: -;;; Maze should be *maze-i-size* by *maze-j-size* -;;; (currently 32 x 32). +;;; Maze guidelines: ;;; X represents a wall. ;;; * represents a mushroom patch. ;;; e is a feeb entry point. +;;; +;;; The maze should be a rectangle bounded by walls +;;; in each side. +;;; These mazes are all 32x32, but you may build +;;; a maze of any size you wish. ;;; ************************************************** ;;; Maze1 has a good number of dead ends and little nooks. @@ -236,3 +254,9 @@ "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")) |# + +;;; Or this function: + +(defun make-template (x-size y-size) + (loop repeat y-size collect + (make-string x-size :initial-element #\#))) Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Sat Dec 29 20:30:32 2007 @@ -15,20 +15,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. |# - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ;;; -;;; The Feebs War ;;; -;;; ;;; -;;; Written by Gustavo Henrique Milar�� ;;; -;;; ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; The GPL should in the file "license", provided with the software. - ;;; based on Planet of the Feebs ;;; About Planet of the Feebs: @@ -39,13 +28,10 @@ ;; Modified by Jim Healy. ;; ;; Graphics ported to X11 by Fred Gilham 8-FEB-1998. -;; -;; -;;; This project exists thanks to them (defpackage :feebs - (:use :common-lisp :lispbuilder-sdl :lispbuilder-sdl-image :cffi) + (:use :common-lisp) ;; Export everything we want the players to get their hands on. (:export *number-of-feebs* *game-length* *number-of-auto-feebs* @@ -138,9 +124,6 @@ (defconstant south 2) (defconstant west 3) -;;; This is t if someone call (asdf:oos 'asdf:load-op 'feebs-c-interface) - -(defvar *c-interface-available* nil) ;;; Parameters that affect strategy of the game. Modified: system.lisp ============================================================================== --- system.lisp (original) +++ system.lisp Sat Dec 29 20:30:32 2007 @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. + along with The Feebs War. If not, see <http://www.gnu.org/licenses/>. |# @@ -29,8 +29,7 @@ (defclass object () ((direction :accessor object-direction) (x-position :accessor object-x-position) - (y-position :accessor object-y-position) - (lifetime :accessor object-lifetime :initform 0))) + (y-position :accessor object-y-position))) (defclass feeb (object) (;; These are structures accessible from behavior functions. @@ -79,7 +78,7 @@ ;;; for the feeb itself (defmethod name :around ((fb feeb)) - (if (feeb-playing-p fb) ;; check if the feeb itself is accessing its name + (if (feeb-playing-p fb) (call-next-method))) (defmethod facing :around ((fb feeb)) @@ -131,10 +130,6 @@ (place-object :mushroom x y) t)) -(defun rot-carcass (x y) - (delete-object :carcass x y) - t) - (defun delete-object (thing x y) (when (eq thing :mushroom) (decf *mushrooms-alive*)) @@ -159,7 +154,8 @@ (new-y (+ (forward-dy (object-direction object)) (object-y-position object)))) (values (aref *maze* new-x new-y) new-x new-y))) - + + ;;; --**-- System Rules --**-- @@ -171,34 +167,25 @@ (defmethod start-turn () t) -(defmethod create-feeb (x-pos y-pos name brain prepare graphs) - (let ((feeb (make-instance 'feeb - :name name - :brain brain - :graphics (if graphs - (sdl:load-and-convert-image graphs)) - :x-position x-pos - :y-position y-pos))) - (push feeb *feebs*) - (place-object (feeb-image feeb) x-pos y-pos) - (when prepare - (funcall prepare)))) +;;; -*- Being Born and Dying -*- + +;;; Creating -;;; -*- Dying and Killing -*- +(defmethod create-object (object x-pos y-pos) + (change-object-pos object x-pos y-pos)) ;;; Reincarnating (defmethod reincarnate-feeb ((feeb feeb)) - (let ((pos (nth (random *number-of-entry-points*) *entry-points*)) - (status (feeb-status feeb))) - (change-object-pos feeb (pos-x pos) (pos-y pos)) - (setf (feeb-facing feeb) (random 4) - (feeb-dead-p feeb) nil - (ready-to-fire status) t - (energy-reserve status) *starting-energy* - (last-move status) :dead))) + (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)) ;;; Dying @@ -210,7 +197,8 @@ (y (feeb-y-position feeb))) (push (list 0 x y) *carcasses*) (delete-object (feeb-image feeb) x y) - (place-object :carcass x y))) + (place-object :carcass x y)) + (call-next-method)) @@ -262,7 +250,7 @@ (setf (aref vision index) (aref *maze* x y) (aref vision-left index) (side-imagify (aref *maze* left-wall-x left-wall-y) - (right-of facing)) + (right-of facing)) (aref vision-right index) (side-imagify (aref *maze* right-wall-x right-wall-y) (left-of facing)))))) @@ -280,67 +268,55 @@ if elt return it))) -(defparameter *mushrooms-to-grow* 0) -(defun number-of-mushrooms (n) - (setf *mushrooms-to-grow* n)) +;;; -*- Movement -*- ;;; Lets the feeb make a choice (defmethod make-move-choice ((feeb feeb)) - (setf (last-move (feeb-status feeb)) - (funcall (feeb-brain feeb) - (feeb-status feeb) - (feeb-proximity feeb) - (feeb-vision feeb) - (feeb-vision-left feeb) - (feeb-vision-right feeb)))) - - - -;;; Moves the fireball - -(defmethod make-move ((fireball fireball)) - ;; move it to new coordinates. - (let ((x (incf (fireball-x fireball) - (forward-dx (fireball-direction fireball)))) - (y (incf (fireball-y fireball) - (forward-dy (fireball-direction fireball))))) - ;; If it hits rock, either reflect or dissipate. - (when (wallp (aref *maze* x y)) - (if (and (> (incf (fireball-age fireball)) - *fireball-guaranteed-lifetime*) - (chance *fireball-reflection-probability*)) - (setf (fireball-direction fireball) - (behind (fireball-direction fireball)) - x (fireball-x fireball) - y (fireball-y fireball)) - (progn - (setf *fireballs-flying* - (delete fireball *fireballs-flying*)) - (return-from move-one-fireball)))) - ;; Now put the fireball into the new square. - (setf (fireball-x fireball) x - (fireball-y fireball) y) - (change-object-pos fireball x y))) - -;;; Doing feeb moves. - -(defmethod make-move ((feeb feeb) (move (eql :turn-right))) - (setf (feeb-facing feeb) (right-of facing)) (call-next-method)) + (funcall (feeb-brain feeb) + (feeb-status feeb) + (feeb-proximity feeb) + (feeb-vision feeb) + (feeb-vision-left feeb) + (feeb-vision-right feeb))) + +;;; Moving + +(defmethod make-move (object (move (eql :turn-right))) + (setf (object-direction object) + (right-of (object-direction object))) + t) -(defmethod make-move ((feeb feeb) (move (eql :turn-around))) - (setf (feeb-facing feeb) (behind facing)) (call-next-method)) +(defmethod make-move (object (move (eql :turn-around))) + (setf (object-direction object) + (behind (object-direction object))) + t) (defmethod make-move (object (move (eql :move-forward))) - (multiple-value-bind (stuff new-x new-y) (get-forward-pos object) + (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) - (let ((thing (find-if #'fireball-image-p stuff))) - (when thing (kill-feeb feeb thing) - (return-from make-move t)))) + (change-object-pos object new-x new-y)) + t) + +;;; Fireball + +(defmethod make-move ((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 + +(defmethod make-move ((feeb feeb) (move (eql :move-forward))) + (let ((thing (find-if #'fireball-image-p stuff))) + (when thing (destroy-object feeb thing) + (return-from make-move t))) (call-next-method)) (defmethod make-move ((feeb feeb) (move (eql :flame))) @@ -350,8 +326,8 @@ (make-fireball-image (feeb-facing feeb) feeb x y (forward-dx facing) (forward-dy facing)))) - (push fireball *fireballs-flying*)) - (call-next-method)) + (push fireball *fireballs-flying*) + t)) (defmethod make-move ((feeb feeb) (move (eql :eat-mushroom))) (let ((x (feeb-x-position feeb)) @@ -367,23 +343,15 @@ t))) (defmethod make-move ((feeb feeb) (move (eql :peek-left))) - (unless - (wallp - (aref *maze* (+ (feeb-x-position feeb) - (forward-dx (feeb-facing feeb))) - (+ (feeb-y-position feeb) - (forward-dy (feeb-facing feeb))))) - (setf (peeking status) - (setf (feeb-image-peeking (feeb-image feeb)) move))) - (call-next-method)) + (multiple-value-bind (x y stuff) + (get-forward-pos feeb) + (unless (wallp stuff) + (setf (peeking feeb) move))) + t) (defmethod make-move ((feeb feeb) (move (eql :peek-right))) - (unless - (wallp - (aref *maze* (+ (feeb-x-position feeb) - (forward-dx (feeb-facing feeb))) - (+ (feeb-y-position feeb) - (forward-dy (feeb-facing feeb))))) - (setf (peeking status) - (setf (feeb-image-peeking (feeb-image feeb)) move))) - (call-next-method)) + (multiple-value-bind (x y stuff) + (get-forward-pos feeb) + (unless (wallp stuff) + (setf (peeking feeb) move))) + t)

1 0

[the-feebs-war-cvs] r6 -
by gmilare＠common-lisp.net 20 Dec '07

20 Dec '07

Author: gmilare Date: Thu Dec 20 15:17:10 2007 New Revision: 6 Added: feebs.asd Log: Added: feebs.asd ============================================================================== --- (empty file) +++ feebs.asd Thu Dec 20 15:17:10 2007 @@ -0,0 +1,32 @@ +;;; -*- Common Lisp -*- + +(defpackage :feebs-system + (:use :cl :asdf)) + +(in-package :feebs-system) + +(defsystem feebs + :description "The Feebs War is an extension of Planetof the Feebs" + :version "1.0" + :author "Gustavo Henrique Milar� <gugamilare(a)gmail.com>" + :licence "GPL" + :depends-on (lispbuilder-sdl lispbuilder-sdl-image) + + :components + (;; source + (:cl-source-file "package") + (:cl-source-file "rules" :depends-on ("package")) + (:cl-source-file "system" :depends-on ("rules")) + (:cl-source-file "main" :depends-on ("rules")) + (:cl-source-file "extra" :depends-on ("rules")) + + (:cl-source-file "mazes" :depends-on ("extra")) + (:cl-source-file "brains" :depends-on ("extra")) + + (:file "graphics" :depends-on ("main")) + + ;; GPL + (:doc-file "licence") + + ;; documentation + (:doc-file "feebs.tex")))

1 0

[the-feebs-war-cvs] r5 -
by gmilare＠common-lisp.net 20 Dec '07

20 Dec '07

Author: gmilare Date: Thu Dec 20 15:16:44 2007 New Revision: 5 Modified: brains.lisp extra.lisp graphics.lisp main.lisp package.lisp system.lisp Log: Modified: brains.lisp ============================================================================== --- brains.lisp (original) +++ brains.lisp Thu Dec 20 15:16:44 2007 @@ -5,7 +5,6 @@ ;;; Modified from "cautious-brain" - (defun auto-brain (status proximity vision vision-left vision-right) (declare (ignore vision-left vision-right)) (let ((stuff (my-square proximity))) Modified: extra.lisp ============================================================================== --- extra.lisp (original) +++ extra.lisp Thu Dec 20 15:16:44 2007 @@ -98,6 +98,9 @@ (the boolean (eq :rock thing))) +(defun chance (ratio) + (< (random (denominator ratio)) (numerator ratio))) + #| ;;; Handling the vision, vision-left and vision-right objects (defmacro with-visible-elements ((count line-of-sight) Modified: graphics.lisp ============================================================================== --- graphics.lisp (original) +++ graphics.lisp Thu Dec 20 15:16:44 2007 @@ -54,7 +54,7 @@ (make-auto-feebs (- 10 (length *feebs-to-be*))) (initialize-feebs) (loop repeat *game-length* do - (play-one-turn) (print-map) (sleep 0.3) (format t "~%~%")) + (play-one-turn) (print-map) (sleep 0.7) (format t "~%~%")) (format t "Fim de jogo!!~%~%Pontua��es:~%~%") (dolist (feeb *feebs*) (format t "~a: ~d~%" (name (feeb-status feeb)) (score (feeb-status feeb))))) @@ -62,12 +62,125 @@ #| + +(defconst *default-graphics* + (make-feeb-graphics + (load-and-convert-image "default-feeb.bmp"))) + +(defvar *cell-width* 32) +(defvar *cell-heigth* 32) + +(defstruct graphic + (walk (make-direction)) + (flaming (make-direction))) + +(defstruct (direction (:conc-name nil)) + (up (make-array 3)) + (left (make-array 3)) + (down (make-array 3)) + (right (make-array 3))) + +(defun make-feeb-graphics (surface) + + (let ((graphic (make-graphic))) + (progn + (loop for field in '(walk flaming) + and y0 from 0 by (* 4 *cell-heigth*) do + (loop for dir in '(up left right down) + and y from y0 by *cell-heigth* do + (loop for ind below 3 + and x from 0 by *cell-width* + for aux = (surface :width *cell-width* :heigth *cell-heigth*) do + (set-cell :x x :y y :width *cell-width* :heigth *cell-heigth* :surface surface) + (draw-surface surface :surface aux) + (setf (svref (slot-value (slot-value graphic field) + dir) + ind) + aux)))) + graphic))) + +(defgeneric create-graphics (feeb) &key (free-p t)) + +(defmethod create-graphics ((feeb pathname)) + (let ((surf (load-and-convert-image feeb))) + (make-feeb-grahpics surf) + (free-surface surf))) + +(defmethod create-graphics ((feeb surface) &key free-p) + (with-surface feeb + (make-feeb-graphics)) + (if free-p + (fre-surface feeb))) + + +(defvar *time* 0) + +(defun human-player (&rest args) + (declare (ignore args)) + (sdl:with-events (:wait) + (:key-down-event (:key key) + (case key + (:sdl-key-up + (return-from human-player :move-forward)) + (:sdl-key-left + (return-from human-player :turn-left)) + (:sdl-key-right + (return-from human-player :turn-right)) + (:sdl-key-up + (return-from human-player :turn-around)) + (:sdl-key-space + (return-from human-player :flame)) + (:sdl-key-return + (return-from human-player :wait)))) + (:video-expose-event + (sdl:update-display)))) + + +(defun feebs (&key (delay 5) ; 4 min of game + human-player + files &aux (time 0)) + "The main loop program. Single-step is no longer available. +If human-player is supplied, it is taken as the name of human player, +wich will controll a feeb with the keyboard. The end of the game +only occurs if the player press ESC. +If there is no human, *game-length* is used instead. +A number of auto-feebs feebs are created by the system. +Also, if there are more feebs supplied than places, +the feeb wich is killed gives room to another feeb to be born." + (initialize-feebs) + (setf (sdl:frame-rate) 10) + + (init-maze *layout*) + + (dolist (file files) + (load file)) + (if human-player + (define-feeb + human-player + #'human-player)) + + (sdl:with-init () + (sdl:with-display () + (sdl:with-events () + (:idle () + (sdl:update-display) + (if zerop time + (progn + (setf time delay) + (play-one-turn) + (when (not *continue*) + (return))) + (decf time))) + )) + + (setf *feebs-to-be* nil)) + ;;; Feeb creation. ;; This a little better version of conservative-brain ;; all others (stupid or redundant) brains of original ;; feebs.lisp were eliminated - (defun simple-brain (status proximity vision vision-left vision-right) +(defun simple-brain (status proximity vision vision-left vision-right) (declare (ignore vision-left vision-right)) (let ((stuff (my-square proximity))) (cond ((and (consp stuff) (member :mushroom stuff :test #'eq)) Modified: main.lisp ============================================================================== --- main.lisp (original) +++ main.lisp Thu Dec 20 15:16:44 2007 @@ -23,9 +23,10 @@ ;;; Some functions -(defmacro def-feeb-parm (name value doc) +(defmacro define-parameter (name value doc) `(progn (defvar ,name ,value ,doc) + (export ,name) (pushnew ',name *feeb-parameters*))) (defun list-parameter-settings () @@ -34,207 +35,42 @@ (push (cons parm (symbol-value parm)) settings)) settings)) -(defun chance (ratio) - (< (random (denominator ratio)) (numerator ratio))) - -;;; General game parameters: - -(def-feeb-parm *game-length* 320 - "Number of cycles in the simulation.") - -(def-feeb-parm *number-of-auto-feebs* 0 - "Number of dumb system-provided feebs.") - -(def-feeb-parm *slow-feeb-noop-switch* nil - "If non-null, each feeb has a chance of having its orders aborted in - proportion to the time it takes to produce them. - See *slow-feeb-noop-factor*.") - -(def-feeb-parm *slow-feeb-noop-factor* 1/4 - "If *slow-feeb-noop-switch* is non-null, a feeb's orders will be aborted - with probability equal to the product of this factor times the time - taken by this feeb divided by *reference-time*, if non-nil, or - the total time taken by all feebs this turn otherwise.") - -(def-feeb-parm *reference-time* nil - "Time taken by reference if non-nil. See *slow-feeb-noop-factor*.") - -(def-feeb-parm *sense-location-p* t - "If non-null, x-position and y-position will return nil when - some a behavior function tries to invoke it.") - -;;(def-feeb-parm *sense-facing-p* t -;; "If non-null, facing will return nil when one tries to -;; invoke it.") - -;;; Scoring: - -(def-feeb-parm *points-for-killing* 5 - "Added to one's score for killing an opponent.") - -(def-feeb-parm *points-for-dying* -3 - "Added to one's score for being killed or starving.") - -(def-feeb-parm *points-for-slow-down* -1 - "Points earned when a feeb's move is aborted due to slowness.") - -;;; Cheating - -(def-feeb-parm *exclude-cheater-p* nil - "Tells if a feeb is excluded from the game when a cheating is done.") - -(def-feeb-parm *warn-when-cheating-p* t - "Tells if a continuable error must be signaled when a cheating is done.") ;;; Characteristics of the maze: -(def-feeb-parm *may-get-maze-map-p* t +(define-parameter *may-get-maze-map-p* t "Tells if the function (get-maze-map) returns the map layout of nil during the game.") -(def-feeb-parm *maze-x-size* 32 - "Number of columns in the maze.") - -(def-feeb-parm *maze-y-size* 32 - "Number of rows in the maze.") - -(def-feeb-parm *number-of-mushrooms* 8 - "Average number of mushrooms in the maze at any given time.") - ;;; Energies: -(def-feeb-parm *flame-energy* 10 - "Energy used when a feeb flames.") -(def-feeb-parm *mushroom-energy* 50 - "Energy gained when a mushroom is eaten.") - -(def-feeb-parm *carcass-energy* 30 - "Energy gained by feeding on a carcass.") - -(def-feeb-parm *maximum-energy* 100 - "The most energy a feeb can accumulate.") +;;; Carcasses: -(def-feeb-parm *starting-energy* 50 - "Smallest amount of energy a feeb will start with.") -;;; Carcasses: +;;; Fireballs: -(def-feeb-parm *carcass-guaranteed-lifetime* 5 - "Minimum number of turns a carcass will hang around.") -(def-feeb-parm *carcass-rot-probability* 1/3 - "Chance of a carcass rotting away each turn after its guaranteed lifetime.") +;;; Tests that behavior functions might use -;;; Fireballs: +(declare (inline feeb-image-p fireball-image-p)) -(def-feeb-parm *fireball-dissipation-probability* 1/5 - "Chance that a fireball will dissipate each turn after it is fired.") +(defun feeb-image-p (thing) + (typep thing 'feeb)) -(def-feeb-parm *fireball-reflection-probability* 2/3 - "Chance that a fireball will reflect when it hits a wall.") +(defun fireball-image-p (thing) + (typep thing 'fireball)) -(def-feeb-parm *flame-recovery-probability* 1/3 - "Chance a feeb will regain its ability to flame each turn after flaming once.") -;;; Structures: - -;;; The Feeb structure contains all of the info relevant to a particular feeb. -;;; The info available to the brain function is in the Status sub-structure. - -(defstruct (feeb - (:print-function print-feeb) - (:constructor make-feeb (id brain))) - id - brain - image - status - proximity - time - last-score - last-kills - facing - x-position - y-position - (dead-p nil) - (turns-since-flamed 0) - (vision (make-array (max *maze-x-size* *maze-y-size*))) - (vision-left (make-array (max *maze-x-size* *maze-y-size*))) - (vision-right (make-array (max *maze-x-size* *maze-y-size*)))) - -(defstruct (status - (:conc-name nil) - (:constructor make-status (name graphics))) - (name "" :read-only t) - facing - graphics - x-position - y-position - peeking - line-of-sight - (energy-reserve *starting-energy*) - (score 0) - (kills 0) - (ready-to-fire t) - (aborted nil) - (last-move :dead)) - -(defun print-feeb (structure stream depth) - (declare (ignore depth)) - (format stream "#<Feeb ~S>" - (name (feeb-status structure)))) - - -(defstruct (proximity - (:conc-name nil)) - my-square - rear-square - left-square - right-square) - - -;;; These image structures are used to represent feebs and fireballs in -;;; the sensory displays of other feebs. - -(defstruct (feeb-image - (:print-function print-feeb-image) - (:constructor make-feeb-image (name feeb))) - (name "" :read-only t) - facing - (feeb nil :read-only t) - peeking) - -(defun print-feeb-image (structure stream depth) - (declare (ignore depth)) - (format stream "#<Feeb-Image of ~S facing ~S>" - (feeb-image-name structure) - (feeb-image-facing structure))) - -(defstruct (fireball-image - (:print-function print-fireball-image) - (:constructor make-fireball-image (direction owner x y dx dy))) - direction - owner - x - y - dx - dy - (new t)) - -(defun print-fireball-image (structure stream depth) - (declare (ignore depth)) - (format stream "#<Fireball moving ~S>" - (fireball-image-direction structure))) - -(defstruct (pos (:constructor make-pos (x y))) - x - y) +;;; The maze ;;; Changing the maze (defun change-layout (layout) + "Changes the layout of the map. See variables +*maze-0* throw *maze-5* for examples (or options) of layouts" (when *feebs-to-be* (warn "There are some feebs that have already been defined. They could have used (get-maze-map). Those are they: @@ -246,22 +82,33 @@ (error "Not all the strings in ~a have the same size." layout))) (setf *layout* layout *maze-y-size* y - *maze-x-size* x))) + *maze-x-size* x)) + (init-maze)) (defun get-maze-map () - (when *may-get-maze-map-p* - (unless (and *maze* *fake-maze*) - (init-maze)) - (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*)))) - (dotimes (x *maze-x-size*) - (dotimes (y *maze-y-size*) - (setf (aref new-maze x y) (aref *fake-maze* x y)))) - new-maze))) + "Gets the current maze in the map. It returns an array +of *maze-x-size* by *maze-y-size*. Each element of the +array is one of these: + :rock - a wall + :mushroom-place - here is a place where mushrooms can grow up + :feeb-entry-place - here is a place where a feeb can reincarnate + nil - nothing special +Just remember that variables can change the behavior of this function, +like *may-get-maze-map-p* which, if nil, makes this function return +an array of nils" + (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*)))) + (dotimes (x *maze-x-size*) + (dotimes (y *maze-y-size*) + (setf (aref new-maze x y) (aref *fake-maze* x y)))) + new-maze))) (defun init-maze () (setf *maze* (make-array (list *maze-x-size* *maze-y-size*)) *fake-maze* (make-array (list *maze-x-size* *maze-y-size*)) - *entry-points* nil) + *entry-points* nil + *mushroom-sites* nil + *number-of-mushroom-sites* 0 + *number-of-entry-points* 0) (do ((rows *layout* (cdr rows)) (i (1- *maze-y-size*) (1- i))) ((null rows)) @@ -271,13 +118,17 @@ (aref *fake-maze* j i) nil) (case (schar str j) (#\X - (setf (aref *maze* j i) :rock - (aref *fake-maze* j i) :rock)) + (setf (aref *fake-maze* j i) (and *may-get-maze-map-p* :rock) + (aref *maze* j i) :rock)) (#\* - (setf (aref *fake-maze* j i) :mushroom-place) + (setf (aref *fake-maze* j i) (and *may-get-maze-map-p* + :mushroom-place)) + (incf *number-of-mushroom-sites*) (push (make-pos j i) *mushroom-sites*)) (#\e - (setf (aref *fake-maze* j i) :feeb-entry-place) + (setf (aref *fake-maze* j i) (and *may-get-maze-map-p* + :feeb-entry-place)) + (incf *number-of-entry-points*) (push (make-pos j i) *entry-points*)) (#\space nil) (t @@ -294,119 +145,90 @@ *static-parameters* (loop for (symbol . value) in (list-parameter-settings) collect value)) - (init-maze) - (setf *number-of-mushroom-sites* (length *mushroom-sites*) - *number-of-entry-points* (length *entry-points*)) (create-feebs)) ; The feebs are defined here -(defun create-mushrooms () - (dotimes (i (- *number-of-mushrooms* (length *mushrooms-alive*) (random 3))) - (do ((site (nth (random *number-of-mushroom-sites*) *mushroom-sites*) - (nth (random *number-of-mushroom-sites*) *mushroom-sites*))) - ((null (aref *maze* (pos-x site) (pos-y site))) - (setf (aref *maze* (pos-x site) (pos-y site)) :mushroom))))) -;;; Setting up the feebs. -(defvar *feebs* nil - "A list of all the feebs in the current game.") +;;; Setting up the feebs. -(defvar *next-feeb-id* 0 - "A counter used to assign a unique numerical code to each feeb.") +(defvar *feebs* nil) ;;; Define-Feeb builds a list of feebs to create. Create-Feebs actually ;;; builds the feebs on this list. (defvar *feebs-to-be* nil) -(defun define-feeb (name brain &optional prepare graphs) - (if (delete-feeb name) +(defun define-feeb (name brain &optional initializer graphs) + "Defines a feeb with name NAME, behavior function BRAIN. +The INITIALIZER key option must be either a function that +will be called in the very start of the game, or nil. +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 prepare graphs) *feebs-to-be*)) (defun delete-feeb (name) - (not - (equal *feebs-to-be* - (setf *feebs-to-be* - (remove name *feebs-to-be* :key #'car :test #'string=))))) + "Deletes the feeb which has name NAME, causing it not to +be created when the game begins. Does not work for feebs in +the game" + (setf *feebs-to-be* + (remove name *feebs-to-be* :key #'car :test #'string=))) + +(defun list-of-feebs () + "Returns a copy of the list of feebs that will be created +when the game begins." + (loop for (name . rest) in *feebs-to-be* + collect name)) + +(defun delete-all-feebs () + "Deletes all feebs that are to be defined when the game begins." + (setf *feebs-to-be* nil)) (defun create-feebs () - (flet ((create-feeb (name brain prepare graphs) - (let ((pos (pick-random-entry-point)) - (feeb (make-feeb *next-feeb-id* brain))) - (incf *next-feeb-id*) - (setf (feeb-image feeb) - (make-feeb-image name feeb) - (feeb-status feeb) - (make-status name nil); (sdl:load-and-convert-image graphs)) - (feeb-proximity feeb) - (make-proximity)) - (change-feeb-pos feeb (pos-x pos) (pos-y pos)) - (change-feeb-facing feeb (random 4)) - (push feeb *feebs*) - (place-object (feeb-image feeb) (pos-x pos) (pos-y pos)) - (when prepare - (let (*static-parameters* *fake-maze*) - (funcall prepare)) - (check-cheating name))))) - (setf *feebs* nil - *next-feeb-id* 0) - (dolist (feeb-spec (reverse *feebs-to-be*)) - (apply #'create-feeb feeb-spec)))) - -;;; Start at some randomly chosen entry point. If this one is occupied, -;;; scan successive entry points until a winner is found. Circle back -;;; to start of list if necessary. - -(defun pick-random-entry-point () - (do ((points (nth (random *number-of-entry-points*) *entry-points*) - (nth (random *number-of-entry-points*) *entry-points*))) - (nil) - (when (null (aref *maze* (pos-x points) - (pos-y points))) - (return points)))) - -;;; Movement interface. - -(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))) - -;;; Functions to change optional structure in status - -(defun change-feeb-pos (feeb x y) - (setf (feeb-x-position feeb) x - (feeb-y-position feeb) y) - (if *sense-location-p* - (setf (x-position (feeb-status feeb)) x - (y-position (feeb-status feeb)) y))) - -(defun change-feeb-facing (feeb facing) - (setf (feeb-facing feeb) -;; ;; use this code to make *sense-facing-p* available -;; ;; but be carefull - it does not really work -;; (if (or *sense-location-p* *sense-facing-p*) -;; (setf (facing (feeb-status feeb)) -;; facing) -;; facing) - (setf (facing (feeb-status feeb)) - (setf (feeb-image-facing (feeb-image feeb)) - facing)))) - -(defun kill-feeb (feeb) - (setf *dead-feebs* (nconc *dead-feebs* (list feeb)) - (feeb-dead-p feeb) t) - (let* ((status (feeb-status feeb)) - (x (feeb-x-position feeb)) - (y (feeb-y-position feeb))) - (push (list 0 x y) *carcasses*) - (incf (score status) *points-for-dying*) - (delete-object (feeb-image feeb) x y) - (place-object :carcass x y))) + (let ((entries (sort *entry-points* #'(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))))) + + +(defun play-one-turn () + ;; This is defined by rules + (start-turn) + ;; Maybe grow up mushrooms + (let ((m-sites (sort *mushroom-sites* + #'(lambda (x y) + (declare (ignore x y)) + (zerop (random 2)))))) + (dotimes (i *mushrooms-to-grow*) + (let ((site (pop m-sites))) + (create-mushroom (car site) (cdr site))))) + ;; Rot some carcasses: + (loop for carc in *carcasses* + with ncarcasses do + (unless (rot-carcass (second carc) (third carc) (first carc)) + (push carc ncarcasses) + (incf (first carc)) + (reincarnate-feeb (pop *dead-feebs*)))) + ;; Move some fireballs: + (dolist (fireball *fireballs-flying*) + (move-fireball fireball)) + ;; Playing with the feebs: + (dolist (feeb *feebs*) + (unless (feeb-dead-p feeb) + ;; Starve the feeb: + (when (<= (decf (feeb-energy-reserve feeb)) 0) + (kill-feeb feeb :starve)) + ;; Compute vision for the feeb: + (compute-vision feeb) + ;; Collect the feeb's move + (make-move-choice feeb))) + ;; Do all the feebs' moves. + (dolist (feeb *feebs*) + (unless (feeb-dead-p feeb) + (setf (feeb-peeking feeb) nil) + (move-feeb feeb (feeb-last-move feeb))))) Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Thu Dec 20 15:16:44 2007 @@ -45,7 +45,7 @@ (defpackage :feebs - (:use :common-lisp) + (:use :common-lisp :lispbuilder-sdl :lispbuilder-sdl-image :cffi) ;; Export everything we want the players to get their hands on. (:export *number-of-feebs* *game-length* *number-of-auto-feebs* @@ -64,8 +64,10 @@ ;; Probabilities *carcass-guaranteed-lifetime* *carcass-rot-probability* + *fireball-guaranteed-lifetime* *fireball-dissipation-probability* *fireball-reflection-probability* + *flame-no-recovery-time* *flame-recovery-probability* ;; Difficulty variables @@ -122,7 +124,7 @@ behind-dx behind-dy ;; Others - wallp + wallp chance ;; Graphics for alpha release simple-play print-map)) @@ -136,6 +138,9 @@ (defconstant south 2) (defconstant west 3) +;;; This is t if someone call (asdf:oos 'asdf:load-op 'feebs-c-interface) + +(defvar *c-interface-available* nil) ;;; Parameters that affect strategy of the game. @@ -190,8 +195,10 @@ "XXXXX XXXXXXXXXXXXX X" "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")) -(defparameter *maze-x-size* 32) -(defparameter *maze-y-size* 32) +(defparameter *maze-x-size* 32 + "Horizontal size of the maze") +(defparameter *maze-y-size* 32 + "Vertical size of the maze") ;;; Quantities during the game Modified: system.lisp ============================================================================== --- system.lisp (original) +++ system.lisp Thu Dec 20 15:16:44 2007 @@ -21,26 +21,205 @@ (in-package :feebs) -(defun reincarnate-feeb (feeb) - (let ((pos (nth (random (length *entry-points*)) *entry-points*)) + +;;; We start defining the main system rules by defining the classes + +;;; This class is used by the system + +(defclass object () + ((direction :accessor object-direction) + (x-position :accessor object-x-position) + (y-position :accessor object-y-position) + (lifetime :accessor object-lifetime :initform 0))) + +(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 + :reader feeb-image-name) + (direction :reader facing :reader feeb-image-facing + :initform (random 4)) + (peeking :accessor feeb-peeking :reader peeking + :reader feeb-image-peeking) + + ;; These are intended to be accessed only by the feeb itself + (x-position :reader x-position :initform 0 :initarg :x-position) + (y-position :reader y-position :initform 0 :initarg :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*) + (ready-to-fire :accessor feeb-ready-to-fire :reader ready-to-fire + :initform t) + (aborted :accessor feeb-aborted :reader aborted) + (last-move :accessor feeb-last-move :reader last-move + :initform :dead) + + ;; These are available for the system only + (brain :accessor feeb-brain :initarg :brain) + (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) + (score :accessor feeb-score :initform 0) + (kills :accessor feeb-kills :initform 0) + (dead-p :accessor feeb-dead-p) + (playing-p :accessor feeb-playing-p) + (turns-since-flamed :accessor feeb-turns-since-flamed :initform 0) + (proximity :accessor feeb-proximity :initform (make-proximity)) + (vision :accessor feeb-vision + :initform (make-array (list (max *maze-y-size* *maze-x-size*)))) + (vision-left :accessor feeb-vision-left + :initform (make-array (list (max *maze-y-size* *maze-x-size*)))) + (vision-right :accessor feeb-vision-right + :initform (make-array (list (max *maze-y-size* *maze-x-size*)))))) + +;;; These make sure that these accessors are just available +;;; for the feeb itself + +(defmethod name :around ((fb feeb)) + (if (feeb-playing-p fb) ;; check if the feeb itself is accessing its name + (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 + +(defun create-mushroom (x y) + (unless (member :mushroom (aref *maze* x y)) + (place-object :mushroom x y) + t)) + +(defun rot-carcass (x y) + (delete-object :carcass x y) + 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) + (delete-object obj (object-x-position obj) + (object-y-position obj)) + (place-object obj x y) + (setf (object-x-position obj) x + (object-y-position obj) y)) + +(defun get-forward-pos (object) + (let ((new-x (+ (forward-dx (object-direction object)) + (object-x-position object))) + (new-y (+ (forward-dy (object-direction object)) + (object-y-position object)))) + (values (aref *maze* new-x new-y) new-x new-y))) + + +;;; --**-- System Rules --**-- + +;;; -*- General Rules -*- + +(defmethod start-round () + t) + +(defmethod start-turn () + t) + +(defmethod create-feeb (x-pos y-pos name brain prepare graphs) + (let ((feeb (make-instance 'feeb + :name name + :brain brain + :graphics (if graphs + (sdl:load-and-convert-image graphs)) + :x-position x-pos + :y-position y-pos))) + (push feeb *feebs*) + (place-object (feeb-image feeb) x-pos y-pos) + (when prepare + (funcall prepare)))) + + + +;;; -*- Dying and Killing -*- + +;;; Reincarnating + +(defmethod reincarnate-feeb ((feeb feeb)) + (let ((pos (nth (random *number-of-entry-points*) *entry-points*)) (status (feeb-status feeb))) - (place-object (feeb-image feeb) - (pos-x pos) (pos-y pos)) - (change-feeb-pos feeb (pos-x pos) (pos-y pos)) - (change-feeb-facing feeb (random 4)) - (setf (feeb-dead-p feeb) nil + (change-object-pos feeb (pos-x pos) (pos-y pos)) + (setf (feeb-facing feeb) (random 4) + (feeb-dead-p feeb) nil (ready-to-fire status) t (energy-reserve status) *starting-energy* (last-move status) :dead))) +;;; Dying + +(defmethod destroy-object ((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)) + (y (feeb-y-position feeb))) + (push (list 0 x y) *carcasses*) + (delete-object (feeb-image feeb) x y) + (place-object :carcass x y))) -;;; Vision calculation. -;;; These guys tell us offsets given an orientation. + +;;; -*- Vision Calculation -*- + +;;; Computes what the feeb is seeing (defun compute-vision (feeb) - (let ((status (feeb-status feeb)) - (proximity (feeb-proximity feeb)) + (let ((proximity (feeb-proximity feeb)) (vision (feeb-vision feeb)) (vision-left (feeb-vision-left feeb)) (vision-right (feeb-vision-right feeb)) @@ -62,7 +241,7 @@ (setf x (+ x (forward-dx facing)) y (+ y (forward-dy facing))) ;; Figure out which direction to scan in. - (case (peeking status) + (case (feeb-peeking feeb) (:left (setf facing (left-of facing))) (:right (setf facing (right-of facing)))) (setf vision-dx (forward-dx facing) @@ -92,213 +271,119 @@ ;;; A peeking feeb must be facing in the specified direction in order to count. (defun side-imagify (stuff facing) - (cond - ((wallp stuff) - stuff) - ((find-if #'(lambda (thing) - (and (feeb-image-p thing) - (peeking (feeb-status (feeb-image-feeb thing))) - (= facing (feeb-image-facing thing)) - (setf facing thing))) - stuff) - (peeking (feeb-status (feeb-image-feeb facing)))) - (t nil))) - -;;; Movement. - -;;; Each turn, the following stuff has to happen: -;;; 1. Bump the turn counter; end the game if we should. -;;; 2. Maybe grow some mushrooms. -;;; 3. Maybe disappear some carcasses. -;;; 4. Move fireballs around. -;;; 5. See if any feebs have starved. -;;; 6. See if any feebs can flame again. -;;; 7. Compute vision and stuff for feebs. -;;; 8. Collect the feebs' moves. -;;; 9. Do the feeb's moves. - -(defun play-one-turn () - ;; Grow some mushrooms: - (dotimes (x (- *number-of-mushrooms* *mushrooms-alive*)) - (let* ((site (nth (random *number-of-mushroom-sites*) *mushroom-sites*)) - (x (pos-x site)) - (y (pos-y site))) - (unless (member :mushroom (aref *maze* x y)) - (place-object :mushroom x y)))) - ;; Rot some carcasses: - (dolist (carc *carcasses*) - (when (and - (> (incf (first carc) *carcass-guaranteed-lifetime*)) - (chance *carcass-rot-probability*)) - (delete-object :carcass (second carc) (third carc)) - (setf *carcasses* (delete carc *carcasses*)) - (if *dead-feebs* - (reincarnate-feeb (pop *dead-feebs*))))) - ;; Move some fireballs: - (dolist (fireball *fireballs-flying*) - (move-one-fireball fireball)) - ;; Starve some feebs: - (dolist (feeb *feebs*) - (unless (feeb-dead-p feeb) - (when (<= (decf (energy-reserve (feeb-status feeb))) 0) - (kill-feeb feeb)))) - ;; Let some feebs regain the power to flame: - (dolist (feeb *feebs*) - (unless (and (feeb-dead-p feeb) - (ready-to-fire (feeb-status feeb))) - (when (and (> (incf (feeb-turns-since-flamed feeb)) - 1) - (chance *flame-recovery-probability*)) - (setf (ready-to-fire (feeb-status feeb)) t)))) - ;; Collect all the feebs' moves, keeping track of the time each one takes. - (let ((total-time 1)) - (dolist (feeb *feebs*) - (unless (feeb-dead-p feeb) - (compute-vision feeb) ; Compute vision for all the feeb. - (let ((time (get-internal-real-time))) - (let ( *static-parameters* *fake-maze*) - (setf (last-move (feeb-status feeb)) - (funcall (feeb-brain feeb) - (feeb-status feeb) - (feeb-proximity feeb) - (feeb-vision feeb) - (feeb-vision-left feeb) - (feeb-vision-right feeb)) - time (- (get-internal-real-time) time))) - (incf total-time time) - (setf (feeb-time feeb) time)))) - ;; Do all the feebs' moves, or perhaps abort the move according - ;; to the time taken by the feeb. - (setf total-time (float total-time)) - (dolist (feeb *feebs*) - (unless (feeb-dead-p feeb) - (if (and *slow-feeb-noop-switch* - (< (random 1.0) - (* *slow-feeb-noop-factor* - (/ (float (feeb-time feeb)) - (or *reference-time* total-time))))) - (progn - (setf (aborted (feeb-status feeb)) t) - (incf (score (feeb-status feeb)) *points-for-slow-down*)) - (progn - (setf (aborted (feeb-status feeb)) nil) - (do-move feeb (last-move (feeb-status feeb))))) - ;; Make the image consistent with the feeb. - (setf (feeb-image-facing (feeb-image feeb)) - (feeb-facing feeb)))))) - -(defun move-one-fireball (fireball) - (let ((x (fireball-image-x fireball)) - (y (fireball-image-y fireball))) - ;; Remove fireball from current square, unless it is new. - (if (fireball-image-new fireball) - (setf (fireball-image-new fireball) nil) - (delete-object fireball x y)) - ;; The fireball might dissipate. - (when (chance *fireball-dissipation-probability*) - (setq *fireballs-flying* (delete fireball *fireballs-flying*)) - (return-from move-one-fireball nil)) - ;; Now move it to new coordinates. - (incf x (fireball-image-dx fireball)) - (incf y (fireball-image-dy fireball)) + (if (wallp stuff) + stuff + (loop for thing in stuff + and elt = (and (feeb-image-p thing) + (= facing (feeb-image-facing thing)) + (feeb-image-peeking thing)) + if elt + return it))) + +(defparameter *mushrooms-to-grow* 0) + +(defun number-of-mushrooms (n) + (setf *mushrooms-to-grow* n)) + + +;;; Lets the feeb make a choice + +(defmethod make-move-choice ((feeb feeb)) + (setf (last-move (feeb-status feeb)) + (funcall (feeb-brain feeb) + (feeb-status feeb) + (feeb-proximity feeb) + (feeb-vision feeb) + (feeb-vision-left feeb) + (feeb-vision-right feeb)))) + + + +;;; Moves the fireball + +(defmethod make-move ((fireball fireball)) + ;; move it to new coordinates. + (let ((x (incf (fireball-x fireball) + (forward-dx (fireball-direction fireball)))) + (y (incf (fireball-y fireball) + (forward-dy (fireball-direction fireball))))) ;; If it hits rock, either reflect or dissipate. (when (wallp (aref *maze* x y)) - (cond ((chance *fireball-reflection-probability*) - (setf (fireball-image-dx fireball) - (- (fireball-image-dx fireball))) - (setf (fireball-image-dy fireball) - (- (fireball-image-dy fireball))) - (setf (fireball-image-direction fireball) - (behind (fireball-image-direction fireball))) - (setq x (fireball-image-x fireball)) - (setq y (fireball-image-y fireball))) - (t (setq *fireballs-flying* - (delete fireball *fireballs-flying*)) - (return-from move-one-fireball nil)))) + (if (and (> (incf (fireball-age fireball)) + *fireball-guaranteed-lifetime*) + (chance *fireball-reflection-probability*)) + (setf (fireball-direction fireball) + (behind (fireball-direction fireball)) + x (fireball-x fireball) + y (fireball-y fireball)) + (progn + (setf *fireballs-flying* + (delete fireball *fireballs-flying*)) + (return-from move-one-fireball)))) ;; Now put the fireball into the new square. - (setf (fireball-image-x fireball) x) - (setf (fireball-image-y fireball) y) - (place-object fireball x y) - ;; And destroy whatever is there. - (delete-object :mushroom x y) - (dolist (thing (aref *maze* x y)) - (if (feeb-image-p thing) - (score-kill fireball (feeb-image-feeb thing)))))) - -;;; The fireball kills the feeb. Update score for killer and victims. -;;; No credit for the kill if you shoot yourself. - -(defun score-kill (fireball feeb) - (unless (eq (fireball-image-owner fireball) feeb) - (incf (score (feeb-status (fireball-image-owner fireball))) - *points-for-killing*) - (incf (kills (feeb-status (fireball-image-owner fireball))))) - (kill-feeb feeb)) + (setf (fireball-x fireball) x + (fireball-y fireball) y) + (change-object-pos fireball x y))) ;;; Doing feeb moves. -(defun do-move (feeb move) - (let ((status (feeb-status feeb)) - (facing (feeb-facing feeb))) - ;; Peeking gets undone every move. +(defmethod make-move ((feeb feeb) (move (eql :turn-right))) + (setf (feeb-facing feeb) (right-of facing)) (call-next-method)) + +(defmethod make-move ((feeb feeb) (move (eql :turn-around))) + (setf (feeb-facing feeb) (behind facing)) (call-next-method)) + +(defmethod make-move (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) + (let ((thing (find-if #'fireball-image-p stuff))) + (when thing (kill-feeb feeb thing) + (return-from make-move t)))) + (call-next-method)) + +(defmethod make-move ((feeb feeb) (move (eql :flame))) + (let ((x (feeb-x-position feeb)) + (y (feeb-y-position feeb)) + (fireball + (make-fireball-image (feeb-facing feeb) + feeb x y (forward-dx facing) + (forward-dy facing)))) + (push fireball *fireballs-flying*)) + (call-next-method)) + +(defmethod make-move ((feeb feeb) (move (eql :eat-mushroom))) + (let ((x (feeb-x-position feeb)) + (y (feeb-y-position feeb))) + (when (member :mushroom (aref *maze* x y)) + (delete-object :mushroom x y) + t))) + +(defmethod make-move ((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))) + +(defmethod make-move ((feeb feeb) (move (eql :peek-left))) + (unless + (wallp + (aref *maze* (+ (feeb-x-position feeb) + (forward-dx (feeb-facing feeb))) + (+ (feeb-y-position feeb) + (forward-dy (feeb-facing feeb))))) + (setf (peeking status) + (setf (feeb-image-peeking (feeb-image feeb)) move))) + (call-next-method)) + +(defmethod make-move ((feeb feeb) (move (eql :peek-right))) + (unless + (wallp + (aref *maze* (+ (feeb-x-position feeb) + (forward-dx (feeb-facing feeb))) + (+ (feeb-y-position feeb) + (forward-dy (feeb-facing feeb))))) (setf (peeking status) - (setf (feeb-image-peeking (feeb-image feeb)) nil)) - (case move - (:turn-left - (change-feeb-facing feeb (left-of facing))) - (:turn-right - (change-feeb-facing feeb (right-of facing))) - (:turn-around - (change-feeb-facing feeb (behind facing))) - (:move-forward - (let* ((old-x (feeb-x-position feeb)) - (old-y (feeb-y-position feeb)) - (new-x (+ (forward-dx facing) old-x)) - (new-y (+ (forward-dy facing) old-y)) - (stuff (aref *maze* new-x new-y))) - (when (wallp stuff) - (return-from do-move nil)) - (delete-object (feeb-image feeb) old-x old-y) - (change-feeb-pos feeb new-x new-y) - (place-object (feeb-image feeb) new-x new-y) - ;; Look for a fireball in the destination square. - (let ((thing (find-if #'fireball-image-p stuff))) - (when thing - (score-kill thing feeb) - (return-from do-move nil))))) - (:flame - (when (ready-to-fire status) - (let* ((x (feeb-x-position feeb)) - (y (feeb-y-position feeb)) - (fireball (make-fireball-image - facing feeb x y - (forward-dx facing) (forward-dy facing)))) - ;; Queue the fireball, marked as new, but don't put it on map yet. - (push fireball *fireballs-flying*) - (decf (energy-reserve status) *flame-energy*) - (setf (ready-to-fire status) nil) - (setf (feeb-turns-since-flamed feeb) 0)))) - (:eat-mushroom - (let* ((x (feeb-x-position feeb)) - (y (feeb-y-position feeb))) - (when (member :mushroom (aref *maze* x y)) - (delete-object :mushroom x y) - (setf (energy-reserve status) - (min (+ (energy-reserve status) *mushroom-energy*) - *maximum-energy*))))) - (:eat-carcass - (let* ((x (feeb-x-position feeb)) - (y (feeb-y-position feeb))) - (when (member :carcass (aref *maze* x y)) - (setf (energy-reserve status) - (min (+ (energy-reserve status) *carcass-energy*) - *maximum-energy*))))) - ((:peek-left :peek-right) - (unless (wallp (aref *maze* (+ (feeb-x-position feeb) - (forward-dx facing)) - (+ (feeb-y-position feeb) - (forward-dy facing)))) - (setf (peeking status) - (setf (feeb-image-peeking (feeb-image feeb)) move)))) - (:wait nil) - (t (warn "Unknown feeb movement: ~a." move))))) + (setf (feeb-image-peeking (feeb-image feeb)) move))) + (call-next-method))

1 0

[the-feebs-war-cvs] r4 -
by gmilare＠common-lisp.net 20 Dec '07

20 Dec '07

Author: gmilare Date: Thu Dec 20 15:15:52 2007 New Revision: 4 Removed: brains.fasl Log:

1 0

[the-feebs-war-cvs] r3 -
by gmilare＠common-lisp.net 20 Dec '07

20 Dec '07

Author: gmilare Date: Thu Dec 20 15:15:24 2007 New Revision: 3 Removed: feebs.asd Log:

1 0