\ 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)  \ statisticsvariable #moves 0 #moves !variable #teleports 3 #teleports ! \ the board20 constant board-rows78 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-dimensioncreate 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 wordschar ☻ constant player-symchar ☹ constant robot-symchar ◯ constant hole-sym32 constant floor-sym \ a space characterchar │ 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 ; \ playercreate (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 words10 constant #holescreate 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 robots20 constant #max-robots\ we start with 2 robotsvariable #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