version 1.1, 1995/10/26 22:48:42
|
version 1.3, 1997/02/16 20:51:11
|
Line 13
|
Line 13
|
\ is shown below. |
\ is shown below. |
|
|
\ program is ANS FORTH with environmental dependency of case-insensitiv |
\ program is ANS FORTH with environmental dependency of case-insensitiv |
\ source. Tested with gforth and bigFORTH |
\ source. Tested with gforth, bigFORTH and pfe |
|
|
\ really uses "dump" terminal: No PAGE, no AT-XY to speed things up |
\ bell (7) is replaced with "Wuff!" ;-) |
\ Even bell (7) is replaced with "Wuff!" ;-) |
|
\ (this is a german joke) |
\ (this is a german joke) |
\ I don't like the keyboard interpreting CASE-statement either, but |
\ I don't like the keyboard interpreting CASE-statement either, but |
\ was to lazy to use a table. |
\ was to lazy to use a table. |
Line 29 Create maze 1 cells allot /maze 25 * al
|
Line 28 Create maze 1 cells allot /maze 25 * al
|
Variable mazes 0 mazes ! \ root pointer |
Variable mazes 0 mazes ! \ root pointer |
Variable soko 0 soko ! \ player position |
Variable soko 0 soko ! \ player position |
Variable >maze 0 >maze ! \ current compiled maze |
Variable >maze 0 >maze ! \ current compiled maze |
>maze off |
|
|
|
\ score information |
\ score information |
|
|
Line 42 Variable score 0 score ! \ total nu
|
Line 40 Variable score 0 score ! \ total nu
|
here mazes rot 1 ?DO @ LOOP ! |
here mazes rot 1 ?DO @ LOOP ! |
0 , 0 , here >maze ! 0 , ; |
0 , 0 , here >maze ! 0 , ; |
: count-$ ( addr u -- n ) 0 rot rot |
: count-$ ( addr u -- n ) 0 rot rot |
bounds ?DO I c@ [char] $ = - LOOP ; |
over + swap ?DO I c@ [char] $ = - LOOP ; |
: m: ( "string" -- ) \ add a level line (top first!) |
: m: ( "string" -- ) \ add a level line (top first!) |
-1 parse tuck 2dup count-$ >maze @ 1 cells - +! |
-1 parse tuck 2dup count-$ >maze @ 1 cells - +! |
here swap move dup allot |
here swap move dup allot |
Line 58 Variable score 0 score ! \ total nu
|
Line 56 Variable score 0 score ! \ total nu
|
|
|
: .maze ( -- ) \ display maze |
: .maze ( -- ) \ display maze |
0 0 at-xy .score |
0 0 at-xy .score |
cr maze-field bounds |
cr maze-field over + swap |
DO I /maze type cr /maze chars +LOOP ; |
DO I /maze type cr /maze chars +LOOP ; |
|
|
: find-soko ( -- n ) |
: find-soko ( -- n ) |
Line 99 Variable score 0 score ! \ total nu
|
Line 97 Variable score 0 score ! \ total nu
|
|
|
: play-rule ( addr1 u1 addr2 u2 offset -- flag ) |
: play-rule ( addr1 u1 addr2 u2 offset -- flag ) |
>r 2swap r@ apply-rule? |
>r 2swap r@ apply-rule? |
IF r> apply-rule! true ELSE rdrop 2drop false THEN ; |
IF r> apply-rule! true ELSE r> drop 2drop false THEN ; |
|
|
\ player may move up, down, left and right |
\ player may move up, down, left and right |
|
|
Line 120 Variable score 0 score ! \ total nu
|
Line 118 Variable score 0 score ! \ total nu
|
S" &." S" .&" r@ play-rule IF r> soko +! EXIT THEN |
S" &." S" .&" r@ play-rule IF r> soko +! EXIT THEN |
S" &* " S" .&$" r@ play-rule |
S" &* " S" .&$" r@ play-rule |
IF r> soko +! 1 rocks +! -1 score +! EXIT THEN |
IF r> soko +! 1 rocks +! -1 score +! EXIT THEN |
-1 moves +! rdrop ; |
-1 moves +! r> drop ; |
|
|
1 move: soko-right |
1 move: soko-right |
-1 move: soko-left |
-1 move: soko-left |
Line 155 Variable score 0 score ! \ total nu
|
Line 153 Variable score 0 score ! \ total nu
|
[char] C OF soko-right false ENDOF |
[char] C OF soko-right false ENDOF |
|
|
[char] q OF true ENDOF |
[char] q OF true ENDOF |
ENDCASE |
false swap ENDCASE |
UNTIL ; |
UNTIL ; |
|
|
\ start game with "sokoban" |
\ start game with "sokoban" |
|
|
: sokoban ( -- ) |
: sokoban ( -- ) |
1 level IF play-loop ." Game finished!" THEN ; |
page 1 level IF play-loop ." Game finished!" THEN ; |
|
|
001 new-maze |
001 new-maze |
m: ##### |
m: ##### |