Ray Casting in Scheme
Post by: Snarky on February 23rd, 2010 | Filed Under Games, Programming, SchemeMy last post was about getting started picking up Scheme again for use in the 7 Day Roguelike contest. Of note I mentioned that I had decided on using Gambit as I could nicely tie Scheme and C libraries together, which I wanted so that I could use ncurses to do all my terminal control (output and reading user input).
I got ncurses working, and managed to get a simple little walk around demo going. However I wanted something a bit deeper than just having the entire map visible from the start, so I poked back at some test code Harkins wrote last year for Ruby (when I had aspirations of learning another language), and read up on Rogue Basin for various examples. In the end I stole Harkin's map, and went with the pseudo code Elig created here.
Without further ado, the code busted apart into a few sections. (Full version can be found here).
;;Scheme ray casting/FOV demo ;;Adapted from pseudo code found at ;;http://roguebasin.roguelikedevelopment.org/index.php?title=Eligloscode ;;Prep work for 7DLR 2010 (to brush back up on my Scheme) ;;Global defines (define char-x 1) ;;x coordinate for the fake character (define char-y 1) ;;y coordinate for the fake character (define VIEW-RADIUS 3) ;;View radius for FOV demo ;;List of tiles we don't want to walk through (Walls and water) (define IMPASSABLE-TILES (list #\# #\~)) ;;List of tiles that will break the ray casting (walls) (define OPAQUE-TILES (list #\#)) (define test-env (list "###################" "#...#.............#" "#...#...#~~~~~....#" "#.......#~~~~~....#" "###################"))
First I set up some variables to work with.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Functions to create the environment;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Function to create our working environment given an array of strings such as test-env (define create-env (lambda (env) (if (null? env) '() (cons (create-env-row (string->list (car env))) (create-env (cdr env)))))) ;;Function that helps create-env by creating a given row (define create-env-row (lambda (env-row) (if (null? env-row) '() (cons (create-env-cell (car env-row)) (create-env-row (cdr env-row)))))) ;;Function to create a given env cell, helps create-env-row (define create-env-cell (lambda (env-cell) (list env-cell #f)))
Next I define some functions to get a map (which is really a list of strings) to something we can work with (nested lists that act like a two dimensional array).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Functions to display the environment;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Function to write the env (define write-env (lambda (env) (write-env-help env 0 0))) ;;Function that does the brunt of the env write (define write-env-help (lambda (env x y) (if (null? env) (newline) (begin (write-env-row (car env) x y) (write-env-help (cdr env) x (+ y 1)))))) ;;Function that writes a given row of the env (define write-env-row (lambda (env-row x y) (if (null? env-row) (newline) (begin (write-env-cell (car env-row) x y) (write-env-row (cdr env-row) (+ x 1) y))))) ;;Function that writes out a given cell of the env (define write-env-cell (lambda (env-cell x y) (let ((char (car env-cell)) ;;The symbol we'll possibly display ;;The boolean bit of the env cell that holds if its visible or not (visible (cadr env-cell))) (if visible ;;If this cell was marked to be seen (if (and (= x char-x) (= y char-y)) ;;Check if its where the character is (print "@") ;;If so, lets show an @ symbol (print char)) ;;Else show whatever character should be displayed (print " ")) ;;If this cell wasn't marked to be shown, just put a space (print " ")))) ;;Put a space after it for pretty printing
Naturally you need some way to nicely see what's going on in your environment. That's what these functions do.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Functions for the FOV demo;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Function to update the FOV as a whole (define update-fov (lambda (env char-x char-y) (update-fov-help env char-x char-y 0 0))) ;;Function that does the actual work of updating the FOV (define update-fov-help (lambda (env char-x char-y x y) (if (not (null? env)) (begin (update-fov-row (car env) char-x char-y x y) (update-fov-help (cdr env) char-x char-y x (+ y 1)))))) ;;Function that updates the FOV for a given row (define update-fov-row (lambda (env-row char-x char-y x y) (if (not (null? env-row)) (begin (update-fov-cell (car env-row) char-x char-y x y) (update-fov-row (cdr env-row) char-x char-y (+ x 1) y))))) ;;Function that does the real work to update a given cell's FOV (define update-fov-cell (lambda (env-cell char-x char-y x y) (set-cell-visible env-cell #f) ;;Set visible to false (let* ((dx (- x char-x)) (dy (- y char-y)) ;;Get the distance between the character and the cell (distance (sqrt (+ (* dx dx) (* dy dy))))) (if (< distance VIEW-RADIUS) ;;If we're within out viewing radius (set-cell-visible env-cell #t))))) ;;set the cell to be shown
Finally we get to the good stuff. This code is for the Field of View demo, which just shows everything within the sight radius. What it does, basically, is loops through every cell on the map, sets it to invisible (aka sets the cdr of the env-cell to be #f), and then checks to see how far from the player it is. If its within our view-radius, it then flips the visibility to true. Slow for big maps, but simple to implement.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Function for the Ray casting demo;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Function to clear the entire env (define clear-cells (lambda (env) (if (not (null? env)) (begin (clear-cells-row (car env)) (clear-cells (cdr env)))))) ;;Function that clears a row of the env (define clear-cells-row (lambda (env-row) (if (not (null? env-row)) (begin (clear-cells-cell (car env-row)) (clear-cells-row (cdr env-row)))))) ;;Function to clear a cell in the env (define clear-cells-cell (lambda (env-cell) (set-cell-visible env-cell #f))) ;;Function to do the ray-cast (define cast-rays (lambda (env char-x char-y) (clear-cells env) ;;Clear everything first (cast-rays-help env char-x char-y 0))) ;;Function to do the real work of casting some rays (define cast-rays-help (lambda (env char-x char-y i) (if (<= i 360) (let ((x (cos (* i 0.01745))) (y (sin (* i 0.01745)))) (trace-ray env char-x char-y x y (+ char-x .0) (+ char-y .0) 0) (cast-rays-help env char-x char-y (+ i 16)))))) ;;Function to trace the specific ray to its end (define trace-ray (lambda (env char-x char-y x y dx dy i) (if (not (> i VIEW-RADIUS)) (let* ((cell-x (round dx)) (cell-y (round dy)) (cell (get-cell env cell-x cell-y))) (if cell (begin (set-cell-visible cell #t) (if (cell-opaque? cell) (trace-ray env char-x char-y x y (+ dx x) (+ dy y) (+ i 1)))))))))
The first three functions simply clear all the cells on the map. Unlike FOV our work functions aren't visiting every cell (we hope) and so we have to go through ahead of time and clear them out.
The rest of the functions do the ray casting. Starting at the character's position, it draws a line (trace-ray) out in a given direction. If it gets either past the view radius, or to a cell considered opaque, it doesn't recur. Otherwise it calls itself and continues stepping out. Trace-ray is called once per every 16 degrees around the circle. Its not entirely accurate, but its a lot faster than using 1 as the increment and drawing 360 rays.
;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Random helper functions;; ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Function to get a given cell (define get-cell (lambda (env x y) (get-cell-help env x y 0))) ;;Function does most of the real work to get a given cell (define get-cell-help (lambda (env new-x new-y y) (if (not (null? env)) (if (= y new-y) (get-cell-x (car env) new-x new-y 0) (get-cell-help (cdr env) new-x new-y (+ y 1))) #f))) ;;Final helper to get a given cell (define get-cell-x (lambda (env-row new-x new-y x) (if (not (null? env-row)) (if (= x new-x) (car env-row) (get-cell-x (cdr env-row) new-x new-y (+ x 1))) #f))) ;;Function to tell if a cell is passable (define cell-passable? (lambda (cell) ;;Check to see if symbol is in our list of impassable tiles (not (member (car cell) IMPASSABLE-TILES)))) ;;Function to tell if a cell is opaque (define cell-opaque? (lambda (cell) ;;Check to see if symbol is in our list of opaque tiles (not (member (car cell) OPAQUE-TILES)))) ;;Function to 'move' our 'character' to another cell (define move-to (lambda (env x y) (if (cell-passable? (get-cell env x y)) ;;Check to make sure they can move there (begin (set! char-x x) ;;'Move' them by changing our global vars (set! char-y y))))) ;;Function to set a given cell's visibility to the given boolean (define set-cell-visible (lambda (cell bool) (set-cdr! cell (list bool))))
These functions simply help the above code look prettier. The first make the environment which is really just a list (in true Scheme form) behave more like a two dimensional array. Cell-passable? and opaque? check to see if a cell can be traveled into or seen through. Move-to moves the character, and set-cell-visible helps quickly toggle a cell's visibility.
;;;;;;;;;;;;; ;;Test code;; ;;;;;;;;;;;;; ;;Setup the environment (define our-env (create-env test-env)) ;;Run the fov-demo (define fov-demo (lambda (env) (print "FOV demo, use h, j, k, and l to move, q to quit\n") (update-fov our-env char-x char-y) (write-env our-env) (let read-loop ((x (read-char))) (if (not (or (char=? x #\q) (char=? x #\newline))) (begin (case x [(#\l) (let ((new-x (+ char-x 1)) (new-y char-y)) (move-to our-env new-x new-y))] [(#\k) (let ((new-x char-x) (new-y (- char-y 1))) (move-to our-env new-x new-y))] [(#\j) (let ((new-x char-x) (new-y (+ char-y 1))) (move-to our-env new-x new-y))] [(#\h) (let ((new-x (- char-x 1)) (new-y char-y)) (move-to our-env new-x new-y))]) (update-fov our-env char-x char-y) (write-env our-env) (read-loop (read-char))) (case x [(#\q) (print "--End of FOV Demo--\n")] [(#\newline) (read-loop (read-char))]))))) ;;Run the ray-casting-demo (define ray-casting-demo (lambda (env) (print "Ray casting demo, use h, j, k, and l to move, q to quit\n") (cast-rays our-env char-x char-y) (write-env our-env) (let read-loop ((x (read-char))) (if (not (or (char=? x #\q) (char=? x #\newline))) (begin (case x [(#\l) (let ((new-x (+ char-x 1)) (new-y char-y)) (move-to our-env new-x new-y))] [(#\k) (let ((new-x char-x) (new-y (- char-y 1))) (move-to our-env new-x new-y))] [(#\j) (let ((new-x char-x) (new-y (+ char-y 1))) (move-to our-env new-x new-y))] [(#\h) (let ((new-x (- char-x 1)) (new-y char-y)) (move-to our-env new-x new-y))]) (cast-rays our-env char-x char-y) (write-env our-env) (read-loop (read-char))) (case x ;;Enter or q was pressed [(#\q) (print "--End of Ray casting demo--\n")] ;;If q, lets quit ;;If enter just read the next char, it happens [(#\newline) (read-loop (read-char))]))))) ;;Run our demos (fov-demo our-env) (ray-casting-demo our-env)
And finally the test code. Both of these loops behave the same, they use typical roguelike controls to move up (k), down (j), left (h), and right (l), as well as (q) to quit. You'll notice I also had to catch enter or read-char would spit out the map twice. At the end we call both of these functions so we can show off both types, back to back.
So there you have it, simple ray casting done in Scheme. I'll note that its not exceptionally fast, in fact for my test map the FOV demo was far quicker, but by degrading the accuracy and reducing the number of rays drawn the speed gets back up to something decent. I suspect that may also have to do with drawing it all out to the terminal, and will see what happens when I plug this into my ncurses code at a later point.
Hope that's commented well enough in the code. Enjoy!
Comments (No responses yet)
