Beetle Brick Chase

Description of the page content

Game written in Ace Forth for the Jupiter Ace.

Tags:

The origin of this program

Beetle Brick Chase is my Forth version of Escarabajo (the Spanish word for beetle), a little game written in Sinclair BASIC by unknown author, published in the first issue of the Spanish magazine ZX, in 1983. It was the first computing magazine I bought after having my ZX Spectrum. Every issue had plenty of program listings, for the Spectrum and the ZX81. Some months later I bought also the new magazine TodoSpectrum (AllSpectrum), devoted only to the ZX Spectrum. And finally I collected the best magazine ever about the ZX Spectrum in Spain: Microhobby, until its last issue, 217, in january 1992.

Sometimes I look at those old magazines, looking for ideas or inspiration. That's how Beetle Brick Chase was born. You can see the listing of the original version, Escarabajo.

I programmed some improvements that are mentioned in the source code.

The plot

It's quite simple: you're a beetle and you gonna die. That's all. Your objective is to dodge among the falling bricks as long as possible. They cannot hit you, but you will die if you crash them, so don't move too fast. You will get a point for every step. If you don't move, the bricks will surround you and you will get mad and starve to death...

Screenshots

Instructions:

Beetle Brick Chase

The beetle dodges to the right of the arena:

Beetle Brick Chase

Crash effect:

Beetle Brick Chase

Another way to die, surrounded by bricks:

Beetle Brick Chase

Final screen:

Beetle Brick Chase

Source code




: task ;

: (  begin  ascii ) word c@ 31 =  while  retype  repeat  ;  immediate
: \  ( -- )  0 word drop  ; immediate

\ Beetle Brick Chase 
\ A game for the Jupiter Ace

\ Copyright (C) 2010 Marcos Cruz (http://programandala.net)
\ License: http://programandala.net/license

\ "Beetle Brick Chase" is an Ace Forth version of "Escarabajo" 
\ (the Spanish word for "beetle"),
\ written in Sinclair Basic by unknown author,
\ published in 1983 in ZX (number 1, page 26):
\ http://microhobby.speccy.cz/zx/zx01/01-26.JPG

\ History:
\ 2009-06-18 First draft.
\ 2010-01-19 Second draft.
\ 2010-02-17 First working version.
\ 2010-02-22 Finished.
\ 2010-02-27 Starvation effect rewritten.
\ 2010-02-28 Simpler method for beetle char to graph conversion (needed by the starvation effect).
\ 2010-03-04 u>ud used instead of s>d .

\ Improvements on the original version:
\ * Clean Forth poetry instead of jumble Basic prose.
\ * The beetle graph changes depending on the direction.
\ * Some random calculations for the sake of naturalism.
\ * No sound! :)
\ * Final effects: crash, madness and starvation
\   (the starvation effect cannot be seen under the xace emulator).

\ Acknowledgements:
\ dulac and Acey helped me programming the starvation effect:
\ http://jupiterace.proboards.com/index.cgi?board=programmingaceforth&action=display&thread=205
\ xris suggested a way to simplify the word .000 :
\ http://jupiterace.proboards.com/index.cgi?action=gotopost&board=programmingaceforth&thread=211&post=872

\ Improvements for future versions:
\ * Animate graph (e.g. moving legs).

forth definitions  decimal

\ -----------------------------
\ System addresses

15403 constant FRAMES
11264 constant 'charset
 8192 constant 'screen

\ -----------------------------
\ Common use words

0 constant false
\ false 0= constant true
32 constant bl  \ space char
: bounds  ( a1 u -- a2 a3 )  over + swap  ;
: cmove  ( a1 a2 u -- )  bounds  do  dup c@ i c! 1+  loop  drop  ;
: +!  ( n a -- )  swap over @ + swap !  ;
\ : s>d  ( n -- d )  dup 0< negate  ;
: u>ud  ( u -- ud )  0  ;
\ : d=  ( d1 d2 -- f )  rot = >r  = r> and  ;
\ : 2dup  ( x1 x2 -- x1 x2 x1 x2 )  over over  ;
: <>  ( x1 x2 -- f ) = 0=  ;
: key  ( -- c )  begin  inkey ?dup  until  ;

\ -----------------------------
\ General ad hoc words

: frames+  ( n1 -- n2 )  FRAMES @ +  ;
: frames<  ( n -- f )  FRAMES @ <  ;
: delay  ( n -- )  \ waits for n 50ths of second
  frames+
  begin  dup frames<
  until  drop
  ;
: (pause)  ( n -- )  \ wait for n 50ths of second or until a key is pressed
  frames+
  begin  dup frames< inkey or
  until  drop
  ;
