robots.f

\ Robots.f - 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 loose. You are able to teleport yourself to a
\ random location 3 times.
\
\ (by ckeen)


\ 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
    random 255 and board-cols mod random 255 and board-rows mod ;

board-rows board-cols * constant board-dimension
create board board-dimension cells 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 cells board + @ ;
: board! ( c x y -- ) \ stores tile char c at coordinates x y
    xy->board cells board + ! ;

\ drawing words
char ☻ constant player-sym
char ☹ constant robot-sym
char ◯ constant hole-sym
32 constant floor-sym \ a space character
char │ constant wall-sym

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

: bottom-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 cells + ! \ 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 top-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 cells + @ emit \ and draw the (next) tile
    loop
    wall cr bottom-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
variable #robots  2 #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! " cr bye endof
        [char] t of #teleports @ 0>
            if #teleports @ 1- #teleports !
                teleport-location 2dup
                update-player player! then endof
        10 of recurse endof
    endcase
    1 #moves +! ;

: run ( -- ) \ main loop and entry point
    2 #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 #robots ! \ unless there are already #max-robots
            reset-game then
        any-collision?                  \ did they catch the player?
        if ." You died! " cr bye       \ yes, player dies
        else user-input then            \ handle user input
        move-robots                     \ robots move last
    again ;

here seed ! \ initialise PRNG
\ run \ start the game