RosettaCodeData/Task/Maze-generation/TXR/maze-generation-1.txr
2019-09-12 10:33:56 -07:00

55 lines
1.4 KiB
Text

@(bind (width height) (15 15))
@(do
(defvar *r* (make-random-state nil))
(defvar vi)
(defvar pa)
(defun neigh (loc)
(let ((x (from loc))
(y (to loc)))
(list (- x 1)..y (+ x 1)..y
x..(- y 1) x..(+ y 1))))
(defun make-maze-rec (cu)
(set [vi cu] t)
(each ((ne (shuffle (neigh cu))))
(cond ((not [vi ne])
(push ne [pa cu])
(push cu [pa ne])
(make-maze-rec ne)))))
(defun make-maze (w h)
(let ((vi (hash :equal-based))
(pa (hash :equal-based)))
(each ((x (range -1 w)))
(set [vi x..-1] t)
(set [vi x..h] t))
(each ((y (range* 0 h)))
(set [vi -1..y] t)
(set [vi w..y] t))
(make-maze-rec 0..0)
pa))
(defun print-tops (pa w j)
(each ((i (range* 0 w)))
(if (memqual i..(- j 1) [pa i..j])
(put-string "+ ")
(put-string "+----")))
(put-line "+"))
(defun print-sides (pa w j)
(let ((str ""))
(each ((i (range* 0 w)))
(if (memqual (- i 1)..j [pa i..j])
(set str `@str `)
(set str `@str| `)))
(put-line `@str|\n@str|`)))
(defun print-maze (pa w h)
(each ((j (range* 0 h)))
(print-tops pa w j)
(print-sides pa w j))
(print-tops pa w h)))
@;;
@(bind m @(make-maze width height))
@(do (print-maze m width height))