;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CLISP Maze 20030311 by Joe Wingbermuehle
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; The width and height of the maze. Both must be odd.
(defconstant *width* 39)
(defconstant *height* 21)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Start carving the maze at a specific location.
(defun carve-maze (x y locations)
	(let ((c 0) (d (random 4)))
		(loop while (< c 5) do
			(setf (aref maze y x) 1)
			(cond
				((= d 0)
					(if (< (+ x 2) (- *width* 1))
						(cond
							((and (= (aref maze y (+ x 1)) 0)
							(= (aref maze y (+ x 2)) 0))
								(setf (aref maze y (+ x 1)) 1)
								(setq c 0)
								(setq x (+ x 2))))))
				((= d 1)
					(if (> (- x 2) 0)
						(cond
							((and (= (aref maze y (- x 1)) 0)
							(= (aref maze y (- x 2)) 0))
								(setf (aref maze y (- x 1)) 1)
								(setq c 0)
								(setq x (- x 2))))))
				((= d 2)
					(if (< (+ y 2) (- *height* 1))
						(cond
							((and (= (aref maze (+ y 1) x) 0)
							(= (aref maze (+ y 2) x) 0))
								(setf (aref maze (+ y 1) x) 1)
								(setq c 0)
								(setq y (+ y 2))))))
				(t
					(if (> (- y 2) 0)
						(cond
							((and (= (aref maze (- y 1) x) 0)
							(= (aref maze (- y 2) x) 0))
								(setf (aref maze (- y 1) x) 1)
								(setq c 0)
								(setq y (- y 2)))))))
			(cond
				((= c 0)
					(if (= (aref maze y x) 0)
						(setq locations (cons (list x y) locations)))
					(setf (aref maze y x) 1)
					(setq d (random 4))))
			(setq d (mod (+ d 1) 4))
			(setq c (+ c 1)))
			locations))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Generate a maze
(defun generate-maze ()
	(let (x y locations)
		(setq *random-state* (make-random-state t))
		(dotimes (y *height*)
			(setf (aref maze y 0) 1)
			(setf (aref maze y (- *width* 1)) 1))
		(dotimes (x *width*)
			(setf (aref maze 0 x) 1)
			(setf (aref maze (- *height* 1) x) 1))
		(setq y 2)
		(setq locations (list (list 2 2)))
		(loop while (not (null locations)) do
			(setq x (caar locations))
			(setq y (cadar locations))
			(setq locations (cdr locations))
			(setq locations (carve-maze x y locations)))
		(setf (aref maze 1 2) 1)
		(setf (aref maze (- *height* 2) (- *width* 3)) 1)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Display the maze
(defun display-maze ()
	(let (x y)
		(dotimes (y *height*)
			(dotimes (x *width*)
				(if (= (aref maze y x) 0)
					(princ "[]")
					(princ "  ")))
			(terpri))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Create and display the maze.
(princ "CLISP Maze 20030311 by Joe Wingbermuehle") 
(setq maze (make-array (list *height* *width*) :initial-element 0))
(generate-maze)
(display-maze)