Siderator

Priskribo de la ĉi-paĝa enhavo

Ludo por Jupiter Ace.

Etikedoj:

Siderator estas mia versio de Sideras (paĝo en la hispana lingvo). Mi verkis ĝin ĉar la originala ludo, de nekonata aŭtoro, estis verkita en Fortho sed sen la stilo de Fortho; fakte mi uzis pecon ĝian kiel ekzemplon en mia artikolo pri la Fortho-stilo (hispanlingva). Mi faris kromajn modifojn: mi uzis grafikojn; kreskanta rapido; la steloj ŝanĝiĝas depende de la rapido de la spacŝipo...

Ekranfotoj

La spacoŝipo bezonas tempon por atingi rapidegon; dume eblas rigardadi la stelojn:

Siderator

Post certa rapido, steloj iĝas rapidaj lumradioj;

Siderator

Kaj kiam la spacoŝipaj ŝraŭboj ektremas, apene eblas vidi la stelojn:

Siderator

Fontkodo



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

Deŝutoj