extra/space-invaders/space-invaders.factor

   1 ! Copyright (C) 2006 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 USING:
   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     math
  18     openal
  19     opengl.gl
  20     sequences
  21     ui
  22     ui.gadgets
  23     ui.gestures
  24     ui.render
  25 ;
  26 QUALIFIED: threads
  27 QUALIFIED: system
  28 IN: space-invaders
  29
  30 <<
  31     "uchar" require-c-array
  32 >>
  33
  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
  37
  38 : make-opengl-bitmap ( -- array )
  39   game-height game-width 3 * * uchar <c-array> ;
  40
  41 : bitmap-index ( point -- index )
  42   #! Point is a {x y}.
  43   first2 game-width 3 * * swap 3 * + ;
  44
  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 ;
  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
  59 CONSTANT: SOUND-SHOT         0
  60 CONSTANT: SOUND-UFO          1
  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
  68
  69 : init-sound ( index cpu filename  -- )
  70   canonicalize-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        "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
  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 HEX: FE 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>> HEX: 8F bitand ] keep
 122   port1>> HEX: 70 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 HEX: FF bitand ;
 129
 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.
 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   tuck 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
 195 M: 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
 206 M: 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>> HEX: FFFF 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>> HEX: 10 = [
 232       HEX: 08 over (>>last-interrupt) HEX: 08 swap interrupt
 233     ] [
 234       HEX: 10 over (>>last-interrupt) HEX: 10 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>> HEX: 10 bitor ] keep (>>port1) ;
 261
 262 : fire-up ( cpu -- )
 263   [ port1>> 255 HEX: 10 - bitand ] keep (>>port1) ;
 264
 265 : left-down ( cpu -- )
 266   [ port1>> HEX: 20 bitor ] keep (>>port1) ;
 267
 268 : left-up ( cpu -- )
 269   [ port1>> 255 HEX: 20 - bitand ] keep (>>port1) ;
 270
 271 : right-down ( cpu -- )
 272   [ port1>> HEX: 40 bitor ] keep (>>port1) ;
 273
 274 : right-up ( cpu -- )
 275   [ port1>> 255 HEX: 40 - bitand ] keep (>>port1) ;
 276
 277
 278 TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
 279
 280 invaders-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
 301 M: invaders-gadget pref-dim* drop { 224 256 } ;
 302
 303 M: 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
 309 CONSTANT: black { 0 0 0 }
 310 CONSTANT: white { 255 255 255 }
 311 CONSTANT: green { 0 255 0 }
 312 CONSTANT: 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   HEX: 2400 - ! n
 317   dup HEX: 1f 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   spin set-bitmap-pixel ;
 323
 324 : within ( n a b -- bool )
 325   #! n >= a and n <= b
 326   rot tuck swap <= [ swap >= ] dip and ;
 327
 328 : get-point-color ( point -- color )
 329   #! Return the color to use for the given x/y position.
 330   first2
 331   {
 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 ] }
 335     [ 2drop white ]
 336   } cond ;
 337
 338 : plot-bitmap-bits ( bitmap point byte bit -- )
 339   #! point is a {x y}.
 340   [ first2 ] 2dip
 341   dup swapd -1 * shift 1 bitand 0 =
 342   [ - 2array ] dip
 343   [ black ] [ dup get-point-color ] if
 344   plot-bitmap-pixel ;
 345
 346 : do-bitmap-update ( bitmap value addr -- )
 347   addr>xy swap
 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
 355   7 plot-bitmap-bits ;
 356
 357 M: space-invaders update-video ( value addr cpu -- )
 358   over HEX: 2400 >= [
 359     bitmap>> -rot do-bitmap-update
 360   ] [
 361     3drop
 362   ] if ;
 363
 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 ;
 368
 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.
 373   dup quit?>> [
 374     2drop
 375   ] [
 376     [ sync-frame ] dip
 377     [ cpu>> gui-frame ] keep
 378     [ relayout-1 ] keep
 379     invaders-process
 380   ] if ;
 381
 382 M: invaders-gadget graft* ( gadget -- )
 383   dup cpu>> init-sounds
 384   f over (>>quit?)
 385   [ system:millis swap invaders-process ] curry
 386   "Space invaders" threads:spawn drop ;
 387
 388 M: invaders-gadget ungraft* ( gadget -- )
 389  t swap (>>quit?) ;
 390
 391 : (run) ( title cpu rom-info -- )
 392   over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
 393
 394 CONSTANT: rom-info {
 395       { HEX: 0000 "invaders/invaders.h" }
 396       { HEX: 0800 "invaders/invaders.g" }
 397       { HEX: 1000 "invaders/invaders.f" }
 398       { HEX: 1800 "invaders/invaders.e" }
 399    }
 400
 401 : run-invaders ( -- )
 402   [
 403     "Space Invaders" <space-invaders> rom-info (run)
 404   ] with-ui ;
 405
 406 MAIN: run-invaders