Escape the robots!

Phil Hagelberg wrote several implementations of the robots(1) game found on *BSDs in different lisp dialects to get a feeling on how they compare. This has been an interesting read for me and I wanted to take it as an opportunity to try an old aquaintance again: Forth.

My robots version has the following rules:

So, without further ado, here is my forth robots game:

\ Robots.fth - An implementation of the BSD robots game
\
\ You ("@") are placed into a wide space covered with holes ("o") and
\ robots ("R"). Try to lure the robots into the holes to win. If a
\ robot catches you, you lose. You are able to teleport yourself to a
\ random location 3 times.

require random.fs

\ statistics
variable #moves 0 #moves !
variable #teleports 3 #teleports !

\ the board
20 constant board-rows
78 constant board-cols

: random-xy ( -- x y ) \ returns random x y coordinates
    board-cols random board-rows random ;

board-rows board-cols * constant board-dimension
create board board-dimension allot
: xy->board ( x y -- i ) \ converts xy coordinates to the board buffer index
    board-cols * + ;
: board@ ( x y -- c ) \ fetches a tile at coordinates x y
    xy->board board + c@ ;
: board! ( c x y -- ) \ stores tile char c at coordinates x y
    xy->board board + c! ;

\ drawing words
char @ constant player-sym
char R constant robot-sym
char o constant hole-sym
32 constant floor-sym \ a space character
char | constant wall-sym

: border ( -- ) \ draw a border like '+----+' for the board
    [char] +  emit
    board-cols 0 do [char] - emit loop
    [char] + emit ;

: wall ( -- ) \ print a wall symbol
    wall-sym emit ;

: board-reset ( -- ) \ empties a board by placing floor tiles in it
    board-dimension 0 do \ for the whole board
        floor-sym board i + ! \ store a floor tile
    loop ;

: board-print ( -- ) \ prints the whole board
    \ clears screen, prints the board surrounded
    \ by walls and a border on top and bottom
    page border cr wall
    board-dimension 0 do
        i board-cols mod 0= i 0> and if \ special case for first position at (0,0)
            wall cr wall then \ otherwise draw a wall at the end of each line
        board i + @ emit \ and draw the (next) tile
    loop
    wall cr border cr ;

\ player
create (player) 2 cells allot

: player@ ( -- x y ) \ returns current player x y position
    (player) 2@ ;

: player! ( x y -- ) \ sets current player position to x y
    (player) 2! ;

: new-position ( x1 y1 dx dy -- x2 y2 ) \ adds an offset to the current position
    rot +        \ calculate y2 ( x1 dx y2 )
    >r           \ store y2
    + r> ;       \ add x1 dx and push y2

: valid-position? ( x y -- f ) \ checks whether the player can be placed here
    2dup 2>r                          \ save coordinates for later
    0 board-rows within swap          \ y is within board boundaries
    ( b x ) 0 board-cols within and   \ x is also within boundaries?
    2r> ( x y ) board@ floor-sym = and ;  \ is it a free space? This prevents falling into holes

: up ( -- dx dy ) 0 -1 ;
: down ( -- dx dy ) 0 1 ;
: left ( -- dx dy ) -1 0 ;
: right ( -- dx dy ) 1 0 ;

: teleport-location ( -- ) \ ensure that the new location is legal
    random-xy                   \ get random coordinates
    2dup valid-position? invert \ use a copy for testing, is valid?
    if 2drop                    \ if it is not, clean stack
        recurse then ;          \ and try again

: update-player ( x y -- )
    \ move the player tile on the board
    \ and update the player position
    floor-sym player@ board!    \ set the floor tile at old pos
    player-sym rot rot          \ ( player-sym x y )
    2dup player!                \ set player position, leave x y
    ( player-sym x y ) board! ; \ set player tile at new position

: move ( dx dy -- )
    \ high level movement word, taking a direction
    \ and moving the player if the new position is valid
    player@ 2swap new-position \ get new x y coordinates
    2dup valid-position?       \ if these are valid
    if update-player           \ move to it
    else 2drop then ;          \ or restore the stack

\ hole words
10 constant #holes
create holes #holes 2* cells allot
: hole@ ( i -- x y ) 2* cells holes + 2@ ;
: hole! ( x y i -- ) 2* cells holes + 2! ;


\ robot words
\ we do have a maximum of 20 robots
20 constant #max-robots
\ we start with 2 robots
2 value #robots
\ robots occupy 3 cells: x y alive?
create robots #max-robots 3 * cells allot

: robot@ ( i -- x y ) \ return the x y position of the ith robot
    3 * cells robots + 2@ ;

: robot! ( x y i -- ) \ set the ith robot's postion to x y
    3 * cells robots + 2! ;

: robot-alive! ( t i -- ) \ set the alive flag to f for the ith robot
    3 * cells 2 cells + robots + ! ;
: robot-alive? ( i -- t ) \ return the alive flag for the ith robot
    3 * cells 2 cells + robots + @ ;

: #robots-alive ( -- n ) \ returns the numer of robots that are alive
    0                  \ always return something sensible
    #robots 0 ?do      \ we iterate over the current number of robots
        i robot-alive? \ it it is alive
        if 1+ then     \ count it
    loop ;

: update-robot ( x y i -- )    \ sets robot position and board tile
    >r                         \ save index for later usage
    floor-sym r@ robot@ board! \ replace the old place with floor tile
    r@ robot!                  \ update the robot
    robot-sym r@ robot@ board! \ robot tie on new pos
    r> drop ;                  \ clean stack

