Heat Seeker

Description of the page content

Game written in Ace Forth for the Jupiter Ace.

Tags:

This simple game was born like an exercise rewriting, with Forth style, a Forth game.

Source code




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

Downloads