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