extra/roms/space-invaders/space-invaders.factor

   1 ! Copyright (C) 2006 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   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 math math.order openal openal.alut opengl.gl sequences
   8 specialized-arrays ui ui.gadgets ui.gestures ui.render ;
   9 QUALIFIED: threads
  10 QUALIFIED: system
  11 SPECIALIZED-ARRAY: uchar
  12 IN: roms.space-invaders
  13
  14 TUPLE: space-invaders < cpu
  15     port1 port2i port2o port3o port4lo port4hi port5o
  16     bitmap sounds looping? ;
  17
  18 CONSTANT: game-width 224
  19 CONSTANT: game-height 256
  20
  21 : make-opengl-bitmap ( -- array )
  22     game-height game-width 3 * * uchar <c-array> ;
  23
  24 : bitmap-index ( point -- index )
  25     ! Point is a {x y}.
  26     first2 game-width 3 * * swap 3 * + ;
  27
  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 ;
  33
  34 : get-bitmap-pixel ( point array -- color )
  35     ! Point is a {x y}. color is a {r g b}
  36     [ bitmap-index ] dip
  37     [ nth ]
  38     [ [ 1 + ] dip nth ]
  39     [ [ 2 + ] dip nth ] 2tri 3array ;
  40
  41 CONSTANT: SOUND-SHOT         0
  42 CONSTANT: SOUND-UFO          1
  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
  50
  51 : init-sound ( index cpu filename  -- )
  52     absolute-path swapd [ sounds>> nth AL_BUFFER ] dip
  53     create-buffer-from-wav set-source-param ;
  54
  55 : init-sounds ( cpu -- )
  56     init-openal {
  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 ]
  68         [ f swap looping?<< ]
  69     } cleave ;
  70
  71 : cpu-init ( cpu -- cpu )
  72     make-opengl-bitmap >>bitmap
  73     [ init-sounds ] keep
  74     [ reset ] keep ;
  75
  76 : <space-invaders> ( -- cpu )
  77     space-invaders new cpu-init ;
  78
  79 : play-invaders-sound ( cpu sound -- )
  80     swap sounds>> nth source-play ;
  81
  82 : stop-invaders-sound ( cpu sound -- )
  83     swap sounds>> nth source-stop ;
  84
  85 : read-port1 ( cpu -- byte )
  86     ! Port 1 maps the keys for space invaders
  87     ! Bit 0 = coin slot
  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 ;
  94
  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 ;
 105
 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 ;
 111
 112 M: space-invaders read-port
 113     ! Read a byte from the hardware port. 'port' should
 114     ! be an 8-bit value.
 115     swap {
 116         { 1 [ read-port1 ] }
 117         { 2 [ read-port2 ] }
 118         { 3 [ read-port3 ] }
 119         [ 2drop 0 ]
 120     } case ;
 121
 122 : write-port2 ( value cpu -- )
 123     ! Setting this value affects the value read from port 3
 124     port2o<< ;
 125
 126 :: bit-newly-set? ( old-value new-value bit -- bool )
 127     old-value bit bit? not new-value bit bit? and ;
 128
 129 : port3-newly-set? ( new-value cpu bit -- bool )
 130     [ port3o>> swap ] dip bit-newly-set? ;
 131
 132 : port5-newly-set? ( new-value cpu bit -- bool )
 133     [ port5o>> swap ] dip bit-newly-set? ;
 134
 135 : write-port3 ( value cpu -- )
 136     ! Connected to the sound hardware
 137     ! Bit 0 = spaceship sound (looped)
 138     ! Bit 1 = Shot
 139     ! Bit 2 = Your ship hit
 140     ! Bit 3 = Invader hit
 141     ! Bit 4 = Extended play sound
 142     over 0 bit? [
 143         dup looping?>> [
 144             dup SOUND-UFO play-invaders-sound
 145             t >>looping?
 146         ] unless
 147     ] [
 148         dup looping?>> [
 149             dup SOUND-UFO stop-invaders-sound
 150             f >>looping?
 151         ] when
 152     ] if
 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
 157     port3o<< ;
 158
 159 : write-port4 ( value cpu -- )
 160     ! Affects the value returned by reading port 3
 161     [ port4hi>> ] [ port4lo<< ] [ port4hi<< ] tri ;
 162
 163 : write-port5 ( value cpu -- )
 164     ! Plays sounds
 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
 176     port5o<< ;
 177
 178 M: space-invaders write-port
 179     ! Write a byte to the hardware port, where 'port' is
 180     ! an 8-bit value.
 181     swap {
 182         { 2 [ write-port2 ] }
 183         { 3 [ write-port3 ] }
 184         { 4 [ write-port4 ] }
 185         { 5 [ write-port5 ] }
 186         [ 3drop ]
 187     } case ;
 188
 189 M: space-invaders reset
 190     dup call-next-method
 191     0 >>port1
 192     0 >>port2i
 193     0 >>port2o
 194     0 >>port3o
 195     0 >>port4lo
 196     0 >>port4hi
 197     0 >>port5o
 198     drop ;
 199
 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
 205     pc<< ;
 206
 207 : gui-frame/2 ( cpu -- )
 208     [ gui-step ] keep
 209     [ cycles>> ] keep
 210     over 16667 < [ ! cycles cpu
 211         nip gui-frame/2
 212     ] [
 213         [ [ 16667 - ] dip cycles<< ] keep
 214         dup last-interrupt>> 0x10 = [
 215             0x08 >>last-interrupt 0x08 swap interrupt
 216         ] [
 217             0x10 >>last-interrupt 0x10 swap interrupt
 218         ] if
 219     ] if ;
 220
 221 : gui-frame ( cpu -- )
 222     dup gui-frame/2 gui-frame/2 ;
 223
 224 : coin-down ( cpu -- )
 225     [ 1 bitor ] change-port1 drop ;
 226
 227 : coin-up ( cpu --  )
 228     [ 255 1 - bitand ] change-port1 drop ;
 229
 230 : player1-down ( cpu -- )
 231     [ 4 bitor ] change-port1 drop ;
 232
 233 : player1-up ( cpu -- )
 234     [ 255 4 - bitand ] change-port1 drop ;
 235
 236 : player2-down ( cpu -- )
 237     [ 2 bitor ] change-port1 drop ;
 238
 239 : player2-up ( cpu -- )
 240     [ 255 2 - bitand ] change-port1 drop ;
 241
 242 : fire-down ( cpu -- )
 243     [ 0x10 bitor ] change-port1 drop ;
 244
 245 : fire-up ( cpu -- )
 246     [ 255 0x10 - bitand ] change-port1 drop ;
 247
 248 : left-down ( cpu -- )
 249     [ 0x20 bitor ] change-port1 drop ;
 250
 251 : left-up ( cpu -- )
 252     [ 255 0x20 - bitand ] change-port1 drop ;
 253
 254 : right-down ( cpu -- )
 255     [ 0x40 bitor ] change-port1 drop ;
 256
 257 : right-up ( cpu -- )
 258     [ 255 0x40 - bitand ] change-port1 drop ;
 259
 260 TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
 261
 262 invaders-gadget H{
 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 ] }
 276 } set-gestures
 277
 278 : <invaders-gadget> ( cpu -- gadget )
 279     invaders-gadget new
 280         swap >>cpu
 281         f >>quit? ;
 282
 283 M: invaders-gadget pref-dim* drop { 224 256 } ;
 284
 285 M: invaders-gadget draw-gadget*
 286     0 0 glRasterPos2i
 287     1.0 -1.0 glPixelZoom
 288     [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip
 289     cpu>> bitmap>> glDrawPixels ;
 290
 291 CONSTANT: black {   0   0   0 }
 292 CONSTANT: white { 255 255 255 }
 293 CONSTANT: green {   0 255   0 }
 294 CONSTANT: red   { 255   0   0 }
 295
 296 : addr>xy ( addr -- point )
 297     ! Convert video RAM address to base X Y value. point is a {x y}.
 298     0x2400 - ! n
 299     dup 0x1f bitand 8 * 255 swap - ! n y
 300     swap -5 shift swap 2array ;
 301
 302 : plot-bitmap-pixel ( bitmap point color -- )
 303     ! point is a {x y}. color is a {r g b}.
 304     set-bitmap-pixel ;
 305
 306 : get-point-color ( point -- color )
 307     ! Return the color to use for the given x/y position.
 308     first2
 309     {
 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 ] }
 313         [ 2drop white ]
 314     } cond ;
 315
 316 : plot-bitmap-bits ( bitmap point byte bit -- )
 317     ! point is a {x y}.
 318     [ first2 ] 2dip
 319     dup swapd -1 * shift 1 bitand 0 =
 320     [ - 2array ] dip
 321     [ black ] [ dup get-point-color ] if
 322     plot-bitmap-pixel ;
 323
 324 : do-bitmap-update ( bitmap value addr -- )
 325     addr>xy swap 8 <iota> [ plot-bitmap-bits ] with with with each ;
 326
 327 M: space-invaders update-video
 328     over 0x2400 >= [
 329         bitmap>> -rot do-bitmap-update
 330     ] [
 331         3drop
 332     ] if ;
 333
 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
 338     system:nano-count ;
 339
 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.
 344     dup quit?>> [
 345         exit-openal 2drop
 346     ] [
 347         [ sync-frame ] dip {
 348             [ cpu>> gui-frame ]
 349             [ relayout-1 ]
 350             [ invaders-process ]
 351         } cleave
 352     ] if ;
 353
 354 M: invaders-gadget graft*
 355     dup cpu>> init-sounds
 356     f >>quit?
 357     [ system:nano-count swap invaders-process ] curry
 358     "Space invaders" threads:spawn drop ;
 359
 360 M: invaders-gadget ungraft*
 361     t swap quit?<< ;
 362
 363 : run-rom ( title cpu rom-info -- )
 364     over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
 365
 366 CONSTANT: rom-info {
 367       { 0x0000 "invaders/invaders.h" }
 368       { 0x0800 "invaders/invaders.g" }
 369       { 0x1000 "invaders/invaders.f" }
 370       { 0x1800 "invaders/invaders.e" }
 371 }
 372
 373 : run-invaders ( -- )
 374     [
 375         "Space Invaders" <space-invaders> rom-info run-rom
 376     ] with-ui ;
 377
 378 MAIN: run-invaders