/extra/space-invaders/space-invaders.factor
Unknown | 402 lines | 341 code | 61 blank | 0 comment | 0 complexity | 2beb1ded2979f5384e21bfe8e5296879 MD5 | raw file
1! Copyright (C) 2006 Chris Double. 2! See http://factorcode.org/license.txt for BSD license. 3! 4USING: 5 accessors 6 alien.c-types 7 alien.data 8 arrays 9 byte-arrays 10 calendar 11 combinators 12 cpu.8080 13 cpu.8080.emulator 14 io.files 15 io.pathnames 16 kernel 17 locals 18 math 19 math.order 20 openal 21 openal.alut 22 opengl.gl 23 sequences 24 ui 25 ui.gadgets 26 ui.gestures 27 ui.render 28 specialized-arrays 29; 30QUALIFIED: threads 31QUALIFIED: system 32SPECIALIZED-ARRAY: uchar 33IN: space-invaders 34 35TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ; 36CONSTANT: game-width 224 37CONSTANT: game-height 256 38 39: make-opengl-bitmap ( -- array ) 40 game-height game-width 3 * * uchar <c-array> ; 41 42: bitmap-index ( point -- index ) 43 #! Point is a {x y}. 44 first2 game-width 3 * * swap 3 * + ; 45 46:: set-bitmap-pixel ( bitmap point color -- ) 47 point bitmap-index :> index 48 color first index bitmap set-nth 49 color second index 1 + bitmap set-nth 50 color third index 2 + bitmap set-nth ; 51 52: get-bitmap-pixel ( point array -- color ) 53 #! Point is a {x y}. color is a {r g b} 54 [ bitmap-index ] dip 55 [ nth ] 2keep 56 [ [ 1 + ] dip nth ] 2keep 57 [ 2 + ] dip nth 3array ; 58 59CONSTANT: SOUND-SHOT 0 60CONSTANT: SOUND-UFO 1 61CONSTANT: SOUND-BASE-HIT 2 62CONSTANT: SOUND-INVADER-HIT 3 63CONSTANT: SOUND-WALK1 4 64CONSTANT: SOUND-WALK2 5 65CONSTANT: SOUND-WALK3 6 66CONSTANT: SOUND-WALK4 7 67CONSTANT: SOUND-UFO-HIT 8 68 69: init-sound ( index cpu filename -- ) 70 absolute-path swapd [ sounds>> nth AL_BUFFER ] dip 71 create-buffer-from-wav set-source-param ; 72 73: init-sounds ( cpu -- ) 74 init-openal 75 [ 9 gen-sources swap sounds<< ] keep 76 [ SOUND-SHOT "vocab:space-invaders/resources/Shot.wav" init-sound ] keep 77 [ SOUND-UFO "vocab: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 "vocab:space-invaders/resources/BaseHit.wav" init-sound ] keep 80 [ SOUND-INVADER-HIT "vocab:space-invaders/resources/InvHit.Wav" init-sound ] keep 81 [ SOUND-WALK1 "vocab:space-invaders/resources/Walk1.wav" init-sound ] keep 82 [ SOUND-WALK2 "vocab:space-invaders/resources/Walk2.wav" init-sound ] keep 83 [ SOUND-WALK3 "vocab:space-invaders/resources/Walk3.wav" init-sound ] keep 84 [ SOUND-WALK4 "vocab:space-invaders/resources/Walk4.wav" init-sound ] keep 85 [ SOUND-UFO-HIT "vocab:space-invaders/resources/UfoHit.wav" init-sound ] keep 86 f swap looping?<< ; 87 88: cpu-init ( cpu -- cpu ) 89 make-opengl-bitmap over bitmap<< 90 [ init-sounds ] keep 91 [ reset ] keep ; 92 93: <space-invaders> ( -- cpu ) 94 space-invaders new cpu-init ; 95 96: play-invaders-sound ( cpu sound -- ) 97 swap sounds>> nth source-play ; 98 99: stop-invaders-sound ( cpu sound -- ) 100 swap sounds>> nth source-stop ; 101 102: read-port1 ( cpu -- byte ) 103 #! Port 1 maps the keys for space invaders 104 #! Bit 0 = coin slot 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 0xFE bitand ] keep 111 port1<< ; 112 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>> 0x8F bitand ] keep 122 port1>> 0x70 bitand bitor ; 123 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 0xFF bitand ; 129 130M: space-invaders read-port ( port cpu -- byte ) 131 #! Read a byte from the hardware port. 'port' should 132 #! be an 8-bit value. 133 swap { 134 { 1 [ read-port1 ] } 135 { 2 [ read-port2 ] } 136 { 3 [ read-port3 ] } 137 [ 2drop 0 ] 138 } case ; 139 140: write-port2 ( value cpu -- ) 141 #! Setting this value affects the value read from port 3 142 port2o<< ; 143 144:: bit-newly-set? ( old-value new-value bit -- bool ) 145 new-value bit bit? [ old-value bit bit? not ] dip and ; 146 147: port3-newly-set? ( new-value cpu bit -- bool ) 148 [ port3o>> swap ] dip bit-newly-set? ; 149 150: port5-newly-set? ( new-value cpu bit -- bool ) 151 [ port5o>> swap ] dip bit-newly-set? ; 152 153: write-port3 ( value cpu -- ) 154 #! Connected to the sound hardware 155 #! Bit 0 = spaceship sound (looped) 156 #! Bit 1 = Shot 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 162 t over looping?<< 163 ] when 164 over 0 bit? not over looping?>> and [ 165 dup SOUND-UFO stop-invaders-sound 166 f over looping?<< 167 ] when 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 172 port3o<< ; 173 174: write-port4 ( value cpu -- ) 175 #! Affects the value returned by reading port 3 176 [ port4hi>> ] keep 177 [ port4lo<< ] keep 178 port4hi<< ; 179 180: write-port5 ( value cpu -- ) 181 #! Plays sounds 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 193 port5o<< ; 194 195M: space-invaders write-port ( value port cpu -- ) 196 #! Write a byte to the hardware port, where 'port' is 197 #! an 8-bit value. 198 swap { 199 { 2 [ write-port2 ] } 200 { 3 [ write-port3 ] } 201 { 4 [ write-port4 ] } 202 { 5 [ write-port5 ] } 203 [ 3drop ] 204 } case ; 205 206M: space-invaders reset ( cpu -- ) 207 dup call-next-method 208 0 >>port1 209 0 >>port2i 210 0 >>port2o 211 0 >>port3o 212 0 >>port4lo 213 0 >>port4hi 214 0 >>port5o 215 drop ; 216 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>> 0xFFFF bitand ] keep 222 pc<< ; 223 224: gui-frame/2 ( cpu -- ) 225 [ gui-step ] keep 226 [ cycles>> ] keep 227 over 16667 < [ ! cycles cpu 228 nip gui-frame/2 229 ] [ 230 [ [ 16667 - ] dip cycles<< ] keep 231 dup last-interrupt>> 0x10 = [ 232 0x08 over last-interrupt<< 0x08 swap interrupt 233 ] [ 234 0x10 over last-interrupt<< 0x10 swap interrupt 235 ] if 236 ] if ; 237 238: gui-frame ( cpu -- ) 239 dup gui-frame/2 gui-frame/2 ; 240 241: coin-down ( cpu -- ) 242 [ port1>> 1 bitor ] keep port1<< ; 243 244: coin-up ( cpu -- ) 245 [ port1>> 255 1 - bitand ] keep port1<< ; 246 247: player1-down ( cpu -- ) 248 [ port1>> 4 bitor ] keep port1<< ; 249 250: player1-up ( cpu -- ) 251 [ port1>> 255 4 - bitand ] keep port1<< ; 252 253: player2-down ( cpu -- ) 254 [ port1>> 2 bitor ] keep port1<< ; 255 256: player2-up ( cpu -- ) 257 [ port1>> 255 2 - bitand ] keep port1<< ; 258 259: fire-down ( cpu -- ) 260 [ port1>> 0x10 bitor ] keep port1<< ; 261 262: fire-up ( cpu -- ) 263 [ port1>> 255 0x10 - bitand ] keep port1<< ; 264 265: left-down ( cpu -- ) 266 [ port1>> 0x20 bitor ] keep port1<< ; 267 268: left-up ( cpu -- ) 269 [ port1>> 255 0x20 - bitand ] keep port1<< ; 270 271: right-down ( cpu -- ) 272 [ port1>> 0x40 bitor ] keep port1<< ; 273 274: right-up ( cpu -- ) 275 [ port1>> 255 0x40 - bitand ] keep port1<< ; 276 277 278TUPLE: invaders-gadget < gadget cpu quit? windowed? ; 279 280invaders-gadget H{ 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 ] } 294 } set-gestures 295 296: <invaders-gadget> ( cpu -- gadget ) 297 invaders-gadget new 298 swap >>cpu 299 f >>quit? ; 300 301M: invaders-gadget pref-dim* drop { 224 256 } ; 302 303M: invaders-gadget draw-gadget* ( gadget -- ) 304 0 0 glRasterPos2i 305 1.0 -1.0 glPixelZoom 306 [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip 307 cpu>> bitmap>> glDrawPixels ; 308 309CONSTANT: black { 0 0 0 } 310CONSTANT: white { 255 255 255 } 311CONSTANT: green { 0 255 0 } 312CONSTANT: red { 255 0 0 } 313 314: addr>xy ( addr -- point ) 315 #! Convert video RAM address to base X Y value. point is a {x y}. 316 0x2400 - ! n 317 dup 0x1f bitand 8 * 255 swap - ! n y 318 swap -5 shift swap 2array ; 319 320: plot-bitmap-pixel ( bitmap point color -- ) 321 #! point is a {x y}. color is a {r g b}. 322 set-bitmap-pixel ; 323 324: get-point-color ( point -- color ) 325 #! Return the color to use for the given x/y position. 326 first2 327 { 328 { [ dup 184 238 between? pick 0 223 between? and ] [ 2drop green ] } 329 { [ dup 240 247 between? pick 16 133 between? and ] [ 2drop green ] } 330 { [ dup 247 215 - 247 184 - between? pick 0 223 between? and ] [ 2drop red ] } 331 [ 2drop white ] 332 } cond ; 333 334: plot-bitmap-bits ( bitmap point byte bit -- ) 335 #! point is a {x y}. 336 [ first2 ] 2dip 337 dup swapd -1 * shift 1 bitand 0 = 338 [ - 2array ] dip 339 [ black ] [ dup get-point-color ] if 340 plot-bitmap-pixel ; 341 342: do-bitmap-update ( bitmap value addr -- ) 343 addr>xy swap 344 [ 0 plot-bitmap-bits ] 3keep 345 [ 1 plot-bitmap-bits ] 3keep 346 [ 2 plot-bitmap-bits ] 3keep 347 [ 3 plot-bitmap-bits ] 3keep 348 [ 4 plot-bitmap-bits ] 3keep 349 [ 5 plot-bitmap-bits ] 3keep 350 [ 6 plot-bitmap-bits ] 3keep 351 7 plot-bitmap-bits ; 352 353M: space-invaders update-video ( value addr cpu -- ) 354 over 0x2400 >= [ 355 bitmap>> -rot do-bitmap-update 356 ] [ 357 3drop 358 ] if ; 359 360: sync-frame ( micros -- micros ) 361 #! Sleep until the time for the next frame arrives. 362 1000 60 / >fixnum + gmt timestamp>micros - dup 0 > 363 [ milliseconds threads:sleep ] [ drop threads:yield ] if gmt timestamp>micros ; 364 365: invaders-process ( micros gadget -- ) 366 #! Run a space invaders gadget inside a 367 #! concurrent process. Messages can be sent to 368 #! signal key presses, etc. 369 dup quit?>> [ 370 2drop 371 ] [ 372 [ sync-frame ] dip 373 [ cpu>> gui-frame ] keep 374 [ relayout-1 ] keep 375 invaders-process 376 ] if ; 377 378M: invaders-gadget graft* ( gadget -- ) 379 dup cpu>> init-sounds 380 f over quit?<< 381 [ gmt timestamp>micros swap invaders-process ] curry 382 "Space invaders" threads:spawn drop ; 383 384M: invaders-gadget ungraft* ( gadget -- ) 385 t swap quit?<< ; 386 387: (run) ( title cpu rom-info -- ) 388 over load-rom* <invaders-gadget> t >>windowed? swap open-window ; 389 390CONSTANT: rom-info { 391 { 0x0000 "invaders/invaders.h" } 392 { 0x0800 "invaders/invaders.g" } 393 { 0x1000 "invaders/invaders.f" } 394 { 0x1800 "invaders/invaders.e" } 395 } 396 397: run-invaders ( -- ) 398 [ 399 "Space Invaders" <space-invaders> rom-info (run) 400 ] with-ui ; 401 402MAIN: run-invaders