: pause  ( n -- )  \ wait for n 50ths of second (or forever if n=0) or until a key is pressed
  ?dup  if  (pause)  else  key drop  then
  ;

: inverse  ( c1 -- c2 )  128 xor  ;
: 'char  ( c -- a )  8 * 'charset +  ;
: graph>addr  ( a1 a2 -- )  8 cmove  ;
: graph>char  ( a c -- )  'char graph>addr ;
32 constant columns
: at@  ( y x -- c )  swap columns * + 'screen + c@  ;
: halfway  ( n1 n2 -- n3 )  - 2 /  ;

: lowercase  ( c1 -- c2 )  32 or  ;
: y/n=  ( c1 -- c2 f )  lowercase dup ascii y = over ascii n = or  ;
: y/n  ( -- c )  0  begin  drop inkey y/n=  until  ;
\ : yes?  ( -- f )  y/n ascii y =  ;
: no?  ( -- f )  y/n ascii n =  ;

\ -----------------------------
\ Pseudo random numbers generator
\ (as of the Jupiter Ace manual)

0 variable seed
: seedon  ( -- x )
  seed @ 75 u* 75 0 d+ over over u< - - 1-
  dup seed !
  ;
: rnd  ( n1 -- n2 )  seedon u* swap drop  ;
: randomize  ( n -- )  ?dup 0=  if  FRAMES @  then  seed !  ;

: (1+-)  ( -- n )  3 rnd 1-  ;
: 1+-  ( n1 -- n2 )  (1+-) +  ;
: 2+-  ( n1 -- n2 )  (1+-) 2 * +  ;

\ -----------------------------
\ Graphs

1 constant up_beetle_char
2 constant left_beetle_char
3 constant right_beetle_char
4 constant down_beetle_char
5 constant brick_char
6 constant crash_char

2 base c!
create up_beetle_graph
00000000 c,
00011000 c,
10100101 c,
01111110 c,
00111100 c,
00111100 c,
01111110 c,
10011001 c,
create left_beetle_graph
00100001 c,
00010010 c,
00111110 c,
01011111 c,
01011111 c,
00111110 c,
00010010 c,
00100001 c,
create right_beetle_graph
10000100 c,
01001000 c,
01111100 c,
11111010 c,
11111010 c,
01111100 c,
01001000 c,
10000100 c,
create down_beetle_graph
10011001 c,
01111110 c,
00111100 c,
00111100 c,
01111110 c,
10100101 c,
00011000 c,
00000000 c,
create brick_graph
11111111 c,
10000001 c,
10111101 c,
10100101 c,
10100101 c,
10111101 c,
10000001 c,
11111111 c,
create crash_graph
10101010 c,
01111111 c,
11010110 c,
01111011 c,
11011110 c,
01101011 c,
11111110 c,
01010101 c,
decimal
create starvation_graph 8 allot

