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@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)