Beetle Brick Chase
Descripción del contenido de la página
Juego escrito en Ace Forth para la Jupiter Ace.
El origen de este programa
La revista ZX fue la primera publicación que compré tras tener mi ZX Spectrum. Sus primeros números eran de modesta apariencia; sus páginas estaban ocupadas casi exclusivamente por listados de programas en BASIC, no pocos para la computadora ZX81, que aún tenía muchos seguidores. El primer número salió en 1983. La seguí comprando hasta el número 14, de enero de 1985. Algo similar me ocurrió con la revista TodoSpectrum, que empezó posteriormente y que compré durante varios números. Ninguna de ellas podría competir con la excepcional Microhobby, sin duda la mejor publicación en castellano sobre ZX Spectrum, que coleccioné completa hasta su último número, el 217, en enero de 1992. Por fortuna todas aquellas publicaciones han sido digitalizadas por antiguos lectores.
Esta introducción viene a cuento porque el programa que publico en esta página, Beetle Brick Chase, es una versión que he escrito en Ace Forth, para la Jupiter Ace, del programa Escarabajo publicado en el número 1 de ZX. En el listado no hay ninguna referencia a su autor.
¿Por qué escribir una versión en Forth de un sencillo jueguecito en Sinclair BASIC de hace veintisiete años? ¿Y por qué hacerlo precisamente para la Jupiter Ace, una computadora de aquella época que apenas usa ya un puñado de personas en el mundo? La respuesta es muy sencilla: ¿Y por qué no?
La programación es apasionante; es un ejercicio intelectual y creativo extraordinario. Por una parte, tras cerca de treinta años programando, sigo sin conocer otro lenguaje de programación más creativo, más flexible, más ingenioso, más liberador, más potente, más sencillo, más gratificante y más poético que Forth. Y por otra parte ninguna de las máquinas actuales, con su derroche de recursos y sus complejísimos sistemas operativos, me ha producido nunca la misma sensación de libertad y aprendizaje ilimitado que disfruté durante más de una década con la ZX Spectrum, y que ofrecía también la mayoría de las computadoras domésticas de su generación, como la Jupiter Ace. Por tanto la combinación es perfecta: programar en Forth para una microcomputadora de los años 1980 es un ejercicio tan instructivo como placentero. ¿Son bastantes porqués?
Por supuesto, programé algunas mejoras respecto al juego original, como menciono (en inglés) en el código fuente, y que son las siguientes:
- El gráfico del escarabajo varía según la dirección y sentido del movimiento.
- En varios lugares del código he introducido cálculos al azar, para darle mayor realismo.
- No hay sonidos. Pocos considerarían esto una mejora, pero yo sí. Los escarabajos son muy silenciosos.
- Hay tres efectos gráficos para el final del juego: el choque con un ladrillo, la locura del escarabajo y su muerte por inanición (este último no se aprecia con el emulador xAce).
Una posible mejora para una futura versión sería hacer el gráfico animado, por ejemplo que moviera las patitas.
Argumento
El juego se resume fácilmente: Eres un escarabajo y hagas lo que hagas vas a morir. Eso es todo. Cuanto más tiempo te mantengas con vida, más puntos lograrás. No es un gran consuelo, pero es lo que hay. Para ser más precisos, no conseguirás más puntos por dejar pasar el tiempo sino por cada pasito que des. De modo que muévete. Deberás esquivar los ladrillos que caen de repente a tu lado. No debes temer que te aplasten, porque nunca acertarán, pero si vas demasiado rápido podrías chocar con uno de ellos, lo cual te mataría instantáneamente. La segunda forma de morir que tienes es más elaborada: Si dejas que los ladrillos te cerquen, te volverás loco, darás vueltas en tu encierro durante un ratito y terminarás muriendo de hambre: tu cuerpo se desintegrará poco a poco.
Por supuesto se trata de un juego de los de verdad, puro realismo, y por ello el protagonista no tiene vidas de repuesto ni chorradas de esas. Tampoco hay, como ya he dicho, ningún tipo de sonido (ni falta que hace), para que nada distraiga.
Pantallazos
Las capacidades gráficas de la Jupiter Ace son muy modestas. Por ejemplo, no tiene otros colores que un negro y un blanco preciosos. Eso no impide que haya algunos juegos por ahí para esta máquina (no este mío precisamente) con un aspecto muy elaborado. Por otra parte, las limitaciones gráficas de la computadora animan a centrarse en la programación de lo más interesante: los algoritmos que hacen el juego entretenido.
Pantalla de presentación con las instrucciones:
Momento del juego con el escarabajo huyendo hacia la derecha:
Instantánea del efecto del choque contra un ladrillo:
Otra forma más lenta de morir, rodeado por los ladrillos:
Pantalla final. ¿Otra partidita?:
Código fuente
: 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
;
Descargas
El fichero FS contiene el código fuente en formato de texto simple. Se puede usar en cualquier emulador de Jupiter Ace que acepte como entrada de teclado un fichero de texto. El fichero DIC es una variante del formato TAP usada por el emulador xAce.