yumaikas / funnyMaze.scm

(use ncurses posix extras posix-extras loops) (define mazeData (vector "OOOOOOOOOOOOOOO" "O O O OOO O OO" "O O" "O O OOOOOOO O O" "O O O O O" "O OOO OO OOOO" "O O O O" "OO O O O OOO OO" "OO O O O" "OOOOOOOOOOOOOOO")) ; Get the character at the given maze location. (define (mazeAt y x) (string-ref (vector-ref mazeData y) x)) (define (setMazeAt y x v) (string-set! (vector-ref mazeData y) x v)) (define (randomaze) (do-for i (1 9) (do-for j (1 14) (setMazeAt i j (if (zero? (random 3)) #\O #\space)))) (setMazeAt 8 13 #\space)) ; Print a stack at a given location (define (printStack x y stack) (do-for i (0 (+ -1 (vector-length stack)) ) (mvaddstr (+ y i) x (vector-ref stack i))) (mvaddstr (+ y (vector-length stack)) x " ")) (define (save x y) (setMazeAt x y #\*)) (define (printMaze x y xStack yStack) (do-for i (0 10) (do-for j (0 15) (mvaddch (+ i y) (+ j x) (mazeAt i j)))) (mvaddch 0 40 #\y) (mvaddch 0 50 #\x); Print the start of the x and y stack columns ; TODO: This may need to be cleaned up for perf at some point. ; (printStack 40 1 (list->vector (map number->string xStack))) ;(printStack 50 1 (list->vector (map number->string yStack))) (mvaddstr 0 0 "Randomaze") (mvaddstr 18 0 "Ctrl + C to Quit") (sleep .1) (refresh)) ; Run the maze, starting with a pair of vectors (define (runMaze) (let loop ( (x 1) (y 1) (xStack (list -1)) (yStack (list -1))) (randomaze) (cond [(not (or (and (= x 8) (= y 13)) (and (= x -1) (= y -1)))) (cond [(eq? (mazeAt x (+ y 1)) #\space) ; Right (save x y) (set! y (+ y 1)) (printMaze 1 1 xStack yStack) (loop x y (append '(x) xStack) (append '(y) yStack))] [(eq? (mazeAt (+ x 1) y) #\space); Down (save x y ) (set! x (+ x 1)) (printMaze 1 1 xStack yStack) (loop x y (append '(x) xStack) (append '(y) yStack))] [(eq? (mazeAt x (- y 1)) #\space); Left (save x y ) (set! y (- y 1)) (printMaze 1 1 xStack yStack) (loop x y (append '(x) xStack) (append '(y) yStack))] [(eq? (mazeAt (- x 1) y) #\space); Up (save x y ) (set! x (- x 1)) (printMaze 1 1 xStack yStack) (loop x y (append '(x) xStack) (append '(y) yStack))] [else ; Backtrack (setMazeAt x y #\D) (printMaze 1 1 xStack yStack) (loop (car xStack) (car yStack) (cdr xStack) (cdr yStack)) ])] [else (printMaze 1 1 xStack yStack) (sleep .1) (mvaddstr 12 2 (if (and (= x 8) (= y 13)) "Solved maze" "No solution for maze")) (printMaze 1 1 xStack yStack) (void)]))) (define (mainLoop) (runMaze) (erase) (sleep 1)) (define (start) (initscr) (nonl) (noecho) (randomize) (do-forever (mainLoop)) (endwin)) ;;; Run main, handling exceptions so that the terminal doesn't get ;;; wedged in a crazy state. (define (main) (set-signal-handler! signal/int (lambda (nothing) (endwin) (exit))) (condition-case (start) [err (exn) (begin (endwin) (signal err))] [() (endwin)])) (main)