Siderator
Description of the page content
Game written in Ace Forth for the Jupiter Ace.
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:
Then stars become fast rays:
And just before the spaceship breaks down, it's almost impossible to see the stars:
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
- siderator.fs (6.00 KiB) (source in plain text format)
- siderator.dic (2.50 KiB) (Forth dictionary in the format of the xAce emulator)