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

Contents of /graphics/graphics.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 21 - (show annotations)
Sat Aug 7 13:40:44 2010 UTC (3 years, 8 months ago) by gmilare
File size: 6461 byte(s)
Corrected mistakes in feebs.tex and enhanced printing of game (thanks to XIE Wensheng)
1 ;;; -*- Common Lisp -*-
2
3 #| Copyright (c) 2007,2008 Gustavo Henrique Milaré
4
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 along with The Feebs War. If not, see <http://www.gnu.org/licenses/>.
19 |#
20
21
22 (in-package :the-feebs-war)
23
24
25
26 (defun print-direction (dir)
27 (case dir
28 (0 #\N)
29 (1 #\E)
30 (2 #\S)
31 (3 #\W)))
32
33 (defun print-map ()
34 (format t "~%") ;add this line
35 (dotimes (y *maze-y-size*)
36 (dotimes (x *maze-x-size*)
37 (let ((elt (aref *maze* x y)))
38 (apply 'format t
39 (cond
40 ((wallp elt)
41 (list " XX"))
42 ((feeb-p (car elt))
43 (list " F~a"
44 (print-direction (feeb-facing (car elt)))))
45 ((fireball-p (car elt))
46 (list " *~a" (print-direction (fireball-direction (car elt)))))
47 ((eq (car elt) :mushroom)
48 (list " mm"))
49 ((eq (car elt) :carcass)
50 (list " cc"))
51 (t (list " "))))))
52 (format t "~%"))
53 (format t "~%")) ;add this line
54
55 (defun simple-play (&optional layout)
56 (if layout
57 (change-layout layout))
58 (make-auto-feebs (- 10 (length *feebs-to-be*)))
59 (initialize-feebs)
60 (start-round)
61 (loop until (finish-game-p)
62 do
63 (play-one-turn)
64 (print-map)
65 (sleep 0.7))
66 (format t "Game Over!!~%~%Scores:~%~%")
67 (let ((scores nil))
68 (dolist (feeb *feebs*)
69 (push (list (feeb-name feeb) (feeb-score feeb))
70 scores)) ;collect living feebs' sores
71 (dolist (feeb *dead-feebs*)
72 (push (list (feeb-name feeb) (feeb-score feeb))
73 scores)) ;collect dead feebs' scoes
74 (sort scores #'> :key #'second) ;sort the scores in dcreasing order
75 (dolist (score scores)
76 (format t "~30@<~a:~> ~@d~%"
77 (first score) (second score))))) ;print out scores
78
79
80 #|
81
82
83 (defconst *default-graphics*
84 (make-feeb-graphics
85 (load-and-convert-image "default-feeb.bmp")))
86
87 (defvar *cell-width* 32)
88 (defvar *cell-heigth* 32)
89
90 (defstruct graphic
91 (walk (make-direction))
92 (flaming (make-direction)))
93
94 (defstruct (direction (:conc-name nil))
95 (up (make-array 3))
96 (left (make-array 3))
97 (down (make-array 3))
98 (right (make-array 3)))
99
100 (defun make-feeb-graphics (surface)
101
102 (let ((graphic (make-graphic)))
103 (progn
104 (loop for field in '(walk flaming)
105 and y0 from 0 by (* 4 *cell-heigth*) do
106 (loop for dir in '(up left right down)
107 and y from y0 by *cell-heigth* do
108 (loop for ind below 3
109 and x from 0 by *cell-width*
110 for aux = (surface :width *cell-width* :heigth *cell-heigth*) do
111 (set-cell :x x :y y :width *cell-width* :heigth *cell-heigth* :surface surface)
112 (draw-surface surface :surface aux)
113 (setf (svref (slot-value (slot-value graphic field)
114 dir)
115 ind)
116 aux))))
117 graphic)))
118
119 (defgeneric create-graphics (feeb) &key (free-p t))
120
121 (defmethod create-graphics ((feeb pathname))
122 (let ((surf (load-and-convert-image feeb)))
123 (make-feeb-grahpics surf)
124 (free-surface surf)))
125
126 (defmethod create-graphics ((feeb surface) &key free-p)
127 (with-surface feeb
128 (make-feeb-graphics))
129 (if free-p
130 (fre-surface feeb)))
131
132
133 (defvar *time* 0)
134
135 (defun human-player (&rest args)
136 (declare (ignore args))
137 (sdl:with-events (:wait)
138 (:key-down-event (:key key)
139 (case key
140 (:sdl-key-up
141 (return-from human-player :move-forward))
142 (:sdl-key-left
143 (return-from human-player :turn-left))
144 (:sdl-key-right
145 (return-from human-player :turn-right))
146 (:sdl-key-up
147 (return-from human-player :turn-around))
148 (:sdl-key-space
149 (return-from human-player :flame))
150 (:sdl-key-return
151 (return-from human-player :wait))))
152 (:video-expose-event
153 (sdl:update-display))))
154
155
156 (defun feebs (&key (delay 5) ; 4 min of game
157 human-player
158 files &aux (time 0))
159 "The main loop program. Single-step is no longer available.
160 If human-player is supplied, it is taken as the name of human player,
161 wich will controll a feeb with the keyboard. The end of the game
162 only occurs if the player press ESC.
163 If there is no human, *game-length* is used instead.
164 A number of auto-feebs feebs are created by the system.
165 Also, if there are more feebs supplied than places,
166 the feeb wich is killed gives room to another feeb to be born."
167 (initialize-feebs)
168 (setf (sdl:frame-rate) 10)
169
170 (init-maze *layout*)
171
172 (dolist (file files)
173 (load file))
174 (if human-player
175 (define-feeb
176 human-player
177 #'human-player))
178
179 (sdl:with-init ()
180 (sdl:with-display ()
181 (sdl:with-events ()
182 (:idle ()
183 (sdl:update-display)
184 (if zerop time
185 (progn
186 (setf time delay)
187 (play-one-turn)
188 (when (not *continue*)
189 (return)))
190 (decf time)))
191 ))
192
193 (setf *feebs-to-be* nil))
194
195 ;;; Feeb creation.
196
197 ;; This a little better version of conservative-brain
198 ;; all others (stupid or redundant) brains of original
199 ;; feebs.lisp were eliminated
200 (defun simple-brain (status proximity vision vision-left vision-right)
201 (declare (ignore vision-left vision-right))
202 (let ((stuff (my-square proximity)))
203 (cond ((and (consp stuff) (member :mushroom stuff :test #'eq))
204 :eat-mushroom)
205 ((and (consp stuff) (member :carcass stuff :test #'eq))
206 :eat-carcass)
207 ((and (ready-to-fire status)
208 (> (energy-reserve status) 30)
209 (dotimes (index (min (line-of-sight status) 5))
210 (if (find-if #'feeb-image-p (aref vision index))
211 (return t))))
212 :flame)
213 ((and (not (eq (left-square proximity) :rock))
214 (> 2 (random 10)))
215 :turn-left)
216 ((and (not (eq (right-square proximity) :rock))
217 (> 2 (random 10)))
218 :turn-right)
219 ((plusp (line-of-sight status))
220 :move-forward)
221 ((not (wallp (left-square proximity)))
222 :turn-left)
223 ((not (wallp (right-square proximity)))
224 :turn-right)
225 ((not (wallp (rear-square proximity)))
226 :turn-around))))
227
228 |#

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.5