;;; -*- Common Lisp -*-

#|  Copyright (c) 2007,2008 Gustavo Henrique Milar�

    This file is part of The Feebs War.

    The Feebs War is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 3 of the License, or
    (at your option) any later version.

    The Feebs War is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with The Feebs War.  If not, see <http://www.gnu.org/licenses/>.
|#

;;; The mazes were
;;; Created by Jim Healy, July 1987.
;;;
;;; **************************************************
;;;  Maze guidelines:
;;;    X represents a wall.
;;;    * represents a mushroom patch.
;;;    e is a feeb entry point.
;;;
;;;  The maze should be a rectangle bounded by walls
;;;  in each side.
;;;  These mazes are all 32x32, but you may build
;;;  a maze of any size you wish.
;;; **************************************************

;;; Maze1 has a good number of dead ends and little nooks.

(in-package :the-feebs-war)

(defparameter *maze-1*
  '("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    "XXX     *eXXXX      *e      ** X"
    "XXX XXXXX XXXX XXXXXXXXXXXX XX X"
    "XXX   XXX      XXXXXX       X  X"
    "XXXXX XXXXXXX XXXXXXX XXXXXXX XX"
    "X *       XXX XX *    XeXX    XX"
    "X XXXXXXX XXX XXXXXXX X XXX XXXX"
    "X  XXXXXX XXX XX      X      *XX"
    "X XXXXXXX XXX XXXXXXX XXXXXXXXXX"
    "X XXXXXXX XXX*     e  XXXXXX XXX"
    "X         XXXXX XXXXXXXXX  * XXX"
    "X XXXXX XXXXXX     XXXXXX XX  XX"
    "X eXXXX XXXXXX XXX  XXXXX XX XXX"
    "X XXXXX*       XXXXe XXXX XX  XX"
    "X XXXXX XXXXXX XXXXX  XXX XXX XX"
    "X eXXXX    e   XXXXXX *XX XX  XX"
    "X XXXXX XXXXXX XXXXXXX  X XXeXXX"
    "X   XXX        XXXXXXXX   XX  XX"
    "X XXXXX XXXXXX XXXXXXXXXX XXXXXX"
    "X XXXXX      * XXXXX          XX"
    "X*  XXX XXXXXX XXXXX XXXXXX X XX"
    "X XXXXX e      XXXXX X  e   X XX"
    "X XX XX XXXXXX XXXXX X XXXXXX XX"
    "X         *XXX XXXXX       *  XX"
    "X XX XX XXXXXX XXXXXXXXXX XXXXXX"
    "X XXXXX XXXXXX   *   *        XX"
    "X   XXX XXXXXXXXXXXXXXXXXXXXX XX"
    "X XXXX    X    X   eX    X    XX"
    "X  XXX XX X XX X XX X XX X XX XX"
    "X XXXX XX X XX X XX X XX*X XX XX"
    "X e *  XX   XX * XX   XX   XXeXX"
    "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"))

;;; Maze2 doesn't have any really long corridors.

(defparameter *maze-2*
  '("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    "X  eXXXXX * X   XXXXXX X e XXXXX"
    "X XXXX    X X XXXX   X   X XXXXX"
    "X  XX  XXXX   XXXX X*  X X XXXXX"
    "XX XX XXX   XXXX   XX XX X     X"
    "XX e  XXX XXXXXXX XX  XXXXXXXX*X"
    "XXXX XXX    XXXXX X e XXX   XX X"
    "XXXX XXX XXXXXXXX   XXXX  X    X"
    "XX * XX   XXe  XXXXXXXXXX XX XXX"
    "XX XXXX X XX X   XXX XXXXX   XXX"
    "XX        XX XXX X   XX    XXXXX"
    "XXXXX XXX   *XXX   X    XXXXXXXX"
    "XX*   XXXXXX  XXXX XXXX XXXXXXXX"
    "XXXXX XX XXXX XXXXXXXXX XXXXXXXX"
    "XXXXX  e XXXX   *XXXXXX   eXXXXX"
    "XXXXXXXX XXXXXXX XXXXXXXXX XXXXX"
    "XXXXXX     XXXXX  eXXXXX   XXXXX"
    "XXXXXX XXX XXXXXXX XXXXX XXXXXXX"
    "XX     XXX X   XXX XX    X    XX"
    "XX XXX   XXXXX XX   XX XXX XX XX"
    "XX XXXXX  *X   XX X XX XXXXXX*XX"
    "X    XXXXX   XXXX X      XX   XX"
    "X XX XXXXXXX   XXXXX*X X Xe XXXX"
    "X    XXXX  e X XXXXX*XX  XX XXXX"
    "X XX XXXXXX XX   XXX*XXX     XXX"
    "XXXX  eXXX  XXXX XX  XXXXX X   X"
    "XXXXXX XXXXXXXXX XX XXXX   XXX X"
    "XXX *  X X    XX    XXXX XXX X X"
    "XX  XXXX X XX XXXX XXX   X  e  X"
    "XX XX  *   X *   X XXXX XX XXX*X"
    "XX    XXX XXX XX  eXXX     XXX*X"
    "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"))

