1 ! Copyright (C) 2006 Chris Double.
2 ! See http://factorcode.org/license.txt for BSD license.
4 ! Space Invaders: http://www.emuparadise.me/M.A.M.E._-_Multiple_Arcade_Machine_Emulator_ROMs/Space_Invaders_--_Space_Invaders_M/13774
5 USING: accessors alien.c-types alien.data arrays
6 combinators cpu.8080 cpu.8080.emulator io.pathnames kernel
7 locals math math.order openal openal.alut opengl.gl sequences
8 specialized-arrays ui ui.gadgets ui.gestures ui.render ;
11 SPECIALIZED-ARRAY: uchar
12 IN: roms.space-invaders
14 TUPLE: space-invaders < cpu
15 port1 port2i port2o port3o port4lo port4hi port5o
16 bitmap sounds looping? ;
18 CONSTANT: game-width 224
19 CONSTANT: game-height 256
21 : make-opengl-bitmap ( -- array )
22 game-height game-width 3 * * uchar <c-array> ;
24 : bitmap-index ( point -- index )
26 first2 game-width 3 * * swap 3 * + ;
28 :: set-bitmap-pixel ( bitmap point color -- )
29 point bitmap-index :> index
30 color first index bitmap set-nth
31 color second index 1 + bitmap set-nth
32 color third index 2 + bitmap set-nth ;
34 : get-bitmap-pixel ( point array -- color )
35 ! Point is a {x y}. color is a {r g b}
39 [ [ 2 + ] dip nth ] 2tri 3array ;
41 CONSTANT: SOUND-SHOT 0
43 CONSTANT: SOUND-BASE-HIT 2
44 CONSTANT: SOUND-INVADER-HIT 3
45 CONSTANT: SOUND-WALK1 4
46 CONSTANT: SOUND-WALK2 5
47 CONSTANT: SOUND-WALK3 6
48 CONSTANT: SOUND-WALK4 7
49 CONSTANT: SOUND-UFO-HIT 8
51 : init-sound ( index cpu filename -- )
52 absolute-path swapd [ sounds>> nth AL_BUFFER ] dip
53 create-buffer-from-wav set-source-param ;
55 : init-sounds ( cpu -- )
57 [ 9 gen-sources swap sounds<< ]
58 [ SOUND-SHOT "vocab:roms/space-invaders/resources/Shot.wav" init-sound ]
59 [ SOUND-UFO "vocab:roms/space-invaders/resources/Ufo.wav" init-sound ]
60 [ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ]
61 [ SOUND-BASE-HIT "vocab:roms/space-invaders/resources/BaseHit.wav" init-sound ]
62 [ SOUND-INVADER-HIT "vocab:roms/space-invaders/resources/InvHit.Wav" init-sound ]
63 [ SOUND-WALK1 "vocab:roms/space-invaders/resources/Walk1.wav" init-sound ]
64 [ SOUND-WALK2 "vocab:roms/space-invaders/resources/Walk2.wav" init-sound ]
65 [ SOUND-WALK3 "vocab:roms/space-invaders/resources/Walk3.wav" init-sound ]
66 [ SOUND-WALK4 "vocab:roms/space-invaders/resources/Walk4.wav" init-sound ]
67 [ SOUND-UFO-HIT "vocab:roms/space-invaders/resources/UfoHit.wav" init-sound ]
71 : cpu-init ( cpu -- cpu )
72 make-opengl-bitmap >>bitmap
76 : <space-invaders> ( -- cpu )
77 space-invaders new cpu-init ;
79 : play-invaders-sound ( cpu sound -- )
80 swap sounds>> nth source-play ;
82 : stop-invaders-sound ( cpu sound -- )
83 swap sounds>> nth source-stop ;
85 : read-port1 ( cpu -- byte )
86 ! Port 1 maps the keys for space invaders
88 ! Bit 1 = two players button
89 ! Bit 2 = one player button
90 ! Bit 4 = player one fire
91 ! Bit 5 = player one left
92 ! Bit 6 = player one right
93 [ dup 0xFE bitand ] change-port1 drop ;
95 : read-port2 ( cpu -- byte )
96 ! Port 2 maps player 2 controls and dip switches
97 ! Bit 0,1 = number of ships
98 ! Bit 2 = mode (1=easy, 0=hard)
99 ! Bit 4 = player two fire
100 ! Bit 5 = player two left
101 ! Bit 6 = player two right
102 ! Bit 7 = show or hide coin info
103 [ port2i>> 0x8F bitand ]
104 [ port1>> 0x70 bitand bitor ] bi ;
106 : read-port3 ( cpu -- byte )
107 ! Used to compute a special formula
108 [ port4hi>> 8 shift ] keep
109 [ port4lo>> bitor ] keep
110 port2o>> shift -8 shift 0xFF bitand ;
112 M: space-invaders read-port
113 ! Read a byte from the hardware port. 'port' should
122 : write-port2 ( value cpu -- )
123 ! Setting this value affects the value read from port 3
126 :: bit-newly-set? ( old-value new-value bit -- bool )
127 old-value bit bit? not new-value bit bit? and ;
129 : port3-newly-set? ( new-value cpu bit -- bool )
130 [ port3o>> swap ] dip bit-newly-set? ;
132 : port5-newly-set? ( new-value cpu bit -- bool )
133 [ port5o>> swap ] dip bit-newly-set? ;
135 : write-port3 ( value cpu -- )
136 ! Connected to the sound hardware
137 ! Bit 0 = spaceship sound (looped)
139 ! Bit 2 = Your ship hit
140 ! Bit 3 = Invader hit
141 ! Bit 4 = Extended play sound
144 dup SOUND-UFO play-invaders-sound
149 dup SOUND-UFO stop-invaders-sound
153 2dup 0 port3-newly-set? [ dup SOUND-UFO play-invaders-sound ] when
154 2dup 1 port3-newly-set? [ dup SOUND-SHOT play-invaders-sound ] when
155 2dup 2 port3-newly-set? [ dup SOUND-BASE-HIT play-invaders-sound ] when
156 2dup 3 port3-newly-set? [ dup SOUND-INVADER-HIT play-invaders-sound ] when
159 : write-port4 ( value cpu -- )
160 ! Affects the value returned by reading port 3
161 [ port4hi>> ] [ port4lo<< ] [ port4hi<< ] tri ;
163 : write-port5 ( value cpu -- )
165 ! Bit 0 = invaders sound 1
166 ! Bit 1 = invaders sound 2
167 ! Bit 2 = invaders sound 3
168 ! Bit 3 = invaders sound 4
169 ! Bit 4 = spaceship hit
170 ! Bit 5 = amplifier enabled/disabled
171 2dup 0 port5-newly-set? [ dup SOUND-WALK1 play-invaders-sound ] when
172 2dup 1 port5-newly-set? [ dup SOUND-WALK2 play-invaders-sound ] when
173 2dup 2 port5-newly-set? [ dup SOUND-WALK3 play-invaders-sound ] when
174 2dup 3 port5-newly-set? [ dup SOUND-WALK4 play-invaders-sound ] when
175 2dup 4 port5-newly-set? [ dup SOUND-UFO-HIT play-invaders-sound ] when
178 M: space-invaders write-port
179 ! Write a byte to the hardware port, where 'port' is
182 { 2 [ write-port2 ] }
183 { 3 [ write-port3 ] }
184 { 4 [ write-port4 ] }
185 { 5 [ write-port5 ] }
189 M: space-invaders reset
200 : gui-step ( cpu -- )
201 [ read-instruction ] keep ! n cpu
202 over get-cycles over inc-cycles
203 [ swap instructions nth call( cpu -- ) ] keep
204 [ pc>> 0xFFFF bitand ] keep
207 : gui-frame/2 ( cpu -- )
210 over 16667 < [ ! cycles cpu
213 [ [ 16667 - ] dip cycles<< ] keep
214 dup last-interrupt>> 0x10 = [
215 0x08 >>last-interrupt 0x08 swap interrupt
217 0x10 >>last-interrupt 0x10 swap interrupt
221 : gui-frame ( cpu -- )
222 dup gui-frame/2 gui-frame/2 ;
224 : coin-down ( cpu -- )
225 [ 1 bitor ] change-port1 drop ;
228 [ 255 1 - bitand ] change-port1 drop ;
230 : player1-down ( cpu -- )
231 [ 4 bitor ] change-port1 drop ;
233 : player1-up ( cpu -- )
234 [ 255 4 - bitand ] change-port1 drop ;
236 : player2-down ( cpu -- )
237 [ 2 bitor ] change-port1 drop ;
239 : player2-up ( cpu -- )
240 [ 255 2 - bitand ] change-port1 drop ;
242 : fire-down ( cpu -- )
243 [ 0x10 bitor ] change-port1 drop ;
246 [ 255 0x10 - bitand ] change-port1 drop ;
248 : left-down ( cpu -- )
249 [ 0x20 bitor ] change-port1 drop ;
252 [ 255 0x20 - bitand ] change-port1 drop ;
254 : right-down ( cpu -- )
255 [ 0x40 bitor ] change-port1 drop ;
257 : right-up ( cpu -- )
258 [ 255 0x40 - bitand ] change-port1 drop ;
260 TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
263 { T{ key-down f f "ESC" } [ t >>quit? dup windowed?>> [ close-window ] [ drop ] if ] }
264 { T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
265 { T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] }
266 { T{ key-down f f "1" } [ cpu>> player1-down ] }
267 { T{ key-up f f "1" } [ cpu>> player1-up ] }
268 { T{ key-down f f "2" } [ cpu>> player2-down ] }
269 { T{ key-up f f "2" } [ cpu>> player2-up ] }
270 { T{ key-down f f "UP" } [ cpu>> fire-down ] }
271 { T{ key-up f f "UP" } [ cpu>> fire-up ] }
272 { T{ key-down f f "LEFT" } [ cpu>> left-down ] }
273 { T{ key-up f f "LEFT" } [ cpu>> left-up ] }
274 { T{ key-down f f "RIGHT" } [ cpu>> right-down ] }
275 { T{ key-up f f "RIGHT" } [ cpu>> right-up ] }
278 : <invaders-gadget> ( cpu -- gadget )
283 M: invaders-gadget pref-dim* drop { 224 256 } ;
285 M: invaders-gadget draw-gadget*
288 [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip
289 cpu>> bitmap>> glDrawPixels ;
291 CONSTANT: black { 0 0 0 }
292 CONSTANT: white { 255 255 255 }
293 CONSTANT: green { 0 255 0 }
294 CONSTANT: red { 255 0 0 }
296 : addr>xy ( addr -- point )
297 ! Convert video RAM address to base X Y value. point is a {x y}.
299 dup 0x1f bitand 8 * 255 swap - ! n y
300 swap -5 shift swap 2array ;
302 : plot-bitmap-pixel ( bitmap point color -- )
303 ! point is a {x y}. color is a {r g b}.
306 : get-point-color ( point -- color )
307 ! Return the color to use for the given x/y position.
310 { [ dup 184 238 between? pick 0 223 between? and ] [ 2drop green ] }
311 { [ dup 240 247 between? pick 16 133 between? and ] [ 2drop green ] }
312 { [ dup 247 215 - 247 184 - between? pick 0 223 between? and ] [ 2drop red ] }
316 : plot-bitmap-bits ( bitmap point byte bit -- )
319 dup swapd -1 * shift 1 bitand 0 =
321 [ black ] [ dup get-point-color ] if
324 : do-bitmap-update ( bitmap value addr -- )
325 addr>xy swap 8 <iota> [ plot-bitmap-bits ] with with with each ;
327 M: space-invaders update-video
329 bitmap>> -rot do-bitmap-update
334 : sync-frame ( micros -- micros )
335 ! Sleep until the time for the next frame arrives.
336 16,667 + system:nano-count - dup 0 >
337 [ 1,000 * threads:sleep ] [ drop threads:yield ] if
340 : invaders-process ( micros gadget -- )
341 ! Run a space invaders gadget inside a
342 ! concurrent process. Messages can be sent to
343 ! signal key presses, etc.
354 M: invaders-gadget graft*
355 dup cpu>> init-sounds
357 [ system:nano-count swap invaders-process ] curry
358 "Space invaders" threads:spawn drop ;
360 M: invaders-gadget ungraft*
363 : run-rom ( title cpu rom-info -- )
364 over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
367 { 0x0000 "invaders/invaders.h" }
368 { 0x0800 "invaders/invaders.g" }
369 { 0x1000 "invaders/invaders.f" }
370 { 0x1800 "invaders/invaders.e" }
373 : run-invaders ( -- )
375 "Space Invaders" <space-invaders> rom-info run-rom