Siderator

Description of the page content

Game written in Ace Forth for the Jupiter Ace.

Tags:

Siderator is my version of Sideras (page in Spanish). I wrote it because the original game, by unknown author, was written in Forth but without a trace of the Forth style; in fact I used some pieces of its code as examples in my article about the Forth style. Besides rewriting the code from scratch in pure Forth, I also improved it: graphics characters; increasing speed; stars change depending on the craft's speed...

Screenshots

It takes time to achieve a high speed; meanwhile, you can look at the stars:

Siderator

Then stars become fast rays:

Siderator

And just before the spaceship breaks down, it's almost impossible to see the stars:

Siderator

Source code



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

Downloads