Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #24679
| From | Christian Kellermann <ckeen@pestilenz.org> |
|---|---|
| Newsgroups | comp.lang.forth |
| Subject | Re: Request for comments on a first forth program |
| Date | 2013-07-22 15:53 +0200 |
| Organization | A noiseless patient Spider |
| Message-ID | <87r4eqem57.fsf@pestilenz.org> (permalink) |
| References | <87wqomga80.fsf@pestilenz.org> <51ea7da3.812674010@news.demon.co.uk> |
stephenXXX@mpeforth.com (Stephen Pelc) writes:
> On Fri, 19 Jul 2013 11:39:11 +0200, Christian Kellermann
> <ckeen@pestilenz.org> wrote:
>
>>I have been re-reading my books on Forth lately and decided to get into
>>learning it finally. One of the first results have been attached to this
>>article and I would like to hear your criticism about it. (If this is a
>>faux pas on this list please ignore this request).
>
> I have just come back from a week teaching a Forth course, so your
> post is very relevant to me.
>
>
> What I find difficult in most Forth programs stems from them being
> bottom up. If you scan them from the top, you don't know why/where
> you're going. Hence, a description of each word is "very good thing".
>
> Further, I emphasise that writing the stack comment and description
> *before* you start coding the word will save time - your code will
> have fewer stack faults and you will be coding to a specification.
> Your successors and readers will thank you.
I have updated the program according to your and suggestion by the other
fine people in this group, please find the new version below.
I have added comments and restructured it a little bit, also you now
cannot run into holes and the number of robots increases with each
completed level.
Thanks!
Christian
--8<---------------cut here---------------start------------->8---
\ 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 loose. 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
--8<---------------cut here---------------end--------------->8---
Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar
Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-19 11:39 +0200
Re: Request for comments on a first forth program Ron Aaron <rambamist@gmail.com> - 2013-07-19 13:04 +0300
Re: Request for comments on a first forth program rickman <gnuarm@gmail.com> - 2013-07-19 12:43 -0400
Re: Request for comments on a first forth program Andrew Haley <andrew29@littlepinkcloud.invalid> - 2013-07-19 05:28 -0500
Re: Request for comments on a first forth program m.a.m.hendrix@tue.nl - 2013-07-19 03:56 -0700
Re: Request for comments on a first forth program m.a.m.hendrix@tue.nl - 2013-07-19 04:00 -0700
Re: Request for comments on a first forth program rickman <gnuarm@gmail.com> - 2013-07-19 12:51 -0400
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:28 +0200
Re: Request for comments on a first forth program anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-07-22 15:43 +0000
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-24 20:00 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-25 10:37 +0200
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-26 00:00 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-26 09:34 +0200
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-25 21:40 -1000
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-27 20:16 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-29 10:09 +0200
Re: Request for comments on a first forth program m.a.m.hendrix@tue.nl - 2013-07-29 04:14 -0700
Re: Request for comments on a first forth program Andrew Haley <andrew29@littlepinkcloud.invalid> - 2013-07-29 07:49 -0500
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-29 15:32 -1000
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-31 17:50 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-31 13:23 +0200
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-31 18:05 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-08-01 12:53 +0200
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-08-01 09:58 -0500
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-08-01 20:42 -0700
Re: Request for comments on a first forth program Brad Eckert <hwfwguy@gmail.com> - 2013-08-04 18:53 -0700
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-08-04 22:05 -0500
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-08-04 20:54 -0700
Re: Request for comments on a first forth program Alex McDonald <blog@rivadpm.com> - 2013-08-05 05:50 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-08-05 22:14 +0200
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-08-06 21:11 -0700
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-08-01 01:04 -0500
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-19 18:06 +0000
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:31 +0200
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:24 +0200
Re: Request for comments on a first forth program anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-07-22 15:32 +0000
Re: Request for comments on a first forth program Alex McDonald <blog@rivadpm.com> - 2013-07-19 06:49 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:34 +0200
Re: Request for comments on a first forth program Mark Wills <markrobertwills@yahoo.co.uk> - 2013-07-19 07:19 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:41 +0200
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-19 07:55 -1000
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:47 +0200
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-20 11:15 -1000
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-20 20:09 -0700
Re: Request for comments on a first forth program "Paul E. Bennett" <Paul_E.Bennett@topmail.co.uk> - 2013-07-19 19:36 +0100
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-20 12:36 +0000
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:53 +0200
Re: Request for comments on a first forth program Coos Haak <chforth@hccnet.nl> - 2013-07-21 02:02 +0200
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-20 17:18 -1000
Re: Request for comments on a first forth program Ian Osgood <iano@quirkster.com> - 2013-07-23 16:07 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:48 +0200
Re: Request for comments on a first forth program stephenXXX@mpeforth.com (Stephen Pelc) - 2013-07-20 12:18 +0000
Re: Request for comments on a first forth program Christian Kellermann <ckeen@necronomicon.my.domain> - 2013-07-20 21:57 +0200
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-20 11:24 -1000
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-22 15:53 +0200
Re: Request for comments on a first forth program m.a.m.hendrix@tue.nl - 2013-07-22 08:06 -0700
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-22 19:35 +0000
Re: Request for comments on a first forth program m.a.m.hendrix@tue.nl - 2013-07-23 00:41 -0700
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-23 12:00 +0200
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-23 12:10 +0000
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-23 14:19 +0200
Re: Request for comments on a first forth program stephenXXX@mpeforth.com (Stephen Pelc) - 2013-07-24 09:27 +0000
Re: Request for comments on a first forth program anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-07-23 13:44 +0000
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-20 20:02 -0700
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-21 03:36 +0000
Re: Request for comments on a first forth program hughaguilar96@yahoo.com - 2013-07-20 22:28 -0700
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-21 10:31 +0000
Re: Request for comments on a first forth program rickman <gnuarm@gmail.com> - 2013-07-20 23:41 -0400
Re: Request for comments on a first forth program anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-07-22 15:36 +0000
Re: Request for comments on a first forth program Lars Brinkhoff <lars.spam@nocrew.org> - 2013-07-23 12:22 +0200
Re: Request for comments on a first forth program Christian Kellermann <ckeen@pestilenz.org> - 2013-07-23 13:44 +0200
Re: Request for comments on a first forth program albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-07-23 12:26 +0000
Re: Request for comments on a first forth program "Elizabeth D. Rather" <erather@forth.com> - 2013-07-23 07:10 -1000
Re: Request for comments on a first forth program stephenXXX@mpeforth.com (Stephen Pelc) - 2013-07-24 09:30 +0000
csiph-web