Beetle Brick Chase
Description of the page content
Game written in Ace Forth for the Jupiter Ace.
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:
The beetle dodges to the right of the arena:
Crash effect:
Another way to die, surrounded by bricks:
Final screen:
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
- beetle_brick_chase.fs (13.92 KiB) (source in plain text format)
- bbc.dic (4.34 KiB) (Forth dictionary in the format of the xAce emulator).