Heat Seeker
Descripción del contenido de la página
Juego escrito en Ace Forth para la Jupiter Ace.
Etiquetas:
Este sencillo programa empezó como un ejercicio para reescribir con el estilo de Forth el código de un juego.
Código fuente
: \ 0 word drop ; immediate
\ Heat Seeker
\ A game for the Jupiter Ace
\ Copyright (C) 2009 Marcos Cruz (http://programandala.net)
\ License: http://programandala.net/license
\ Based on "Chase", by Andrew Curtis, 1983:
\ http://www.jupiter-ace.co.uk/listing_PCWeekly_830127p18.html
\ History
\ 2009-06-15 First version.
\ 2009-06-16 Inner loop a bit simplified.
forth definitions decimal
\ Man
10 variable ym
15 variable xm
ascii x constant man_char
ascii 5 constant left
ascii 6 constant up
ascii 7 constant down
ascii 8 constant right
: at_man ( -- ) ym @ xm @ at ;
: .man ( -- ) at_man man_char emit ;
: -man ( -- ) at_man space ;
: key ( c -- u ) inkey = 2 * ;
: man>x ( -- )
xm @ left key - right key + 1 max 30 min xm ! ;
: man>y ( -- ) ym @ up key - down key + 1 max 20 min ym ! ;
: man> ( -- ) man>x man>y ;
: man ( -- ) -man man> .man ;
\ Missile
1 variable yr
1 variable xr
ascii * constant rocket_char
: at_rocket ( -- ) yr @ xr @ at ;
: .rocket ( -- ) at_rocket rocket_char emit ;
: -rocket ( -- ) at_rocket space ;
: +coord ( coord1 coord2 -- coord3 ) over > + ;
: -coord ( coord0 coord1 coord2 -- coord3 ) < negate + ;
: rocket>y ( -- ) yr @ ym @ +coord ym @ yr @ -coord yr ! ;
: rocket>x ( -- ) xr @ xm @ +coord xm @ xr @ -coord xr ! ;
: rocket> ( -- ) rocket>x rocket>y ;
: rocket ( -- ) -rocket rocket> .rocket ;
\ Instructions
: .about ( -- )
cr ." Heat Seeker"
cr
cr ." Copyright (C) 2009 Marcos Cruz"
cr ." http://programandala.net"
cr ." License:"
cr ." http://programandala.net/license"
;
: .key ( c -- ) emit space ;
: .keys ( -- ) left .key up .key down .key right .key ;
: .player ( c -- ) ascii ( emit emit ascii ) emit ;
: .objective ( -- )
cr ." The objective is to dodge the"
cr ." heat guided missile (" rocket_char .player ascii ) emit
cr ." for as long as possible."
cr ." You ( " man_char .player ." ) can move twice as"
cr ." fast as the missile but it can"
cr ." move diagonally..."
;
: .start ( -- ) cr ." Type RUN and press ENTER." ;
: .press ( -- ) cr ." Press any key to start." ;
: pause ( -- ) begin inkey until ;
: .instructions ( -- ) cr ." Control keys: " .keys cr .objective ;
\ Init
: page ( -- ) cls invis ;
: init_coords ( -- ) 10 ym ! 15 xm ! 1 dup yr ! xr ! ;
: init_round ( -- ) cls init_coords ;
: init_game ( -- ) page .about cr .instructions cr .press pause cls ;
\ Yes/No
: 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 ;
: more? ( -- f ) 11 13 at ." More?" y/n ascii y = ;
\ End
: (blast) ( -- ) .man 64 0 do loop .rocket ;
: blast ( -- ) 256 0 do (blast) loop -rocket ;
: end ( -- ) cls ." Bye!" vis ;
: game_over ( -- ) blast 10 11 at ." Game Over" 250 1000 beep ;
\ Main
: bleep ( -- ) 250 70 beep ;
: leave? ( -- f ) more? 0= ;
: crash? ( -- f ) ym @ yr @ = xm @ xr @ = and ;
: (round) ( -- ) bleep man rocket ;
: round ( -- )
init_round begin (round) crash? until game_over
;
: heat_seeker ( -- ) init_game begin round leave? until end ;
: run ( -- ) heat_seeker ;
page .about cr .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.