invaders.fs 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362
  1. ( Space invaders JCB 10:43 11/18/10)
  2. : whereis ( t -- x y )
  3. >r
  4. d# 384 r@ sin* d# 384 +
  5. r@ d# 4 rshift d# 32 r> 2* sin* +
  6. ;
  7. 56 constant nsprites
  8. nsprites array invx
  9. nsprites array invy
  10. nsprites array alive
  11. nsprites array invnext
  12. nsprites array anim
  13. : invload ( i -- ) \ load sprite i
  14. \ s" sprite " type dup . s" at " type dup invx @ . dup invy @ . cr
  15. dup invx @ swap
  16. dup invy @ swap
  17. dup anim @ swap
  18. d# 7 and
  19. tuck cells vga_spritep + !
  20. sprite!
  21. ;
  22. : inv-makedl ( -- )
  23. erasedl
  24. nsprites 0do
  25. \ invy -ve load sprite; +ve gives the dl offset
  26. i alive @ if
  27. i invy @ dup 0< if
  28. drop i invload
  29. else
  30. dup d# 512 < if
  31. \ dl[y] -> invnext[i]
  32. \ i -> dl[y]
  33. cells dl + dup
  34. @ i invnext !
  35. i swap !
  36. else
  37. drop
  38. then
  39. then
  40. then
  41. loop
  42. ;
  43. : inv-chase
  44. d# 512 0do
  45. begin vga-line@ i = until
  46. \ s" line" type i . cr
  47. i cells dl + @
  48. begin
  49. dup d# 0 >=
  50. while
  51. dup invload
  52. invnext @
  53. repeat
  54. loop
  55. ;
  56. : born ( x y i ) \ sprite i born
  57. dup alive on
  58. tuck invy !
  59. invx !
  60. ;
  61. : kill ( i -- ) \ kill sprite i
  62. d# 512 over invy !
  63. alive off
  64. ;
  65. : isalien ( u -- f)
  66. d# 6 and d# 6 <> ;
  67. : moveto ( i -- ) \ move invader i to current position
  68. dup d# 6 and d# 6 <>
  69. over alive @ and if
  70. >r
  71. frame @ r@ d# 7 and d# 8 * + whereis
  72. r@ d# 3 rshift d# 40 * +
  73. r@ invy !
  74. r> invx !
  75. else
  76. drop
  77. then
  78. ;
  79. : bomb ( u -- u ) d# 3 lshift d# 6 + ;
  80. : shot ( u -- u ) d# 3 lshift d# 7 + ;
  81. 8 array lowest
  82. : findlowest
  83. d# 8 0do d# -1 i lowest ! loop
  84. d# 48 0do
  85. i alive @ if
  86. i dup d# 7 and lowest !
  87. then
  88. loop
  89. ;
  90. create bias 0 , 1 , 2 , 3 , 4 , 5 , 0 , 5 ,
  91. : rand6
  92. time @ d# 7 and cells bias + @
  93. ;
  94. 2variable bombalarm
  95. variable nextbomb
  96. 2variable shotalarm
  97. variable nextshot
  98. variable playerx
  99. variable lives
  100. 2variable score
  101. variable dying
  102. 32 constant girth
  103. : 1+mod6 ( a )
  104. dup @ dup d# 5 = if d# -5 else d# 1 then + swap ! ;
  105. : .status
  106. 'emit @ >r ['] vga-emit 'emit !
  107. home
  108. s" LIVES " type lives @ .
  109. d# 38 d# 0 vga-at-xy
  110. s" SCORE " type score 2@ <# # # # # # # #> type
  111. cr
  112. lives @ 0= if
  113. ['] vga-bigemit 'emit !
  114. d# 8 d# 7 vga-at-xy s" GAME" type
  115. d# 8 d# 17 vga-at-xy s" OVER" type
  116. then
  117. r> 'emit !
  118. ;
  119. : newlife
  120. d# -1 lives +! .status
  121. d# 0 dying !
  122. d# 100 playerx !
  123. ;
  124. : parabolic ( dx dy i -- ) \ move sprite i in parabolic path
  125. >r
  126. swap r@ invx +!
  127. dying @ d# 3 rshift +
  128. r> invy +!
  129. ;
  130. : exploding
  131. d# 3 d# -4 d# 48 parabolic
  132. d# -3 d# -4 d# 49 parabolic
  133. d# -4 d# -3 d# 50 parabolic
  134. d# 4 d# -3 d# 51 parabolic
  135. d# -5 d# -2 d# 52 parabolic
  136. d# 5 d# -2 d# 53 parabolic
  137. d# 1 d# -2 d# 55 parabolic
  138. ;
  139. : @xy ( i -- x y )
  140. dup invx @ swap invy @ ;
  141. : dist ( u1 u2 )
  142. invert + dup 0< xor ;
  143. : fall
  144. d# 6 0do
  145. i bomb
  146. d# 4 over invy +!
  147. @xy d# 470 dist d# 16 < swap
  148. playerx @ dist girth < and
  149. dying @ 0= and if
  150. d# 1 dying !
  151. then
  152. loop
  153. ;
  154. : trigger \ if shotalarm expired, launch new shot
  155. shotalarm isalarm if
  156. d# 400000. shotalarm setalarm
  157. playerx @ d# 480
  158. nextshot @ shot born
  159. nextshot 1+mod6
  160. then
  161. ;
  162. : collide ( x y -- u )
  163. d# 48 0do
  164. i isalien i alive @ and if
  165. over i invx @ dist d# 16 <
  166. over i invy @ dist d# 16 < and if
  167. 2drop i unloop exit
  168. then
  169. then
  170. loop
  171. 2drop
  172. d# -1
  173. ;
  174. : rise
  175. d# 6 0do
  176. i shot >r r@ alive @ if
  177. d# -5 r@ invy +!
  178. r@ invy @ d# -30 < if r@ kill then
  179. r@ @xy collide dup 0< if
  180. drop
  181. else
  182. kill r@ kill
  183. d# 10. score 2@ d+ score 2!
  184. .status
  185. then
  186. then
  187. r> drop
  188. loop
  189. ;
  190. : doplayer
  191. lives @ if
  192. dying @ 0= if
  193. buttons >r
  194. girth 2/ playerx @ <
  195. r@ pb2 and and if
  196. d# -4 playerx +!
  197. then
  198. playerx @ d# 800 girth 2/ - <
  199. r@ pb3 and and if
  200. d# 4 playerx +!
  201. then
  202. r> pb4 and if
  203. trigger
  204. \ else trigger
  205. then
  206. d# 6 0do
  207. frame @ d# 3 lshift i d# 42 * +
  208. girth swap sin* playerx @ +
  209. d# 480
  210. i d# 48 +
  211. dup anim on
  212. born
  213. loop
  214. playerx @ d# 470 d# 55 born
  215. else
  216. exploding
  217. d# 1 dying +!
  218. dying @ d# 100 > if
  219. newlife
  220. then
  221. then
  222. then
  223. ;
  224. create cscheme
  225. h# 400 ,
  226. h# 440 ,
  227. h# 040 ,
  228. h# 044 ,
  229. h# 004 ,
  230. h# 404 ,
  231. h# 340 ,
  232. h# 444 ,
  233. : invaders-cold
  234. vga-page
  235. d# 16384 0do
  236. h# 208000. 2/ i s>d d+ flash@
  237. i vga_spritea ! vga_spriteport !
  238. loop
  239. vga_addsprites on
  240. rainbow
  241. \ vga_spritep d# 6 cells + on
  242. \ everything dead
  243. nsprites 0do
  244. i kill
  245. loop
  246. \ all aliens alive
  247. d# 48 0do
  248. i isalien i alive !
  249. loop
  250. d# 500000. bombalarm setalarm
  251. d# 0 nextbomb !
  252. d# 100000. shotalarm setalarm
  253. d# 0 nextshot !
  254. d# 4 lives !
  255. d# 0. score 2!
  256. newlife
  257. time@ xor seed !
  258. d# 0 frame !
  259. d# 48 0do i moveto loop
  260. ;
  261. 0 [IF]
  262. : escape
  263. vision isalarm next? or ;
  264. : restart
  265. vision isalarm sw2_n @ 0= or ;
  266. [ELSE]
  267. : escape
  268. next? ;
  269. : restart
  270. sw2_n @ 0= ;
  271. [THEN]
  272. : gameloop
  273. invaders-cold
  274. begin
  275. depth if snap then
  276. inv-makedl
  277. depth if snap then
  278. inv-chase
  279. depth if snap then
  280. frame @ 1+ frame !
  281. d# 48 0do i moveto loop
  282. findlowest
  283. bombalarm isalarm if
  284. d# 800000. bombalarm setalarm
  285. rand6 lowest @ dup 0< if
  286. drop
  287. else
  288. dup invx @ swap invy @
  289. dup d# 460 > if d# 1 dying ! then
  290. nextbomb @ bomb born
  291. nextbomb 1+mod6
  292. then
  293. then
  294. depth if snap then
  295. fall
  296. depth if snap then
  297. rise
  298. depth if snap then
  299. doplayer
  300. depth if snap then
  301. escape if exit then
  302. again
  303. ;
  304. : invaders-main
  305. invaders-cold
  306. d# 9000000. vision setalarm
  307. gameloop
  308. snap
  309. frame @ . s" frames" type cr
  310. ;