Ray Casting in Scheme

Post by: on February 23rd, 2010 | Filed Under Games, Programming, Scheme

My 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)

(library 7DRL (import (rnrs))

Post by: on February 23rd, 2010 | Filed Under Games, Programming, Scheme

7DRL

Some friends were discussing the upcoming 7 Day Roguelike contest and I thought it'd be a fun thing to do after completing a browser based game in a month contest just a week back. However, I wanted to use something besides something besides the PHP I've been using for so very long, and somehow in the same IRC channel Scheme came up.

Scheme is a LISP language that I learned back in college and very quickly grew a nice love/hate relationship. I love seeing the beauty of recursion expressed so easily, and I just hate to see so many parenthesis all over the place. Seriously they make your eyes bleed. But the idea hit me that it'd be fun to try to do the roguelike in Scheme, and I decided to enter. I most likely won't finish, and I'm not too happy with the idea I have, but it'll be fun nonetheless.

Flavors

To that end, I've been playing in Scheme for the past week to familiarize myself with a language I haven't touched in a few years and which has had some nice advances since that time. First job was getting it installed on Ubuntu. I'd recommend playing with various flavors and seeing what you like best. I tried Mit-Scheme, Chez Scheme, PLT Scheme (Dr Scheme), Tiny Scheme, and Gambit. These can all be installed under Linux (fairly) easily, and all have upsides and downsides.

  • MIT Scheme - I had used this a tad during school, but sadly they're not supporting R6RS, and don't have a full implementation of R5RS, so its essentially useless.
  • Chez Scheme - What my school used primarily. Has a copy of the Scheme Programming Language Version 4 free on their site which is a big plus. They support all three major OS's and include an RPM/instructions for Debian installation.
  • PLT Scheme - The other product we used at school, it comes as a Scheme IDE with the ability to select from a variety of language subsets. The Ubuntu 9.04 package isn't up to date, but the package available on their site includes R6RS, so grab their install script and forgo synaptic. Big plus of being a fully featured IDE.
  • Tinyscheme - From the command line I actually liked this flavor the best. Sadly its a subset of the R5RS standard so it won't do everything you need, but for small proof-of-concept or test code, its nice and fast. I know it'd defeat the purpose, but I wish there was an R6RS version.
  • Gambit Scheme - This is a flavor I only came across this past week, had no prior experience with it. I love it. Again the version in the 9.04 Ubuntu repos is a bit old, so grab the newest version (4.6 as of now) here. If you just want to use Gambit as an interpreter/REPL you're good to go. If you want to use it to spit out C code as well, you may need to make sure your gambit.h file is in the right location.

Gambit

Yes, I said spit out C, as Gambit-C compiles your Scheme nicely into C files that gcc will then happily compile for you along with real C to use both languages. This is going to play greatly into my 7DRL as I wanted to use the NCurses library to handle my screen output and to I can easily include that now. An example of Hello World in Gambit Scheme with NCurses:

 
;;Hello World example for Gambit/NCurses
 
;;Include our headers
(c-declare "#include <ncurses.h>")
 
;;Define the function
(define hello-world
    ;;C lambda performs c commands, this is a basic ncurses
    ;;example that inits the screen, prints our string, waits
    ;;for input so it stays on the screen, and then kills the window
    (c-lambda () int "initscr(); printw(\"Hello World\"); refresh(); getch(); endwin();" ))
 
;;Gotta remember to call it!
(hello-world)
 

Now link, compile, and run it:

snarky@Reaper$ gsc -link ncurses.scm
snarky@Reaper$ gcc ncurses_.c ncurses.c -lgambc -lncurses -o ncurses
snarky@Reaper$ ./ncurses
Hello World

(Of course, the above output is slightly tweaked as I'm opting not to take a screenshot of a terminal empty save for one string)

It should be noted that once you start including C in your scheme you can no longer use the Gambit Scheme Interpreter to test your code, so I'd recommend breaking those bits out into other files if possible.

There are some other great additions within the Gambit system, such as the ability to have optional arguments in your functions, keyed variables passed to functions, and some random extensions like vector-copy, as well as, obviously, in-lining C in your Scheme. I highly recommend checking our their manual if you're at all interested.

Gotchas

I did get bit by a few things in Gambit, that I feel I should clarify. Even after reading through the manual, I missed that the compiler is spitting out linked files, not actual executables. To make sure you're getting an executable out of it make sure you do something akin to:

snarky@Reaper$ gsc -link file.scm
snarky@Reaper$ gcc file_.c file.c -lgambc

I very quickly just made a make file to handle it to simply forget about what steps go into it.

The big thing that bit me, however, was when I got out of the nice usual functions and into some higher syntax, specifically define-syntax. Gambit has a bunch of functionality turned off by default and requires that you turn it all on to use it. However I didn't feel like the documentation beat that into my head enough, so here's what you have to do:

For the interpreter:

snarky@Reaper$ gsi -:s

And for the compiler:

snarky@Reaper$ gsc -:s -link file.scm

OR

snarky@Reaper$ gsc -link -e '(load "/usr/local/Gambit-C/lib/syntax-case.scm")' file.scm

The top example turns a whole bunch of syntactic sugar on, while the bottom I believe just turns on some of the syntax. I could be wrong there.

I'm quite looking forward to playing with Gambit more and getting to know Scheme as I used to. Hopefully someone else can find a new sadistic language out of this post.

Comments (One response so far)