\ Older version, unnecessarily complex because the lookup table
\ is needed only for the beetle graph, and the beetle chars are 1 to 4.
\  create chars{  \ lookup table
\  up_beetle_char c, up_beetle_graph ,
\  left_beetle_char c, left_beetle_graph ,
\  right_beetle_char c, right_beetle_graph ,
\  down_beetle_char c, down_beetle_graph ,
\  here constant }chars
\  : char>graph  ( c -- a | )  \ return the original graph address associated with a char, or nothing
\   }chars chars{
\   do  
\     i c@ over =   if  i 1+ @ swap leave  then  
\   3 +loop  drop
\   ;
create beetle_graphs  \ indexed table
up_beetle_graph ,
left_beetle_graph ,
right_beetle_graph ,
down_beetle_graph ,
: beetle_char>graph  ( c -- a )  \ return the beetle original graph address associated with a beetle char
  1- 2 * beetle_graphs + @
  ;

: init_graphs  ( -- )
  up_beetle_graph up_beetle_char graph>char
  left_beetle_graph left_beetle_char graph>char
  right_beetle_graph right_beetle_char graph>char
  down_beetle_graph down_beetle_char graph>char
  brick_graph brick_char graph>char
  crash_graph crash_char graph>char
  ;

\ -----------------------------
\ Arena

0 constant arena_top  \ line
0 constant arena_left  \ column
21 constant arena_bottom  \ line
columns 1- constant arena_right  \ column

\ -----------------------------
\ Score

0 variable score
0 variable record
arena_bottom 1+ constant score_line
: .000  ( u -- ) u>ud <# # # # #> type  ;
: ."record"  ( -- ) score_line [ arena_right 10 - ] literal at ." Record:"  ;
: .record  ( -- )  score_line [ arena_right 2 - ] literal at record @ .000  ;
: record!  ( u -- )  record ! .record  ;
: ."score"  ( -- )  score_line arena_left at ." Score:"  ;
: .score  ( -- )  score_line [ arena_left 7 + ] literal at score @ .000  ;
: +record ( -- )
  score @ record @ >
  if  score @ record!  then
  ;
: +score  ( -- )  1 score +! .score  +record  ;

\ -----------------------------
\ Beetle char and printing

: random_beetle  ( -- u )  4 rnd 1+  ;
random_beetle variable beetle_char
: random_beetle!  ( -- )  random_beetle beetle_char !  ;
: beetle_graph  ( -- a )  beetle_char @ beetle_char>graph  ;
0 variable beetle_x
0 variable beetle_y
: beetle_coords  ( -- y x )  beetle_y @ beetle_x @  ;
: at_beetle  ( -- )  beetle_coords at  ;
: .beetle  ( -- )  at_beetle beetle_char @ emit  ;
: -beetle  ( -- )  at_beetle space  ;

\ -----------------------------
\ Beetle final effects

\ Crash

0 variable crashed?
: .crash  ( c -- )  at_beetle emit  5 delay ;
: crash  ( -- )
  16 0 do
    crash_char dup inverse .crash .crash
  loop
  brick_char .crash
  ;
: crash?  ( -- f )  beetle_coords at@ bl <> dup crashed? !  ;

\ Starvation to death

: 'beetle_char  ( -- a )  beetle_char @ 'char  ;
: random_scan  ( -- u )  8 rnd  ;
: 'starvation_scans  ( -- a1 a2 )  starvation_graph 8 bounds  ;
: dead?  ( -- f )  \ is the starvation graph blank?
  0  'starvation_scans
  do
    i c@ ?dup  if  or leave  then
  loop  0=
  ;
: lighter  ( b1 -- b2 )
  255 rnd and
  ;
: thinner  ( -- )  \ unset some random bits from a random beetle scan
  random_scan dup starvation_graph + dup c@ lighter dup
  rot c!  \ update the starvation graph with the corrupted scan
  swap 'beetle_char + c!  \ update the actual graph with the corrupted scan
  ;
: init_starvation  ( -- )
  beetle_graph starvation_graph graph>addr
  ;
: starvation  ( -- )
  init_starvation
  begin  thinner dead?  until
  ;

\ Madness

: (madness)  ( -- )
  random_beetle! .beetle  8 16 rnd + delay
  ;

: madness  ( -- )
  beetle_char dup @  \ save the current char
  16 dup rnd + 0
  do  (madness)  loop
  swap !  \ restore the current char
  ;

\ -----------------------------
\ Beetle movement

ascii 5 constant left_key
ascii 6 constant up_key
ascii 7 constant down_key
ascii 8 constant right_key

: pace ( -- )  8 17 rnd + delay  ;
: move  ( n a -- ) -beetle +! crash?  if  crash  else  .beetle +score pace  then  ;
: left ( -- )  left_beetle_char beetle_char !  -1 beetle_x move  ;
: right ( -- )  right_beetle_char beetle_char !  1 beetle_x move  ;
: up ( -- )  up_beetle_char beetle_char !  -1 beetle_y move  ;
: down ( -- )  down_beetle_char beetle_char !  1 beetle_y move  ;

0 variable pressed_key
: pressed?  ( c -- f )  pressed_key @ =  ;
: left_key?  (  -- f )  left_key pressed?  ;
: right_key?  ( -- f )  right_key pressed?  ;
: up_key?  ( -- f )  up_key pressed?  ;
: down_key?  ( -- f )  down_key pressed?  ;
: action  ( c -- )
  pressed_key !
  left_key?  if  left  else
  right_key?  if  right  else
  up_key?  if  up  else
  down_key?  if  down
  then then then then
  ;
: beetle  ( -- )  24 pause inkey action ;

\ Alternative system, with a lookup table.
\ It is more elegant than nested if-structures
\ but it works only the first time; it doesn't work
\ after loading the dictionary from tape.
\ To fix it, the code field addresses of the actions
\ should be calculated at run time, in the game init.
\  : action:  ( c -- )  c, find ,  ;
\  3 constant /key  \ bytes per key
\  0 variable key_action
\  create key_actions
\  left_key action: left
\  up_key action: up
\  down_key action: down
\  right_key action: right
\  0 action: still  \ other keys
\  here /key - constant other_key
\  : action  ( c -- cfa )
\   other_key dup key_action !
\   key_actions do
\     dup i c@ =  if  i key_action ! leave  then
\   /key +loop  drop  1+ @
\   ;
\  : beetle  ( -- )  inkey action execute  ;

\ -----------------------------
\ Beetle surrounded?

: surrounded  ( -- )  madness starvation  ;
: brick?  ( y x -- f )  at@ brick_char =  ;
: upper_brick?  ( -- f )  beetle_y @ 1- beetle_x @ brick?  ;
: lower_brick?  ( -- f )  beetle_y @ 1+ beetle_x @ brick?  ;
: left_brick?  ( -- f )  beetle_coords 1- brick?  ;
: right_brick?  ( -- f )  beetle_coords 1+ brick?  ;
: surrounded?  ( -- f )
  false
  left_brick?  if
    right_brick?  if
      lower_brick?  if
        drop upper_brick?
      then
    then
  then
  dup  if  surrounded  then
  ;

\ -----------------------------
\ Brick

0 variable brick_x
0 variable brick_y
: at_brick  ( -- )  brick_y @ brick_x @ at  ;
: (.brick)  ( -- )  brick_char emit  ;
: .brick  ( -- )  at_brick (.brick)  ;
: proper?  ( y x -- f )  \ proper coords for the new brick?
  beetle_x @ <> swap beetle_y @ <> or
  ;
: +brick_coords  ( -- y x )  \ calculate coords for a new brick
  beetle_y @ 1+- dup brick_y !
  beetle_x @ 1+- dup brick_x !
  ;
: +brick  ( -- )  +brick_coords proper?  if  .brick  then  ;
: +brick?  ( -- f )  3 rnd 0=  ;
: brick  ( -- )  +brick?  if  +brick  then  ;

\ -----------------------------
\ Scenery

: .hbricks  ( x -- )  \ print horizontal bricks at column x
  arena_top over at (.brick)
  arena_bottom swap at (.brick)
  ;
: (.vbricks)  ( y -- )  \ print vertical bricks at line y
  dup arena_left at (.brick)
  arena_right at (.brick)
  ;
: .vbricks  ( y -- )  \ print vertical bricks at line y if needed
  dup [ arena_bottom 1+ ] literal <
  if  (.vbricks)  else  drop  then
  ;
: .wall  ( -- )
  [ arena_right 1+ ] literal arena_left
  do  i dup .hbricks .vbricks  loop
  ;
: .status  ( -- )  ."score" .score ."record" .record  ;
: .scenery  ( -- )  cls .wall .status  ;

\ -----------------------------
\ Init

: .about  ( -- )
     ." Beetle Brick Chase"
  cr
  cr ." Copyright (C) 2010 Marcos Cruz"
  cr ." http://programandala.net"
  cr ." License:"
  cr ." http://programandala.net/license"
     ." Version: 2010-03-04"
  ;
: .objective  ( -- )
  cr ." You are a beetle. Your objective"
     ." is to dodge among the falling"
  cr ." bricks. They cannot hit you, but"
     ." you will die if you crash them."
  cr ." If you don't move, they will"
  cr ." surround you and you will"
  cr ." get mad and starve to death..."
  ;
: .key  ( c -- )  cr 4 spaces inverse emit space  ;
: .keys  ( -- )
  cr ." Keys:"
  left_key .key ." left"
  up_key .key ." up"
  down_key .key ." down"
  right_key .key ." right"
  ;
: .instructions  ( -- )  .objective cr .keys  ;
: wait  ( -- )  cr cr ." Press any key to start."  0 pause  ;
: init_screen  ( -- )  init_graphs invis cls .about cr .instructions wait cls  ;
: init_beetle  ( -- )
  [ arena_bottom arena_top halfway ] literal beetle_y !
  [ arena_right arena_left halfway ] literal beetle_x !
  random_beetle! .beetle
  ;
: init  ( -- )
  0 randomize  0 score !  0 crashed? !
  init_screen  .scenery  init_beetle
  ;

\ -----------------------------
\ End

\ Older version.
\  : proper_y  ( -- y )  \ return a coordinate y near the beetle, but not the same
\   0  begin 
\     drop  beetle_y @ dup
\     2+- [ arena_top 1+ ] literal max [ arena_bottom 1- ] literal min dup
\     rot <>  
\   until  
\   ;
: proper_y  ( -- y )  \ return a coordinate y near the center of the screen, but not the same than the beetle's y
  [ arena_bottom arena_top halfway ] literal
  begin  dup beetle_y @ =
  while  2+-
  repeat
  ;
: ."again?"  ( -- )  \ print the final message, but not at the beetle's line
  proper_y [ arena_right arena_left halfway 23 2 / - ] literal at
  ." GAME OVER. AGAIN? (Y/N)"
  ;
: finish?  ( -- f )  ."again?" no?  ;

\ -----------------------------
\ Main

: round  ( -- )
  begin
    brick beetle  crashed? @ surrounded? or
  until
  ;
: run  ( -- )
  begin
    init round  finish?
  until
  ;


Downloads