1 ! Copyright (C) 2006 Chris Double.
2 ! See http://factorcode.org/license.txt for BSD license.
31 "uchar" require-c-array
34 TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ;
35 CONSTANT: game-width 224
36 CONSTANT: game-height 256
38 : make-opengl-bitmap ( -- array )
39 game-height game-width 3 * * uchar <c-array> ;
41 : bitmap-index ( point -- index )
43 first2 game-width 3 * * swap 3 * + ;
45 : set-bitmap-pixel ( color point array -- )
46 #! 'color' is a {r g b}. Point is {x y}.
47 [ bitmap-index ] dip ! color index array
48 [ [ first ] 2dip set-nth ] 3keep
49 [ [ second ] 2dip [ 1 + ] dip set-nth ] 3keep
50 [ third ] 2dip [ 2 + ] dip set-nth ;
52 : get-bitmap-pixel ( point array -- color )
53 #! Point is a {x y}. color is a {r g b}
56 [ [ 1 + ] dip nth ] 2keep
57 [ 2 + ] dip nth 3array ;
59 CONSTANT: SOUND-SHOT 0
61 CONSTANT: SOUND-BASE-HIT 2
62 CONSTANT: SOUND-INVADER-HIT 3
63 CONSTANT: SOUND-WALK1 4
64 CONSTANT: SOUND-WALK2 5
65 CONSTANT: SOUND-WALK3 6
66 CONSTANT: SOUND-WALK4 7
67 CONSTANT: SOUND-UFO-HIT 8
69 : init-sound ( index cpu filename -- )
70 canonicalize-path swapd [ sounds>> nth AL_BUFFER ] dip
71 create-buffer-from-wav set-source-param ;
73 : init-sounds ( cpu -- )
75 [ 9 gen-sources swap (>>sounds) ] keep
76 [ SOUND-SHOT "resource:extra/space-invaders/resources/Shot.wav" init-sound ] keep
77 [ SOUND-UFO "resource:extra/space-invaders/resources/Ufo.wav" init-sound ] keep
78 [ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep
79 [ SOUND-BASE-HIT "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] keep
80 [ SOUND-INVADER-HIT "resource:extra/space-invaders/resources/InvHit.Wav" init-sound ] keep
81 [ SOUND-WALK1 "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep
82 [ SOUND-WALK2 "resource:extra/space-invaders/resources/Walk2.wav" init-sound ] keep
83 [ SOUND-WALK3 "resource:extra/space-invaders/resources/Walk3.wav" init-sound ] keep
84 [ SOUND-WALK4 "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep
85 [ SOUND-UFO-HIT "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
88 : cpu-init ( cpu -- cpu )
89 make-opengl-bitmap over (>>bitmap)
93 : <space-invaders> ( -- cpu )
94 space-invaders new cpu-init ;
96 : play-invaders-sound ( cpu sound -- )
97 swap sounds>> nth source-play ;
99 : stop-invaders-sound ( cpu sound -- )
100 swap sounds>> nth source-stop ;
102 : read-port1 ( cpu -- byte )
103 #! Port 1 maps the keys for space invaders
105 #! Bit 1 = two players button
106 #! Bit 2 = one player button
107 #! Bit 4 = player one fire
108 #! Bit 5 = player one left
109 #! Bit 6 = player one right
110 [ port1>> dup HEX: FE bitand ] keep
113 : read-port2 ( cpu -- byte )
114 #! Port 2 maps player 2 controls and dip switches
115 #! Bit 0,1 = number of ships
116 #! Bit 2 = mode (1=easy, 0=hard)
117 #! Bit 4 = player two fire
118 #! Bit 5 = player two left
119 #! Bit 6 = player two right
120 #! Bit 7 = show or hide coin info
121 [ port2i>> HEX: 8F bitand ] keep
122 port1>> HEX: 70 bitand bitor ;
124 : read-port3 ( cpu -- byte )
125 #! Used to compute a special formula
126 [ port4hi>> 8 shift ] keep
127 [ port4lo>> bitor ] keep
128 port2o>> shift -8 shift HEX: FF bitand ;
130 M: space-invaders read-port ( port cpu -- byte )
131 #! Read a byte from the hardware port. 'port' should
132 #! be an 8-bit value.
140 : write-port2 ( value cpu -- )
141 #! Setting this value affects the value read from port 3
144 : bit-newly-set? ( old-value new-value bit -- bool )
145 tuck bit? [ bit? not ] dip and ;
147 : port3-newly-set? ( new-value cpu bit -- bool )
148 [ port3o>> swap ] dip bit-newly-set? ;
150 : port5-newly-set? ( new-value cpu bit -- bool )
151 [ port5o>> swap ] dip bit-newly-set? ;
153 : write-port3 ( value cpu -- )
154 #! Connected to the sound hardware
155 #! Bit 0 = spaceship sound (looped)
157 #! Bit 2 = Your ship hit
158 #! Bit 3 = Invader hit
159 #! Bit 4 = Extended play sound
160 over 0 bit? over looping?>> not and [
161 dup SOUND-UFO play-invaders-sound
164 over 0 bit? not over looping?>> and [
165 dup SOUND-UFO stop-invaders-sound
168 2dup 0 port3-newly-set? [ dup SOUND-UFO play-invaders-sound ] when
169 2dup 1 port3-newly-set? [ dup SOUND-SHOT play-invaders-sound ] when
170 2dup 2 port3-newly-set? [ dup SOUND-BASE-HIT play-invaders-sound ] when
171 2dup 3 port3-newly-set? [ dup SOUND-INVADER-HIT play-invaders-sound ] when
174 : write-port4 ( value cpu -- )
175 #! Affects the value returned by reading port 3
180 : write-port5 ( value cpu -- )
182 #! Bit 0 = invaders sound 1
183 #! Bit 1 = invaders sound 2
184 #! Bit 2 = invaders sound 3
185 #! Bit 3 = invaders sound 4
186 #! Bit 4 = spaceship hit
187 #! Bit 5 = amplifier enabled/disabled
188 2dup 0 port5-newly-set? [ dup SOUND-WALK1 play-invaders-sound ] when
189 2dup 1 port5-newly-set? [ dup SOUND-WALK2 play-invaders-sound ] when
190 2dup 2 port5-newly-set? [ dup SOUND-WALK3 play-invaders-sound ] when
191 2dup 3 port5-newly-set? [ dup SOUND-WALK4 play-invaders-sound ] when
192 2dup 4 port5-newly-set? [ dup SOUND-UFO-HIT play-invaders-sound ] when
195 M: space-invaders write-port ( value port cpu -- )
196 #! Write a byte to the hardware port, where 'port' is
199 { 2 [ write-port2 ] }
200 { 3 [ write-port3 ] }
201 { 4 [ write-port4 ] }
202 { 5 [ write-port5 ] }
206 M: space-invaders reset ( cpu -- )
217 : gui-step ( cpu -- )
218 [ read-instruction ] keep ! n cpu
219 over get-cycles over inc-cycles
220 [ swap instructions nth call( cpu -- ) ] keep
221 [ pc>> HEX: FFFF bitand ] keep
224 : gui-frame/2 ( cpu -- )
227 over 16667 < [ ! cycles cpu
230 [ [ 16667 - ] dip (>>cycles) ] keep
231 dup last-interrupt>> HEX: 10 = [
232 HEX: 08 over (>>last-interrupt) HEX: 08 swap interrupt
234 HEX: 10 over (>>last-interrupt) HEX: 10 swap interrupt
238 : gui-frame ( cpu -- )
239 dup gui-frame/2 gui-frame/2 ;
241 : coin-down ( cpu -- )
242 [ port1>> 1 bitor ] keep (>>port1) ;
245 [ port1>> 255 1 - bitand ] keep (>>port1) ;
247 : player1-down ( cpu -- )
248 [ port1>> 4 bitor ] keep (>>port1) ;
250 : player1-up ( cpu -- )
251 [ port1>> 255 4 - bitand ] keep (>>port1) ;
253 : player2-down ( cpu -- )
254 [ port1>> 2 bitor ] keep (>>port1) ;
256 : player2-up ( cpu -- )
257 [ port1>> 255 2 - bitand ] keep (>>port1) ;
259 : fire-down ( cpu -- )
260 [ port1>> HEX: 10 bitor ] keep (>>port1) ;
263 [ port1>> 255 HEX: 10 - bitand ] keep (>>port1) ;
265 : left-down ( cpu -- )
266 [ port1>> HEX: 20 bitor ] keep (>>port1) ;
269 [ port1>> 255 HEX: 20 - bitand ] keep (>>port1) ;
271 : right-down ( cpu -- )
272 [ port1>> HEX: 40 bitor ] keep (>>port1) ;
274 : right-up ( cpu -- )
275 [ port1>> 255 HEX: 40 - bitand ] keep (>>port1) ;
278 TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
281 { T{ key-down f f "ESC" } [ t over (>>quit?) dup windowed?>> [ close-window ] [ drop ] if ] }
282 { T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
283 { T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] }
284 { T{ key-down f f "1" } [ cpu>> player1-down ] }
285 { T{ key-up f f "1" } [ cpu>> player1-up ] }
286 { T{ key-down f f "2" } [ cpu>> player2-down ] }
287 { T{ key-up f f "2" } [ cpu>> player2-up ] }
288 { T{ key-down f f "UP" } [ cpu>> fire-down ] }
289 { T{ key-up f f "UP" } [ cpu>> fire-up ] }
290 { T{ key-down f f "LEFT" } [ cpu>> left-down ] }
291 { T{ key-up f f "LEFT" } [ cpu>> left-up ] }
292 { T{ key-down f f "RIGHT" } [ cpu>> right-down ] }
293 { T{ key-up f f "RIGHT" } [ cpu>> right-up ] }
296 : <invaders-gadget> ( cpu -- gadget )
301 M: invaders-gadget pref-dim* drop { 224 256 } ;
303 M: invaders-gadget draw-gadget* ( gadget -- )
306 [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip
307 cpu>> bitmap>> glDrawPixels ;
309 CONSTANT: black { 0 0 0 }
310 CONSTANT: white { 255 255 255 }
311 CONSTANT: green { 0 255 0 }
312 CONSTANT: red { 255 0 0 }
314 : addr>xy ( addr -- point )
315 #! Convert video RAM address to base X Y value. point is a {x y}.
317 dup HEX: 1f bitand 8 * 255 swap - ! n y
318 swap -5 shift swap 2array ;
320 : plot-bitmap-pixel ( bitmap point color -- )
321 #! point is a {x y}. color is a {r g b}.
322 spin set-bitmap-pixel ;
324 : within ( n a b -- bool )
326 rot tuck swap <= [ swap >= ] dip and ;
328 : get-point-color ( point -- color )
329 #! Return the color to use for the given x/y position.
332 { [ dup 184 238 within pick 0 223 within and ] [ 2drop green ] }
333 { [ dup 240 247 within pick 16 133 within and ] [ 2drop green ] }
334 { [ dup 247 215 - 247 184 - within pick 0 223 within and ] [ 2drop red ] }
338 : plot-bitmap-bits ( bitmap point byte bit -- )
341 dup swapd -1 * shift 1 bitand 0 =
343 [ black ] [ dup get-point-color ] if
346 : do-bitmap-update ( bitmap value addr -- )
348 [ 0 plot-bitmap-bits ] 3keep
349 [ 1 plot-bitmap-bits ] 3keep
350 [ 2 plot-bitmap-bits ] 3keep
351 [ 3 plot-bitmap-bits ] 3keep
352 [ 4 plot-bitmap-bits ] 3keep
353 [ 5 plot-bitmap-bits ] 3keep
354 [ 6 plot-bitmap-bits ] 3keep
357 M: space-invaders update-video ( value addr cpu -- )
359 bitmap>> -rot do-bitmap-update
364 : sync-frame ( millis -- millis )
365 #! Sleep until the time for the next frame arrives.
366 1000 60 / >fixnum + system:millis - dup 0 >
367 [ milliseconds threads:sleep ] [ drop threads:yield ] if system:millis ;
369 : invaders-process ( millis gadget -- )
370 #! Run a space invaders gadget inside a
371 #! concurrent process. Messages can be sent to
372 #! signal key presses, etc.
377 [ cpu>> gui-frame ] keep
382 M: invaders-gadget graft* ( gadget -- )
383 dup cpu>> init-sounds
385 [ system:millis swap invaders-process ] curry
386 "Space invaders" threads:spawn drop ;
388 M: invaders-gadget ungraft* ( gadget -- )
391 : (run) ( title cpu rom-info -- )
392 over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
395 { HEX: 0000 "invaders/invaders.h" }
396 { HEX: 0800 "invaders/invaders.g" }
397 { HEX: 1000 "invaders/invaders.f" }
398 { HEX: 1800 "invaders/invaders.e" }
401 : run-invaders ( -- )
403 "Space Invaders" <space-invaders> rom-info (run)