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