: distance ( x1 y1 x2 y2 -- x2-x1 y2-y1) \ returns the distance between two positions
    >r       \ save y2
    rot -    \ x2-x1
    r> rot - \ y2-y1
    swap ;   \ -> x' y'

: sign ( n1 -- n2 ) \ calculate the sign of a number
    dup 0=
    if
        drop 0    \ 0 -> 0
    else
        dup abs / \ n1 / (abs n1) -> -1 / 1
    then ;

: direction ( d1 d2 -- dx dy ) \ extract the direction from a given position
    sign swap sign ;

: towards-player ( x y -- x' y' ) \ return new position that moves one step toward the player's current pos
    2dup player@ distance direction new-position ;

: collision? ( x1 y1 x2 y2 -- f ) \ are the two positions the same?
    xy->board     \ get the index for the second position
    rot rot       \ move first position to TOS
    xy->board = ; \ convert to index and compare

: is-in-hole? ( x y -- f ) \ checks whether a given position is on a hole
    xy->board                  \ convert to index
    false                      \ initialise with false
    #holes 0 do
        over                   \ get a copy of the index
        i hole@ xy->board      \ is it on this hole?
        = or                   \ yes? if so or it
    loop swap drop ;           \ ( i f ) -> ( -- f )

: move-robot ( i -- ) \ move the i-th robot towards the player
    dup >r robot@ towards-player   \ get the new coords
    2dup is-in-hole?               \ fell into a hole
    if false r@ robot-alive!       \ yes, this is a dead robot
        floor-sym r> robot@ board! \ replace the old robot position with an empty tile
        2drop                      \ remove the wrong position again
    else
        r> update-robot            \ if alive update the robot's position and the board
    then ;

: move-robots ( -- ) \ highlevel word to move all robots towards player
    #robots 0 ?do
        i robot-alive?              \ if robot i is alive
        if i move-robot then loop ; \ move it towards player

: any-collision? ( -- f ) \ returns true if any robot caught the player
    false                               \ we assume that the player is well
    #robots 0                           \ for all robots
    ?do i robot-alive?                  \ is this robot alive
        if i robot@ player@  collision? \ has this robot caught the player?
            or                          \ set flag to true if so
        then loop ;

\ game routines init, loop
: init-robots ( -- ) \ place the current number of robots on the board and activate them
    #robots 0 ?do
        robot-sym random-xy 2dup i robot! board! \ place them on board and initialise position
        true i robot-alive! loop ;               \ switch them on

: init-holes ( -- ) \ randomly scatter holes on the board
    #holes 0 do hole-sym random-xy 2dup i hole! board! loop ;

: init-player ( -- ) \ place player on the board
    teleport-location          \ find a spot where the player can live
    2dup player! update-player \ update board tiles and player pos
    0 #moves !                 \ reset move counter
    3 #teleports ! ;           \ give the player 3 teleports

: reset-game ( -- ) \ sets up a new game with the current number of robots
    board-reset init-player init-robots init-holes ;
: status-line ( -- ) \ prints a status line on screen
    ." moves: "  #moves @ . ." teleports: " #teleports @ . ." robots: " #robots-alive . ;
: help ( -- ) \ prints a key legend on screen
    ." h: left, j: down, k: up, l: right, t: teleport, q: quit, any other key waits."  cr ;

: user-input ( -- ) \ waits for one key, then handles player movement
    key
    case
        [char] h of left move endof
        [char] j of down move endof
        [char] k of up move endof
        [char] l of right move endof
        [char] q of ." Thanks for playing! " quit endof
        [char] t of #teleports @ 0>
            if #teleports @ 1- #teleports !
                teleport-location 2dup
                update-player player! then endof
    endcase
    1 #moves +! ;

: run ( -- ) \ main loop and entry point
    !csp
    2 to #robots \ start with 2 robots
    reset-game
    begin
        board-print status-line cr help \ print the board
        #robots-alive 0=                \ are robots left?
        if ." You win!" cr              \ no, next round with more robots
            #max-robots #robots 1+ min to #robots \ unless there are already #max-robots
            reset-game then
        any-collision?                  \ did they catch the player?
        if ." You died! " cr quit       \ yes, player dies
        else user-input then            \ handle user input
        move-robots                     \ robots move last
        ?csp                            \ watch out for an unclean stack
    again ;

here seed ! \ initialise PRNG
run \ start the game

You can also grab the source and try it for yourself. Note that the random word is a nonstandard forth word, I have used GNU Forth for this and you may need to adjust this even for your GNU forth installation. On OpenBSD I need to pass the full path to the file (include /usr/local/share/gforth/random.fs). On my linux system it works as is.

My observations:

I have sent my first attempt to comp.lang.forth for comments. It looked a bit smaller due to missing comments and features. The nice people on c.l.f helped improve the program and my understanding of forth a lot. It seems I did it mostly right on the first try :)

So how does this game compare to scheme? All in all, I have to say it is not too much different. The interactivity in the forth interpreter is as nice as a scheme repl, the lack of parenthesis is made up by the unusual stack juggling, which got easier by the minute.

As with scheme forth provides a small core language and extensions differ from implementation to implementation. The community is aware of this and tries to stick to the core language for portability but breaks it when necessary.

A nice thing is that you can immediately fiddle with internals if you need it, extend the compiler and even write macros! Although it seemed overkill for this little game.

So will I abandon scheme for this forth? Probably not, but I am looking forward to using it more and more, especially on embedded systems.

Code on this site is licensed under a 2 clause BSD license, everything else unless noted otherwise is licensed under a CreativeCommonsAttribution-ShareAlike3.0UnportedLicense