;;; Maze3 has the minimum number of mushroom sites, most
;;; of which are between a rock and a hard place.  Those
;;; poor feebs!

(defparameter *maze-3*
  '("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    "X    e  XXXXXX XXXXXXX*XXXXXXXXX"
    "X X XXX XXXXX e   XXXX XXX e   X"
    "X   XXX XXXXXX XX XX   XXX XXX X"
    "XXX XXX XXXXXX XX XX X X   e   X"
    "Xe  XXX*XXXX*  XX XXeX X XXXXX X"
    "X X XXX XXXXXX XX XX X   XXXXX X"
    "X   XXX XXXXXX XX*   XXXXXXXXX X"
    "X XXXXX XX e   XX XXXXXXXX XXX X"
    "X X XXX XXX XXXXX XXXXXX   XXX X"
    "Xe  XXX      XXXX XXXX   X X   X"
    "XXX XXXX XXXXXXXX  X   XXX   XXX"
    "XXX  eXX XXXXXXXXX   XXXXX XXXXX"
    "XXXXX XXXXXXXXXXXX XXXXXX    XXX"
    "XXXXX     *    XX eXX XXX XX XXX"
    "XX*XXXX XXXXXX XX XXX XXX XX XXX"
    "XX X    XXXXX  X  XXX    eXX XXX"
    "X    XXXXXXXX XX XXXX XXX XX XXX"
    "X XXXXeXXXXXX    XXXX XXX XX XXX"
    "X      XX*XXXXX XXXXXXXXX    XXX"
    "XXXXXX    XXX   XXXX  XXXXXX XXX"
    "XXXXXXXXX XXX XXXXXX XXXXXX  XXX"
    "XXX       XX  e          eX XXXX"
    "XX  XXXXX    XXXX XXXX XXXX XXXX"
    "XX XXXXX  XX XXXX XXXX XXXX   XX"
    "XX eXXXX XX  XXXX XXXX XXXXXX XX"
    "XXX XX   XXX     *        XXX XX"
    "XX  XX XXXX* XXXX XXXX XXXXXX XX"
    "XXX  X XXXXX XXXX XXXX X      XX"
    "XXXX    e    XXXX XXXX X XX X  X"
    "XXXXXXXXXXXX     *e       X e XX"
    "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"))


;;; Maze4 is symmetric about the vertical axis.  (Wow...)

(defparameter *maze-4*
  '("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    "X*        eXXXXXXXXXXe        *X"
    "X XXXXXXXX            XXXXXXXX X"
    "X XX   XXXXXXX XX XXXXXXX   XX X"
    "X    XeXXXXXXX XX XXXXXXXeX    X"
    "XX X XXXXXXX  eXXe  XXXXXXX X XX"
    "XX X XXXXXXX XXXXXX XXXXXXX X XX"
    "XX * XXXXXXX XXXXXX XXXXXXX * XX"
    "XX X XXXe              eXXX X XX"
    "XX X XXX XXXXXXXXXXXXXX XXX X XX"
    "XX e XXX    XXXXXXXX    XXX e XX"
    "XX X XXXXXX XXXXXXXX XXXXXX X XX"
    "XX X XXXX   XXXXXXXX   XXXX X XX"
    "XX   XXXX XXXe   eXXXX XXXX   XX"
    "XXX XXXXX XXX XXX XXXX XXXXX XXX"
    "XXX XXXXX XXX      XXX XXXXX XXX"
    "X*  XXXXX     XXXX     XXXXX  *X"
    "X XXXXX XX XX  **  XX XX XXXXX X"
    "X XXXXX XX XX XXXX XX XX XXXXX X"
    "X XXX e XX XX XXXX XX XX e XXX X"
    "X XXXXX XX    XXXX    XX XXXXX X"
    "X XXXXX XXXXX XXXX XXXXX XXXXX X"
    "X     X XXXXX XXXX XXXXX X     X"
    "XXXXX  *                *  XXXXX"
    "XXXXX XXXXXXXX XX XXXXXXXX XXXXX"
    "XXXXX XXXXXXXX XX XXXXXXXX XXXXX"
    "XXXXX    XXXXX XX XXXXX    XXXXX"
    "XXXX  XX  XXXXeXXeXXXX  XX  XXXX"
    "XXX  XXXX  XXX XX XXX  XXXX  XXX"
    "XXX XXXXXX XXX XX XXX XXXXXX XXX"
    "XX*       e    XX    e       *XX"
    "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"))

