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.