363 lines
6.6 KiB
Forth
363 lines
6.6 KiB
Forth
( Space invaders JCB 10:43 11/18/10)
|
|
|
|
: whereis ( t -- x y )
|
|
>r
|
|
d# 384 r@ sin* d# 384 +
|
|
r@ d# 4 rshift d# 32 r> 2* sin* +
|
|
;
|
|
|
|
56 constant nsprites
|
|
|
|
nsprites array invx
|
|
nsprites array invy
|
|
nsprites array alive
|
|
nsprites array invnext
|
|
nsprites array anim
|
|
|
|
: invload ( i -- ) \ load sprite i
|
|
\ s" sprite " type dup . s" at " type dup invx @ . dup invy @ . cr
|
|
dup invx @ swap
|
|
dup invy @ swap
|
|
dup anim @ swap
|
|
d# 7 and
|
|
tuck cells vga_spritep + !
|
|
sprite!
|
|
;
|
|
|
|
: inv-makedl ( -- )
|
|
erasedl
|
|
nsprites 0do
|
|
\ invy -ve load sprite; +ve gives the dl offset
|
|
i alive @ if
|
|
i invy @ dup 0< if
|
|
drop i invload
|
|
else
|
|
dup d# 512 < if
|
|
\ dl[y] -> invnext[i]
|
|
\ i -> dl[y]
|
|
cells dl + dup
|
|
@ i invnext !
|
|
i swap !
|
|
else
|
|
drop
|
|
then
|
|
then
|
|
then
|
|
loop
|
|
;
|
|
|
|
: inv-chase
|
|
d# 512 0do
|
|
begin vga-line@ i = until
|
|
\ s" line" type i . cr
|
|
i cells dl + @
|
|
begin
|
|
dup d# 0 >=
|
|
while
|
|
dup invload
|
|
invnext @
|
|
repeat
|
|
loop
|
|
;
|
|
|
|
: born ( x y i ) \ sprite i born
|
|
dup alive on
|
|
tuck invy !
|
|
invx !
|
|
;
|
|
|
|
: kill ( i -- ) \ kill sprite i
|
|
d# 512 over invy !
|
|
alive off
|
|
;
|
|
|
|
: isalien ( u -- f)
|
|
d# 6 and d# 6 <> ;
|
|
|
|
: moveto ( i -- ) \ move invader i to current position
|
|
dup d# 6 and d# 6 <>
|
|
over alive @ and if
|
|
>r
|
|
frame @ r@ d# 7 and d# 8 * + whereis
|
|
r@ d# 3 rshift d# 40 * +
|
|
r@ invy !
|
|
r> invx !
|
|
else
|
|
drop
|
|
then
|
|
;
|
|
|
|
: bomb ( u -- u ) d# 3 lshift d# 6 + ;
|
|
: shot ( u -- u ) d# 3 lshift d# 7 + ;
|
|
|
|
8 array lowest
|
|
|
|
: findlowest
|
|
d# 8 0do d# -1 i lowest ! loop
|
|
d# 48 0do
|
|
i alive @ if
|
|
i dup d# 7 and lowest !
|
|
then
|
|
loop
|
|
;
|
|
|
|
create bias 0 , 1 , 2 , 3 , 4 , 5 , 0 , 5 ,
|
|
: rand6
|
|
time @ d# 7 and cells bias + @
|
|
;
|
|
|
|
2variable bombalarm
|
|
variable nextbomb
|
|
|
|
2variable shotalarm
|
|
variable nextshot
|
|
|
|
variable playerx
|
|
variable lives
|
|
2variable score
|
|
variable dying
|
|
|
|
32 constant girth
|
|
|
|
: 1+mod6 ( a )
|
|
dup @ dup d# 5 = if d# -5 else d# 1 then + swap ! ;
|
|
|
|
: .status
|
|
'emit @ >r ['] vga-emit 'emit !
|
|
|
|
home
|
|
s" LIVES " type lives @ .
|
|
d# 38 d# 0 vga-at-xy
|
|
s" SCORE " type score 2@ <# # # # # # # #> type
|
|
cr
|
|
|
|
lives @ 0= if
|
|
['] vga-bigemit 'emit !
|
|
d# 8 d# 7 vga-at-xy s" GAME" type
|
|
d# 8 d# 17 vga-at-xy s" OVER" type
|
|
then
|
|
|
|
r> 'emit !
|
|
;
|
|
|
|
: newlife
|
|
d# -1 lives +! .status
|
|
d# 0 dying !
|
|
d# 100 playerx !
|
|
;
|
|
|
|
: parabolic ( dx dy i -- ) \ move sprite i in parabolic path
|
|
>r
|
|
swap r@ invx +!
|
|
dying @ d# 3 rshift +
|
|
r> invy +!
|
|
;
|
|
|
|
: exploding
|
|
d# 3 d# -4 d# 48 parabolic
|
|
d# -3 d# -4 d# 49 parabolic
|
|
d# -4 d# -3 d# 50 parabolic
|
|
d# 4 d# -3 d# 51 parabolic
|
|
d# -5 d# -2 d# 52 parabolic
|
|
d# 5 d# -2 d# 53 parabolic
|
|
d# 1 d# -2 d# 55 parabolic
|
|
;
|
|
|
|
: @xy ( i -- x y )
|
|
dup invx @ swap invy @ ;
|
|
|
|
: dist ( u1 u2 )
|
|
invert + dup 0< xor ;
|
|
|
|
: fall
|
|
d# 6 0do
|
|
i bomb
|
|
d# 4 over invy +!
|
|
@xy d# 470 dist d# 16 < swap
|
|
playerx @ dist girth < and
|
|
dying @ 0= and if
|
|
d# 1 dying !
|
|
then
|
|
loop
|
|
;
|
|
|
|
: trigger \ if shotalarm expired, launch new shot
|
|
shotalarm isalarm if
|
|
d# 400000. shotalarm setalarm
|
|
playerx @ d# 480
|
|
nextshot @ shot born
|
|
nextshot 1+mod6
|
|
then
|
|
;
|
|
|
|
: collide ( x y -- u )
|
|
d# 48 0do
|
|
i isalien i alive @ and if
|
|
over i invx @ dist d# 16 <
|
|
over i invy @ dist d# 16 < and if
|
|
2drop i unloop exit
|
|
then
|
|
then
|
|
loop
|
|
2drop
|
|
d# -1
|
|
;
|
|
|
|
: rise
|
|
d# 6 0do
|
|
i shot >r r@ alive @ if
|
|
d# -5 r@ invy +!
|
|
r@ invy @ d# -30 < if r@ kill then
|
|
r@ @xy collide dup 0< if
|
|
drop
|
|
else
|
|
kill r@ kill
|
|
d# 10. score 2@ d+ score 2!
|
|
.status
|
|
then
|
|
then
|
|
r> drop
|
|
loop
|
|
;
|
|
|
|
: doplayer
|
|
lives @ if
|
|
dying @ 0= if
|
|
buttons >r
|
|
|
|
girth 2/ playerx @ <
|
|
r@ pb2 and and if
|
|
d# -4 playerx +!
|
|
then
|
|
|
|
playerx @ d# 800 girth 2/ - <
|
|
r@ pb3 and and if
|
|
d# 4 playerx +!
|
|
then
|
|
|
|
r> pb4 and if
|
|
trigger
|
|
\ else trigger
|
|
then
|
|
|
|
d# 6 0do
|
|
frame @ d# 3 lshift i d# 42 * +
|
|
girth swap sin* playerx @ +
|
|
d# 480
|
|
i d# 48 +
|
|
dup anim on
|
|
born
|
|
loop
|
|
playerx @ d# 470 d# 55 born
|
|
else
|
|
exploding
|
|
d# 1 dying +!
|
|
dying @ d# 100 > if
|
|
newlife
|
|
then
|
|
then
|
|
then
|
|
;
|
|
|
|
create cscheme
|
|
h# 400 ,
|
|
h# 440 ,
|
|
h# 040 ,
|
|
h# 044 ,
|
|
h# 004 ,
|
|
h# 404 ,
|
|
h# 340 ,
|
|
h# 444 ,
|
|
|
|
: invaders-cold
|
|
vga-page
|
|
d# 16384 0do
|
|
h# 208000. 2/ i s>d d+ flash@
|
|
i vga_spritea ! vga_spriteport !
|
|
loop
|
|
|
|
vga_addsprites on
|
|
rainbow
|
|
|
|
\ vga_spritep d# 6 cells + on
|
|
|
|
\ everything dead
|
|
nsprites 0do
|
|
i kill
|
|
loop
|
|
|
|
\ all aliens alive
|
|
d# 48 0do
|
|
i isalien i alive !
|
|
loop
|
|
|
|
d# 500000. bombalarm setalarm
|
|
d# 0 nextbomb !
|
|
d# 100000. shotalarm setalarm
|
|
d# 0 nextshot !
|
|
d# 4 lives !
|
|
d# 0. score 2!
|
|
|
|
newlife
|
|
|
|
time@ xor seed !
|
|
d# 0 frame !
|
|
d# 48 0do i moveto loop
|
|
;
|
|
|
|
0 [IF]
|
|
: escape
|
|
vision isalarm next? or ;
|
|
: restart
|
|
vision isalarm sw2_n @ 0= or ;
|
|
[ELSE]
|
|
: escape
|
|
next? ;
|
|
: restart
|
|
sw2_n @ 0= ;
|
|
[THEN]
|
|
|
|
: gameloop
|
|
invaders-cold
|
|
begin
|
|
depth if snap then
|
|
inv-makedl
|
|
depth if snap then
|
|
inv-chase
|
|
depth if snap then
|
|
frame @ 1+ frame !
|
|
d# 48 0do i moveto loop
|
|
findlowest
|
|
bombalarm isalarm if
|
|
d# 800000. bombalarm setalarm
|
|
rand6 lowest @ dup 0< if
|
|
drop
|
|
else
|
|
dup invx @ swap invy @
|
|
dup d# 460 > if d# 1 dying ! then
|
|
nextbomb @ bomb born
|
|
nextbomb 1+mod6
|
|
then
|
|
then
|
|
depth if snap then
|
|
fall
|
|
depth if snap then
|
|
rise
|
|
depth if snap then
|
|
doplayer
|
|
depth if snap then
|
|
escape if exit then
|
|
again
|
|
;
|
|
|
|
: invaders-main
|
|
invaders-cold
|
|
d# 9000000. vision setalarm
|
|
|
|
gameloop
|
|
snap
|
|
|
|
frame @ . s" frames" type cr
|
|
;
|
|
|