maze.lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Common Lisp Maze 20030311 by Joe Wingbermuehle
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; https://github.com/joewing/maze/blob/master/maze.lisp

; Changes Rainer Joswig, joswig@lisp.de, 2018

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Interface: the width and height of the maze. Both must be odd.

(defparameter *maze-width*  39 "The width of the maze. Must be odd.")
(defparameter *maze-height* 21 "The height of the maze. Must be odd.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Implementation of the maze

(defun make-maze (width height)
  "Make the maze array given width and height. Both values must be odd. Returns an array."
  (assert (and (oddp width) (oddp height))
      (width height)
    "Width ~a and height ~a must both be odd." width height)
  (make-array (list width height) :initial-element 1))

(defun carve-maze (maze x y &optional (width (array-dimension maze 0)) (height (array-dimension maze 1)))
  "Start carving the maze at a specific location."
  (declare (type array maze)
           (fixnum x y))
  (let ((d (random 4)))
    (dotimes (c 4)
      (let ((cd (mod (+ c d) 4)))
        (multiple-value-bind (dvx dvy)
            (case cd
              (0 (values  1  0))
              (1 (values  0  1))
              (2 (values -1  0))
              (t (values  0 -1)))
          (let* ((x1 (+  x dvx))
                 (y1 (+  y dvy))
                 (x2 (+ x1 dvx))
                 (y2 (+ y1 dvy)))
            (when (and (< 0 x2 width)
                       (< 0 y2 height))
              (when (= 1 (aref maze x1 y1) (aref maze x2 y2))
                (setf (aref maze x1 y1) 0
                      (aref maze x2 y2) 0)
                (carve-maze maze x2 y2 width height))))))))
  maze)

(defun generate-maze (maze &optional (width (array-dimension maze 0)) (height (array-dimension maze 1)))
  (setq *random-state* (make-random-state t))
  (setf (aref maze 1 1) 0)
  (carve-maze maze 1 1)
  (setf (aref maze 1 0) 0)
  (setf (aref maze (- width 1) (- height 2)) 0)
  maze)

(defun display-maze (maze)
  (dotimes (y (array-dimension maze 1))
    (dotimes (x (array-dimension maze 0))
      (princ (if (= (aref maze x y) 1) "[]" "  ")))
    (terpri))
  maze)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Example

(defun example (&optional (width *maze-width*) (height *maze-height*))
  "Create and display the maze."
  (display-maze
   (generate-maze
    (make-maze width height)))
  (values))

; (example)