/[the-feebs-war]/main.lisp
ViewVC logotype

Contents of /main.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 14 - (hide annotations)
Sat Feb 16 19:59:50 2008 UTC (6 years, 2 months ago) by gmilare
File size: 7992 byte(s)
1 gmilare 1 ;;; -*- Common Lisp -*-
2    
3 gmilare 14 #| Copyright (c) 2007,2008 Gustavo Henrique Milaré
4 gmilare 1
5     This file is part of The Feebs War.
6    
7     The Feebs War is free software; you can redistribute it and/or modify
8     it under the terms of the GNU General Public License as published by
9     the Free Software Foundation; either version 3 of the License, or
10     (at your option) any later version.
11    
12     The Feebs War is distributed in the hope that it will be useful,
13     but WITHOUT ANY WARRANTY; without even the implied warranty of
14     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15     GNU General Public License for more details.
16    
17     You should have received a copy of the GNU General Public License
18 gmilare 7 along with The Feebs War. If not, see <http://www.gnu.org/licenses/>.
19 gmilare 1 |#
20    
21    
22 gmilare 14 (in-package :the-feebs-war)
23 gmilare 1
24    
25    
26 gmilare 11 ;;; Parameters
27    
28     (let ((parameters (make-hash-table :test 'eq)))
29    
30     (defun def-feeb-parm (name value &optional doc)
31     (aif (gethash name parameters)
32     (progn
33     (warn "Change parameter ~a to ~a: ~
34     parameter already existed with value ~a." name value (car it))
35     (setf (gethash name parameters) (cons value (or doc (cdr it)))))
36     (setf (gethash name parameters) (cons value doc)))
37 gmilare 13 (export name)
38 gmilare 11 name)
39    
40     (defun get-feeb-parm (name)
41 gmilare 13 (car (gethash name parameters)))
42 gmilare 11
43 gmilare 13 (defun change-feeb-parm (name value)
44 gmilare 12 (unless *playing-feeb*
45     (setf (car (gethash name parameters)) value)))
46 gmilare 11
47     (defmethod documentation (name (type (eql 'feeb-parameter)))
48     (cdr (gethash name parameters)))
49    
50     (defun list-parameter-settings ()
51     (let (params)
52     (maphash #'(lambda (key value)
53     (push (list key (car value) (cdr value)) params))
54     parameters)
55     params)))
56    
57    
58 gmilare 1 ;;; Characteristics of the maze:
59    
60 gmilare 13 (def-feeb-parm 'maze-x-size *maze-x-size*
61     "Horizontal size of the maze.")
62    
63     (def-feeb-parm 'maze-y-size *maze-y-size*
64     "Vertical size of the maze.")
65    
66 gmilare 11 (def-feeb-parm 'may-get-maze-map-p t
67     "Tells if the function (get-maze-map) returns the map layout
68     instead of nil during the game.")
69 gmilare 1
70    
71    
72 gmilare 5 ;;; The maze
73 gmilare 1
74     ;;; Changing the maze
75     (defun change-layout (layout)
76 gmilare 5 "Changes the layout of the map. See variables
77 gmilare 13 *maze-0* throw *maze-5* for examples (or options) of layouts."
78 gmilare 1 (when *feebs-to-be*
79     (warn "There are some feebs that have already been defined.
80     They could have used (get-maze-map). Those are they:
81     ~a." (loop for feeb in *feebs-to-be* collect (first feeb))))
82     (let ((x (length layout))
83     (y (length (car layout))))
84     (loop for string in layout do
85     (if (/= (length string) y)
86     (error "Not all the strings in ~a have the same size." layout)))
87     (setf *layout* layout
88 gmilare 11 *maze-y-size* (change-feeb-parm 'maze-y-size y)
89     *maze-x-size*(change-feeb-parm 'maze-x-size x)))
90 gmilare 5 (init-maze))
91 gmilare 1
92     (defun get-maze-map ()
93 gmilare 5 "Gets the current maze in the map. It returns an array
94     of *maze-x-size* by *maze-y-size*. Each element of the
95     array is one of these:
96     :rock - a wall
97 gmilare 9 :mushroom-place - place where mushrooms can grow up
98     :feeb-entry-place -place where a feeb can reincarnate
99 gmilare 5 nil - nothing special
100 gmilare 9 Just remember that if *may-get-maze-map-p* is nil,
101 gmilare 11 this function return nil."
102     (and (get-feeb-parm 'may-get-maze-map-p)
103     (let ((new-maze (make-array (list *maze-x-size* *maze-y-size*))))
104     (dotimes (x *maze-x-size*)
105     (dotimes (y *maze-y-size*)
106     (setf (aref new-maze x y) (aref *fake-maze* x y))))
107     new-maze)))
108 gmilare 1
109     (defun init-maze ()
110     (setf *maze* (make-array (list *maze-x-size* *maze-y-size*))
111     *fake-maze* (make-array (list *maze-x-size* *maze-y-size*))
112 gmilare 5 *entry-points* nil
113     *mushroom-sites* nil
114     *number-of-mushroom-sites* 0
115     *number-of-entry-points* 0)
116 gmilare 1 (do ((rows *layout* (cdr rows))
117 gmilare 13 (y (1- *maze-y-size*) (1- y))) ; inverting the y axis
118 gmilare 1 ((null rows))
119     (let ((str (car rows)))
120 gmilare 13 (dotimes (x (length str))
121     (setf (aref *maze* x y) nil
122     (aref *fake-maze* x y) nil)
123     (case (schar str x)
124 gmilare 1 (#\X
125 gmilare 13 (setf (aref *fake-maze* x y) :rock
126     (aref *maze* x y) (list :rock)))
127 gmilare 1 (#\*
128 gmilare 13 (setf (aref *fake-maze* x y) :mushroom-place)
129 gmilare 5 (incf *number-of-mushroom-sites*)
130 gmilare 13 (push (cons x y) *mushroom-sites*))
131 gmilare 1 (#\e
132 gmilare 13 (setf (aref *fake-maze* x y)
133 gmilare 11 :feeb-entry-place)
134 gmilare 5 (incf *number-of-entry-points*)
135 gmilare 13 (push (cons x y) *entry-points*))
136 gmilare 1 (#\space nil)
137     (t
138 gmilare 13 (error "Unknown spec in maze: ~C." (schar str x))))))))
139 gmilare 1
140 gmilare 13 (eval-when (:load-toplevel)
141     (init-maze))
142    
143 gmilare 1 (defun initialize-feebs ()
144 gmilare 13 (setf *feebs* ()
145     *dead-feebs* ()
146     *fireballs-flying* ()
147     *mushroom-sites* ()
148     *carcasses* ()
149     *playing-feeb* nil)
150     (init-maze)
151 gmilare 1 (create-feebs)) ; The feebs are defined here
152    
153    
154 gmilare 5
155 gmilare 1 ;;; Define-Feeb builds a list of feebs to create. Create-Feebs actually
156     ;;; builds the feebs on this list.
157    
158     (defvar *feebs-to-be* nil)
159    
160 gmilare 9 (defun define-feeb (name brain &key graphics (class 'feeb))
161 gmilare 5 "Defines a feeb with name NAME, behavior function BRAIN.
162     If there is another feeb with the same name, overwrites it
163 gmilare 7 with a case sensitive test."
164 gmilare 5 (when (find name *feebs-to-be* :key #'car
165 gmilare 13 :test #'string=)
166     (delete-feeb name)
167     (warn "Feeb ~s already exists, deleting..." name))
168     (push (list name brain graphics class) *feebs-to-be*)
169     name)
170 gmilare 1
171     (defun delete-feeb (name)
172 gmilare 5 "Deletes the feeb which has name NAME, causing it not to
173 gmilare 7 be created when the game begins. Does not work for feebs
174     already in the game."
175 gmilare 5 (setf *feebs-to-be*
176 gmilare 13 (remove name *feebs-to-be* :key #'car :test #'string=))
177     nil)
178 gmilare 1
179 gmilare 5 (defun list-of-feebs ()
180     "Returns a copy of the list of feebs that will be created
181     when the game begins."
182     (loop for (name . rest) in *feebs-to-be*
183     collect name))
184 gmilare 1
185 gmilare 5 (defun delete-all-feebs ()
186     "Deletes all feebs that are to be defined when the game begins."
187     (setf *feebs-to-be* nil))
188 gmilare 1
189 gmilare 5 (defun create-feebs ()
190 gmilare 9 (flet ((create-feeb (x-pos y-pos name brain graphs class)
191     (let ((feeb (make-instance class
192 gmilare 7 :name name
193     :brain brain
194     :graphics graphs
195     :x-position x-pos
196     :y-position y-pos)))
197     (if (and x-pos y-pos)
198     (create-object feeb x-pos y-pos)
199     (push feeb *dead-feebs*)))))
200 gmilare 13 (let ((entries (sort (copy-list *entry-points*) ; random positions
201     #'(lambda (x y)
202     (declare (ignore x y))
203     (zerop (random 2))))))
204     (setf *feebs* nil)
205     (dolist (feeb-spec *feebs-to-be*)
206     (let ((pos (pop entries)))
207     (apply #'create-feeb (car pos) (cdr pos) feeb-spec))))))
208 gmilare 1
209    
210 gmilare 7
211     ;;; The Game
212    
213 gmilare 11 (let ((mushrooms 1))
214 gmilare 7
215 gmilare 9 (defun number-of-mushrooms (n)
216 gmilare 11 (setf mushrooms n))
217 gmilare 7
218 gmilare 9 (defun play-one-turn ()
219     ;; This is defined by rules:
220 gmilare 11 (start-turn) ; possible call to number-of-mushrooms
221 gmilare 9 ;; Maybe grow up mushrooms:
222 gmilare 13 (let ((m-sites (sort (copy-list *mushroom-sites*)
223 gmilare 9 #'(lambda (x y)
224     (declare (ignore x y))
225     (zerop (random 2))))))
226     (dotimes (i mushrooms)
227     (let ((site (pop m-sites)))
228 gmilare 13 (unless (find-if #'fireball-p
229     (aref *maze* (car site) (cdr site)))
230     (create-mushroom (car site) (cdr site))))))
231 gmilare 9 ;; Maybe rot some carcasses
232 gmilare 11 (dolist (carc (prog1 *carcasses*
233     (setf *carcasses* nil)))
234 gmilare 12 (if (rot-carcass-p (first carc))
235     (progn
236     (delete-object :carcass (second carc) (third carc))
237     (reincarnate-feeb (pop *dead-feebs*)))
238 gmilare 11 (progn
239     (incf (first carc))
240     (push carc *carcasses*))))
241 gmilare 9 ;; Move some fireballs:
242 gmilare 10 (dolist (fireball *fireballs-flying*)
243 gmilare 13 (make-move fireball (make-move-choice fireball)))
244 gmilare 10 (dolist (feeb *feebs*)
245 gmilare 12 ;; Starve the feeb:
246     (when (<= (decf (feeb-energy-reserve feeb)) 0)
247     (destroy-object feeb :starve)))
248 gmilare 11 (dolist (*playing-feeb* *feebs*)
249 gmilare 12 ;; Compute vision for the feeb:
250 gmilare 13 (compute-vision *playing-feeb*)
251     (incf (feeb-turns-since-flamed *playing-feeb*))
252 gmilare 12 ;; Lets the feeb make a choice
253     (setf (feeb-last-move *playing-feeb*)
254     (make-move-choice *playing-feeb*)
255     (feeb-peeking *playing-feeb*) nil))
256     ;; binds the variable to the current playing feeb
257     (dolist (feeb *feebs*)
258     ;; Collect the feeb's move
259 gmilare 13 (make-move feeb (feeb-last-move feeb))))
260 gmilare 12
261     ) ; end of let ((mushrooms 1))

  ViewVC Help
Powered by ViewVC 1.1.5