[the-feebs-war-cvs] r10 -
gmilare at common-lisp.net
gmilare at common-lisp.net
Mon Dec 31 00:21:19 UTC 2007
Author: gmilare
Date: Sun Dec 30 19:21:19 2007
New Revision: 10
Modified:
main.lisp
mazes.lisp
Log:
Functions make-template, generate-maze added and tested.
Modified: main.lisp
==============================================================================
--- main.lisp (original)
+++ main.lisp Sun Dec 30 19:21:19 2007
@@ -196,7 +196,7 @@
(setf *feebs* nil)
(dolist (feeb-spec *feebs-to-be*)
(let ((pos (pop entries))))
- (apply 'create-feeb (car pos) (cdr pos) feeb-spec))))
+ (apply 'create-feeb (car pos) (cdr pos) feeb-spec)))))
@@ -231,16 +231,19 @@
(push carc ncarcasses)
(incf (first carc)))))
;; Move some fireballs:
- (dolist (fireball *fireballs-flying*)
- (move-object fireball (make-move-choice fireball)))
- (progn
- ;; Starve the feeb:
- (when (<= (decf (feeb-energy-reserve feeb)) 0)
- (destroy-object feeb :starve))
- ;; Compute vision for the feeb:
- (compute-vision feeb)
- ;; Collect the feeb's move
- (setf (feeb-peeking feeb) nil)
- (move-object feeb (setf (feeb-last-move feeb)
- (make-move-choice feeb)))))))
+ (dolist (fireball *fireballs-flying*)
+ (move-object fireball (make-move-choice fireball)))
+ (dolist (feeb *feebs*)
+ (unless (feeb-dead-p feeb)
+ ;; Starve the feeb:
+ (when (<= (decf (feeb-energy-reserve feeb)) 0)
+ (destroy-object feeb :starve))
+ ;; Compute vision for the feeb:
+ (compute-vision feeb)))
+ (dolist (feeb *feebs*)
+ (unless (feeb *feebs*)
+ ;; Collect the feeb's move
+ (setf (feeb-peeking feeb) nil)
+ (move-object feeb (setf (feeb-last-move feeb)
+ (make-move-choice feeb))))))
)
\ No newline at end of file
Modified: mazes.lisp
==============================================================================
--- mazes.lisp (original)
+++ mazes.lisp Sun Dec 30 19:21:19 2007
@@ -236,21 +236,32 @@
"\")"
"\""))))
-(defun density (maze)
- (loop for line in maze summing
- (float (/ (loop for elt across line counting
- (char/= #\X elt))
- (length line) (length maze)))))
-
-(defun bound-random (min avg max)
- (let ((sort (random 2.0)))
- (round
- (if (< sort 1.0)
- (+ min (* sort (- avg min)))
- (+ avg (* (1- sort) (- max avg)))))))
+(defun density (maze xs ys)
+ (let ((sum 0))
+ (dotimes (x xs)
+ (dotimes (y ys)
+ (if (not (aref maze x y))
+ (incf sum))))
+ (float (/ sum (* xs ys)))))
+
+(defun bound-random (start min avg max)
+ (+ start
+ (* (expt -1 (random 2))
+ (let ((sort (random 2.0)))
+ (round
+ (if (< sort 1.0)
+ (+ min (* sort (- avg min)))
+ (+ avg (* (1- sort) (- max avg)))))))))
+
+(defun random-elt (seq)
+ (if seq
+ (elt seq (random (length seq)))))
(defmacro ensure-bound (elt min max)
- `(setf ,elt (max ,min (min ,max ,elt))))
+ `(setf ,elt (bound ,elt ,min ,max)))
+
+(defun bound (elt min max)
+ (max min (min max elt)))
(defun horiz-corridor (map y x1 x2)
(do ((x x1 (if (< x1 x2) (1+ x) (1- x))))
@@ -270,11 +281,11 @@
(not (aref map (1- x) y)))) ; blank square to the left
(return)) ; can't make a blank square here, stop
(and (not (aref map x (1+ y))) ; blank square down
- (if (or (and (not (aref map (1+ x) y)) ; blank square to the right
- (not (aref map (1+ x) (1+ y)))) ; blank square down-right
- (and (not (aref map (1- x) (1+ y))) ; blank square down-left
- (not (aref map (1- x) y)))) ; blank square to the left
- (return))) ; can't make a blank square here, stop
+ (or (and (not (aref map (1+ x) y)) ; blank square to the right
+ (not (aref map (1+ x) (1+ y)))) ; blank square down-right
+ (and (not (aref map (1- x) (1+ y))) ; blank square down-left
+ (not (aref map (1- x) y)))) ; blank square to the left
+ (return)) ; can't make a blank square here, stop
(setf (aref map x y) nil))
map)
@@ -296,38 +307,77 @@
(setf (aref map x y) nil))
map)
+(defun translate (map xs ys)
+ (loop for y from (1- ys) downto 0 collect
+ (let ((str (make-string xs)))
+ (dotimes (x xs str)
+ (setf (aref str x)
+ (if (aref map x y)
+ #\X
+ #\Space))))))
+
+;;; This one generates a almost ready-to-use map
+
(defun generate-maze (x-size y-size
&key (density 0.4)
(corridor-x-min 1)
(corridor-x-max (- x-size 2))
- (corridor-x-avg (floor x-size 2))
+ (corridor-x-avg (floor x-size 4))
(corridor-y-min 1)
(corridor-y-max (- y-size 2))
- (corridor-y-avg (floor y-size 2)))
+ (corridor-y-avg (floor y-size 4)))
"Generates a maze of size X-SIZE x Y-SIZE (at least 10x10)
with no entry points and no mushroom sites.
DENSITY decides aproximatelly the ratio
(blank squares) / (total squares)
recomended to be between 0.25 and 0.45.
-The horizontal corridors will be between
-CORRIDOR-X-MIN and CORRIDOR-X-MAX with average CORRIDOR-X-AVG;
-similarly for vertical corridors."
- (if (or (< x 10) (< y 10))
+The horizontal corridors will be between CORRIDOR-X-MIN
+and CORRIDOR-X-MAX around CORRIDOR-X-AVG, when
+possible; similarly for vertical corridors."
+ (if (or (< x-size 10) (< y-size 10))
(error "Too small - should be at least 10x10."))
;; Certifying the values to be acceptable
- (ensure-bound density 0.1 0.5)
- (ensure-bound corridor-x-min 1 (- x-size 2))
- (ensure-bound corridor-x-avg 2 (- x-size 2))
- (ensure-bound corridor-x-max 3 (- x-size 2))
- (ensure-bound corridor-y-min 1 (- y-size 2))
- (ensure-bound corridor-y-avg 2 (- y-size 2))
- (ensure-bound corridor-y-max 3 (- y-size 2))
+ (ensure-bound corridor-x-avg
+ (ensure-bound corridor-x-min 1 (- x-size 2))
+ (ensure-bound corridor-x-max 3 (- x-size 2)))
+ (ensure-bound corridor-y-avg
+ (ensure-bound corridor-y-min 1 (- y-size 2))
+ (ensure-bound corridor-y-max 3 (- y-size 2)))
;; Beginning with an array of walls
(let ((map (make-array (list x-size y-size)
:initial-element t
:element-type 'boolean)))
- (do* ((y 1 (1+ (random (- y-size 1)))) ; position of horizontal corridor
- (x 1 (1+ (random (- x-size 1)))) ; position of vertical corridor
- (x1
- (setf map (horiz-corridor
- map 1 (1+ (random (- x-size 1)))
\ No newline at end of file
+ (do* ((i 1 (1+ i))
+ (y 1 y*) ; position of horizontal corridor
+ (y* (- y-size 2) (1+ (random (- y-size 2))))
+ (x1 (1+ (random (- x-size 2))) ; start position of horiz corridor
+ x1*)
+ (x1* (1+ (random (- x-size 2)))
+ (random-elt
+ (loop for x from 1 to (- x-size 2) ; any blank space
+ if (not (aref map x y)) collect x))) ; in line
+ (x2 (if x1 (bound-random x1 corridor-x-min
+ corridor-x-avg corridor-x-max))
+ (if x1 (bound-random x1 corridor-x-min
+ corridor-x-avg corridor-x-max)))
+ (x 1 x*) ; position of vertical corridor
+ (x* (- x-size 2) (1+ (random (- x-size 2))))
+ (y1 (1+ (random (- y-size 2)))
+ y1*)
+ (y1* (1+ (random (- y-size 2)))
+ (random-elt
+ (loop for y from 1 to (- y-size 2)
+ if (not (aref map x y)) collect y)))
+ (y2 (if y1 (bound-random y1 corridor-y-min
+ corridor-y-avg corridor-y-max))
+ (if y1 (bound-random y1 corridor-y-min
+ corridor-y-avg corridor-y-max))))
+ ((or (>= (density map x-size y-size) density)
+ (> i (* density x-size y-size))) ; quits after trying TOO MUCH
+ (translate map x-size y-size))
+ (if x1
+ (setf map (horiz-corridor map y x1
+ (bound x2 1 (- x-size 2)))))
+ (if y1
+ (setf map (vert-corridor map x y1
+ (bound y2 1 (- x-size 2))))))))
More information about the The-feebs-war-cvs
mailing list