Revision of funnyMaze.scm

yumaikas revised this gist 1735792357. Go to revision

1 file changed, 109 insertions

funnyMaze.scm(file created)

		@@ -0,0 +1,109 @@
1	+	(use ncurses posix extras posix-extras loops)
2	+	(define mazeData
3	+	(vector "OOOOOOOOOOOOOOO"
4	+	"O O O OOO O OO"
5	+	"O O"
6	+	"O O OOOOOOO O O"
7	+	"O O O O O"
8	+	"O OOO OO OOOO"
9	+	"O O O O"
10	+	"OO O O O OOO OO"
11	+	"OO O O O"
12	+	"OOOOOOOOOOOOOOO"))
13	+	; Get the character at the given maze location.
14	+	(define (mazeAt y x)
15	+	(string-ref (vector-ref mazeData y) x))
16	+
17	+	(define (setMazeAt y x v)
18	+	(string-set! (vector-ref mazeData y) x v))
19	+
20	+	(define (randomaze)
21	+	(do-for i (1 9)
22	+	(do-for j (1 14)
23	+	(setMazeAt i j (if (zero? (random 3)) #\O #\space))))
24	+	(setMazeAt 8 13 #\space))
25	+
26	+	; Print a stack at a given location
27	+	(define (printStack x y stack)
28	+	(do-for i (0 (+ -1 (vector-length stack)) )
29	+	(mvaddstr (+ y i) x (vector-ref stack i)))
30	+	(mvaddstr (+ y (vector-length stack)) x " "))
31	+
32	+	(define (save x y) (setMazeAt x y #\*))
33	+
34	+	(define (printMaze x y xStack yStack)
35	+	(do-for i (0 10)
36	+	(do-for j (0 15)
37	+	(mvaddch (+ i y) (+ j x) (mazeAt i j))))
38	+	(mvaddch 0 40 #\y)
39	+	(mvaddch 0 50 #\x); Print the start of the x and y stack columns
40	+	; TODO: This may need to be cleaned up for perf at some point.
41	+	; (printStack 40 1 (list->vector (map number->string xStack)))
42	+	;(printStack 50 1 (list->vector (map number->string yStack)))
43	+	(mvaddstr 0 0 "Randomaze")
44	+	(mvaddstr 18 0 "Ctrl + C to Quit")
45	+	(sleep .1) (refresh))
46	+	; Run the maze, starting with a pair of vectors
47	+	(define (runMaze)
48	+	(let loop (
49	+	(x 1) (y 1)
50	+	(xStack (list -1))
51	+	(yStack (list -1)))
52	+	(randomaze)
53	+	(cond [(not (or (and (= x 8) (= y 13)) (and (= x -1) (= y -1))))
54	+	(cond
55	+	[(eq? (mazeAt x (+ y 1)) #\space) ; Right
56	+	(save x y)
57	+	(set! y (+ y 1))
58	+	(printMaze 1 1 xStack yStack)
59	+	(loop x y (append '(x) xStack) (append '(y) yStack))]
60	+	[(eq? (mazeAt (+ x 1) y) #\space); Down
61	+	(save x y )
62	+	(set! x (+ x 1))
63	+	(printMaze 1 1 xStack yStack)
64	+	(loop x y (append '(x) xStack) (append '(y) yStack))]
65	+	[(eq? (mazeAt x (- y 1)) #\space); Left
66	+	(save x y )
67	+	(set! y (- y 1))
68	+	(printMaze 1 1 xStack yStack)
69	+	(loop x y (append '(x) xStack) (append '(y) yStack))]
70	+	[(eq? (mazeAt (- x 1) y) #\space); Up
71	+	(save x y )
72	+	(set! x (- x 1))
73	+	(printMaze 1 1 xStack yStack)
74	+	(loop x y (append '(x) xStack) (append '(y) yStack))]
75	+	[else ; Backtrack
76	+	(setMazeAt x y #\D)
77	+	(printMaze 1 1 xStack yStack)
78	+	(loop (car xStack) (car yStack)
79	+	(cdr xStack) (cdr yStack))
80	+	])]
81	+	[else
82	+	(printMaze 1 1 xStack yStack)
83	+	(sleep .1)
84	+	(mvaddstr 12 2 (if (and (= x 8) (= y 13))
85	+	"Solved maze"
86	+	"No solution for maze"))
87	+	(printMaze 1 1 xStack yStack)
88	+	(void)])))
89	+	(define (mainLoop)
90	+	(runMaze)
91	+	(erase)
92	+	(sleep 1))
93	+	(define (start)
94	+	(initscr)
95	+	(nonl)
96	+	(noecho)
97	+	(randomize)
98	+	(do-forever (mainLoop))
99	+	(endwin))
100	+
101	+
102	+	;;; Run main, handling exceptions so that the terminal doesn't get
103	+	;;; wedged in a crazy state.
104	+	(define (main)
105	+	(set-signal-handler! signal/int (lambda (nothing) (endwin) (exit)))
106	+	(condition-case (start)
107	+	[err (exn) (begin (endwin) (signal err))]
108	+	[() (endwin)]))
109	+	(main)

Newer Older