123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362 |
- ( 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
- ;
|