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