;;; Maze5 has a lot of long corridors good for feeb showdowns.
;;; Furthermore, all the feeb entry-points are in the corridors.
;;; You can run but you can't hide!

(defparameter *maze-5*
  '("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
    "X              e           e   X"
    "X XXXXXXX*XXXXXXXXXXXX XXXXXXX X"
    "X               e              X"
    "X X XXXXX XXXXXXXXXXXX XXXXX X X"
    "X              *               X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX XXXXXXXXXXXX XXeXX X X"
    "X X XX XX    *         XX XX X X"
    "XeX XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX          e   XX XXeX X"
    "X X XXeXX XXXXXXXXXXXX XX XX X X"
    "X X XX XX XXXXXXXXXXXX XX XX XeX"
    "X*X XX XX              XX XX X X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X XeXX XX XXXXXXXXXXXX*XX XX X X"
    "X X XX XX  *           XX XX*X X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX  e           XX XX*X X"
    "X X XX*XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX              XX XXeX X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X X XX XX XXXXXXXXXXXX XX XX X X"
    "X             e                X"
    "X*X XXXXX XXXXXXXXXXXX XXXXX X*X"
    "X             e       *        X"
    "X XXXXXXX XXXXXXXXXXXX XXXXXXX X"
    "X     e        *               X"
    "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"))

;;; Use this function to create new mazes
;;; of any size.

(defun make-template (x-size y-size)
  "Prints map template of the requested size.
Use this to create new mazes."
  (loop repeat y-size collect
	(make-string x-size :initial-element #\X)))

(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 horiz-corridor (map y x1 x2)
  (do ((x x1 (if (< x1 x2) (1+ x) (1- x))))
      ((= x x2))
    ;; we need to guarantee that everything in map is
    ;; corridors, that is, can't have something like
    ;; XXXXXXXX
    ;; XXX    X
    ;; X    XXX
    ;; XXXXXXXX
    ;; that big blank square isn't good due
    ;; to the limited vision of the feebs
    (and (not (aref map x (1- y))) ; blank square up
	 (or (and (not (aref map (1+ x) y)) ; blank square to the right
		  (not (aref map (1+ x) (1- y)))) ; blank square up-right
	     (and (not (aref map (1- x) (1- y))) ; blank square up-left
		  (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
	 (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)

(defun vert-corridor (map x y1 y2)
  (do ((y y1 (if (< y1 y2) (1+ y) (1- y))))
      ((= y y2))
    (and (not (aref map (1- x) y))
	 (or (and (not (aref map x (1+ y)))
		  (not (aref map (1- x) (1+ y))))
	     (and (not (aref map (1- x) (1- y)))
		  (not (aref map x (1- y)))))
	 (return))
    (and (not (aref map (1+ x) y))
	 (if (or (and (not (aref map x (1+ y)))
		      (not (aref map (1+ x) (1+ y))))
		 (and (not (aref map (1+ x) (1- y)))
		      (not (aref map x (1- y)))))
	     (return)))
    (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 an 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 4))
		      (corridor-y-min 1)
		      (corridor-y-max (- 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 around CORRIDOR-X-AVG, when
possible; similarly for vertical corridors.
It returns two values, a layout like *maze-0* and its density."
  (if (or (< x-size 10) (< y-size 10))
      (error "Too small - should be at least 10x10."))
  ;; Certifying the values to be acceptable
  (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* ((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)))
	  (real-dens (density map x-size y-size)))
	((or (>= real-dens density)
	     (> i (* density x-size y-size))) ; quits after trying TOO MUCH
	 (values (translate map x-size y-size) real-dens))
      (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))))))))