Siderator

Descripción del contenido de esta página

Juego escrito en Ace Forth para la Jupiter Ace.

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:

Siderator

A partir de cierta velocidad las estrellas se convierten en rápidos haces de luz:

Siderator

Y cuando los tornillos de la nave empiezan a crujir, casi no es posible ver las estrellas:

Siderator

Listado




: 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 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.

\ 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: Judgment 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.

Descarga

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.

Páginas relacionadas