[the-feebs-war-cvs] r7 -
gmilare at common-lisp.net
gmilare at common-lisp.net
Sun Dec 30 01:30:34 UTC 2007
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)
, at finalize)
(declare (list ,v ,vl ,vr)
- (fixnum ,count)) ; can be assumed fixnum unless you have a mega PC
+ (fixnum ,count))
(dolist (,vis ,v)
, at 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 at 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)
More information about the The-feebs-war-cvs
mailing list