Siderator
Descripción del contenido de la página
Juego escrito en Ace Forth para la Jupiter Ace.
Etiquetas:
Siderator es mi versión de Sideras. La escribí porque el juego original, de autor desconocido, no estaba escrito con el estilo propio de Forth (de hecho usé algunas muestras de su código en mi artículo Programar en Forth con el estilo de Forth); pero una vez reescrito, el código me pidió a gritos algunas mejoras más, como usar gráficos; que la velocidad fuera aumentando; y que las estrellas cambiaran de aspecto en función de la velocidad...
Pantallazos
La nave necesita tiempo para alcanzar una gran velocidad; mientras tanto es posible contemplar las estrellas:
A partir de cierta velocidad las estrellas se convierten en rápidos haces de luz:
Y cuando los tornillos de la nave empiezan a crujir, casi no es posible ver las estrellas:
Código fuente
: task ;
: \ 0 word drop ; immediate
: ( begin ascii ) word c@ 31 = while retype repeat ; immediate
\ Siderator
\ A game for the Jupiter Ace
\ Copyright (C) 2009,2010,2013 Marcos Cruz (http://programandala.net)
\ License: http://programandala.net/license
\ History
\ 2009-06-06 First draft, based on Sideras by unknown author.
\ 2009-06-07 First working version.
\ 2009-06-08 Craft graphic, AT@ .
\ 2009-06-09 Star graphics, HALT-STARS , RECORD .
\ 2009-06-18 Almost finished.
\ 2009-06-19 Increasing number of stars, formatted panel numbers, inner loop reorganized to prevent too much flickering, .OBJECTIVE .
\ 2009-06-20 Some words renamed. Bug fixed: X wasn't reseted in INIT .
\ 2010-01-10 Added missing comment.
\ 2010-01-18 Little changes in some stack comments.
\ 2013-08-22 Typo fixed in comment.
\ Improvements on the original Sideras
\ Code rewritten from scratch;
\ graphics;
\ increasing speed;
\ increasing number of stars depending on speed;
\ stars change depending on the speed;
\ speed, distance and record panel;
\ no sound (the outer space is quite quiet).
\ Known bugs (or special features)
\ The craft's autodestruction creates a new star.
\ Road map (planned future versions of Siderator)
\ Siderator 2: Judgement Day
\ Siderator 3: Rise of the machines
\ Siderator Salvation
forth definitions decimal
\ Game variables and constants
0 variable x
0 variable speed
0 variable parsecs
0 variable record
999 constant max-speed
ascii 5 constant left-key
ascii 8 constant right-key
ascii q constant quit-key
\ System variables and addresses
15403 constant FRAMES
11264 constant 'charset
8192 constant 'screen
\ Common words
: bounds ( a1 u -- a2 a3 ) over + swap ;
: cmove ( a0 a1 u -- ) bounds do dup c@ i c! 1+ loop drop ;
: pause ( -- ) begin inkey until ;
\ Pseudo random number generator
\ (as of the Jupiter Ace manual)
0 variable seed
: seedon ( -- n )
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 ! ;
\ Graphics
\ The graphics are kept in the dictionary and then copied to the charset.
\ It's a waste of memory, but simpler than saving them in a separate file.
: 'char ( c -- a ) 8 * 'charset + ;
\ : char! ( b0...b7 c -- ) 'char dup 8 + do i c! -1 +loop ;
: graph-move ( a c -- ) 'char 8 cmove ;
: char-copy ( c0 c1 -- ) swap 'char swap graph-move ;
1 constant star0-char
2 constant star1-char
3 constant star2-char
4 constant star3-char
5 constant craft-char
base c@ 2 base c!
create craft-graph
10000001 c,
10000001 c,
11000011 c,
11100111 c,
11111111 c,
01100110 c,
00111100 c,
00011000 c,
create star1-graph
00011000 c,
00011000 c,
00011000 c,
00011000 c,
00011000 c,
00011000 c,
00011000 c,
00011000 c,
create star3-graph
00001000 c,
00000000 c,
00001000 c,
00000000 c,
00001000 c,
00000000 c,
00001000 c,
00000000 c,
base c!
: graphs ( -- )
craft-graph craft-char graph-move
ascii * star0-char char-copy
star1-graph star1-char graph-move
ascii | star2-char char-copy
star3-graph star3-char graph-move
;
\ Keyboard
: k= ( c -- f ) inkey = ;
: left? ( -- f ) left-key k= ;
: right? ( -- f ) right-key k= ;
: left ( -- ) x @ left? - 0 max x ! ;
: right ( -- ) x @ right? + 31 min x ! ;
: rudder ( -- ) right left ;
\ Stars
4 constant #stars
: star-coords ( -- y x ) 22 31 ;
: .star ( c -- ) star-coords 1+ rnd at emit ;
: star/speed ( -- c ) speed @ #stars 1- max-speed */ 1+ ;
: scroll ( -- ) star-coords at cr cr ;
: .stars ( -- ) star/speed dup 0 do dup .star loop drop ;
: star<> ( c -- f ) #stars > ;
: star= ( c -- f ) star<> 0= ;
\ Craft
: craft-coords ( -- y x ) 10 x @ ;
: craft-at ( -- ) craft-coords at ;
: -craft ( -- ) craft-at space ;
: .craft ( -- ) craft-at craft-char emit ;
\ Speed, parsecs, record
: .datum ( u -- ) 0 <# # # # #> type space ;
: delay ( -- ) max-speed speed @ - 2 / 0 do loop ;
: .speed ( -- ) ." Speed:" speed @ .datum ;
: +speed ( u1 -- u2 )
dup 10 / 1 max parsecs @ 4 mod 0= * + max-speed min
;
: faster ( -- ) speed @ +speed speed ! ;
: .parsecs ( -- ) ." Parsecs:" parsecs @ .datum ;
: farther ( -- ) parsecs @ 1+ parsecs ! ;
: .record ( -- ) ." Record:" record @ .datum ;
: .info ( -- ) 0 dup at .speed .parsecs .record ;
\ End
: blast-delay ( -- ) 32 0 do loop ;
: (blast) ( -- ) .craft blast-delay craft-at star0-char emit blast-delay ;
: blast ( -- ) 256 0 do (blast) loop ;
: at@ ( y x -- c ) swap 32 * + 'screen + c@ ;
: halt ( -- ) 'screen 768 bounds do i c@ star= if star0-char i c! then loop ;
: safe? ( -- f ) craft-coords at@ star<> ;
: autodestruction? ( -- f ) quit-key k= ;
: continue? ( -- f ) safe? autodestruction? 0= and ;
: new-record ( -- ) parsecs @ record @ > if parsecs @ record ! then ;
: game-over ( -- ) blast halt 11 dup at ." GAME OVER" new-record .info 22 0 at vis ;
\ Init
: .about ( -- )
cr ." Siderator"
cr
cr ." Copyright (C) Marcos Cruz"
cr ." http://programandala.net"
cr ." License:"
cr ." http://programandala.net/license"
cr ." Version: 2010-01-10"
;
: .objective ( -- )
cr ." Your objective is to travel as"
cr ." much parsecs as possible"
cr ." while dodging the stars."
cr ." Anyway you're supposed to die"
cr ." before the 1000th parsec"
cr ." because four digits would ruin"
cr ." the beautiful panel."
;
: .keys ( -- )
cr ." Rudder keys: "
left-key emit space right-key emit
cr ." Autodestruction key: "
quit-key emit
;
: .instructions ( -- ) .objective cr .keys ;
: wait ( -- ) cr cr ." Press any key to start." pause ;
: init-screen ( -- ) graphs invis cls .about cr .instructions wait cls ;
: 4+- ( u1 -- u2 ) 9 rnd 4 - + ;
: init ( -- ) 0 randomize init-screen 15 4+- x ! 0 parsecs ! 0 speed ! ;
\ Main
: siderator ( -- )
init
begin
-craft scroll
faster farther .info
continue?
while
rudder .craft .stars
delay
repeat
game-over
;
: run ( -- ) siderator ;
cls
\ Type RUN
\ and press ENTER to start.
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.