; Connor Braa, Nikita Kouevda
; 2012/04/26
;;; Title:
;;; Maze Generator
;;;
;;; Description:
;;; Three hundred scheme words,
;;; Three hundred parentheses,
;;; All for some mazes.
;;; Helper functions
;; Returns L with all instances of item removed
(define (delete L item)
(if (null? L)
L
(append
; Skip this element by appending '() if it matches item
(if (equal? (car L) item)
'()
(list (car L))
)
; Recursively delete item from the rest of L
(delete (cdr L) item)
)
)
)
;; Draws a square at (x, y) with sidelength s
(define (square x y s)
; Position the turtle and point it up
(setposition x y)
(setheading 0)
; Draw a square of sidelength s
(begin_fill)
(forward s)
(right 90)
(forward s)
(right 90)
(forward s)
(end_fill)
)
;;; Main functions
;; Generates a maze using Prim's algorithm for minimum spanning trees (Kruskal's would be more random, but the recursion depth limit would be reached at much smaller sizes)
(define (generate-maze cells walls total-size cell-size seed)
; Continue unless no walls left
(cond
((not (null? walls))
; Pick a random wall from walls by taking the (seed % length)th wall
(define wall (car (list-tail walls (modulo seed (length walls)))))
; Determine the cells that the chosen wall joins
(if (zero? (modulo (car wall) 2))
(begin
(define first (list (- (car wall) 1) (cadr wall)))
(define second (list (+ (car wall) 1) (cadr wall)))
)
(begin
(define first (list (car wall) (- (cadr wall) 1)))
(define second (list (car wall) (+ (cadr wall) 1)))
)
)
(if
(or
(and (member first cells) (member second cells))
(zero? (car wall))
(zero? (cadr wall))
(= (car wall) (- total-size 1))
(= (cadr wall) (- total-size 1))
)
; Remove this wall if both cells are in the maze, and continue recursively
(generate-maze cells (delete walls wall) total-size cell-size seed)
; Add this wall and the new cell to the maze
(begin
; Determine the cell that is not yet in the maze (guaranteed to be exactly one)
(define cell (if (member first cells) second first))
; Draw the squares for the wall and the cell
(square (* (car wall) cell-size) (* (cadr wall) cell-size) cell-size)
(square (* (car cell) cell-size) (* (cadr cell) cell-size) cell-size)
; Recursively generate, adding to cells and walls accordingly
(generate-maze
(cons cell cells)
(delete
(append
walls
(list
(list (- (car cell) 1) (cadr cell))
(list (+ (car cell) 1) (cadr cell))
(list (car cell) (- (cadr cell) 1))
(list (car cell) (+ (cadr cell) 1))
)
)
wall
)
total-size
cell-size
seed
)
)
)
)
)
)
;; Creates a maze of the given grid-size (must be positive) with cells and walls of thickness cell-size (must be positive) using the given random seed (must be positive; use relatively large primes for best results)
(define (maze grid-size cell-size seed bg-color fg-color)
; Define the total size to be (2n+1) of the grid-size in order to account for walls
(define total-size (+ (* grid-size 2) 1))
; Clear, hide the turtle, lift the pen, and set maximum speed
(clear)
(hideturtle)
(penup)
(speed 0)
; Draw the background
(color bg-color)
(square 0 0 (* total-size cell-size))
; Switch to the foreground color and draw the first square
(color fg-color)
(square cell-size cell-size cell-size)
; Generate the maze
(generate-maze
'((1 1))
(list (list 1 2) (list 2 1))
total-size
cell-size
seed
)
; Draw the entrance and exit at random locations on opposite sides
(square
0
(* (+ (* 2 (- grid-size (modulo seed grid-size))) 1) cell-size)
cell-size
)
(square
(* (- total-size 1) cell-size)
(* (+ (* 2 (- grid-size (modulo (* seed seed) grid-size))) 1) cell-size)
cell-size
)
; Wait for click to exit
;(exitonclick)
)
;;; Begin here
; Draw a full maze with default arguments
(maze
; 15x15 grid, 31x31 total
15
; 10 px thick cells and walls
10
; Random prime seed
478189
; Blue background, gold foreground
'blue
'|#ffd700|
)