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     locals
  18     math
  19     math.order
  20     openal
  21     opengl.gl
  22     sequences
  23     ui
  24     ui.gadgets
  25     ui.gestures
  26     ui.render
  27     specialized-arrays
  28 ;
  29 QUALIFIED: threads
  30 QUALIFIED: system
  31 SPECIALIZED-ARRAY: uchar
  32 IN: space-invaders
  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 ( bitmap point color -- )
  46     point bitmap-index :> index
  47     color first  index     bitmap set-nth
  48     color second index 1 + bitmap set-nth
  49     color third  index 2 + bitmap set-nth ;
  50
  51 : get-bitmap-pixel ( point array -- color )
  52   #! Point is a {x y}. color is a {r g b}
  53   [ bitmap-index ] dip
  54   [ nth ] 2keep
  55   [ [ 1 + ] dip nth ] 2keep
  56   [ 2 + ] dip nth 3array ;
  57
  58 CONSTANT: SOUND-SHOT         0
  59 CONSTANT: SOUND-UFO          1
  60 CONSTANT: SOUND-BASE-HIT     2
  61 CONSTANT: SOUND-INVADER-HIT  3
  62 CONSTANT: SOUND-WALK1        4
  63 CONSTANT: SOUND-WALK2        5
  64 CONSTANT: SOUND-WALK3        6
  65 CONSTANT: SOUND-WALK4        7
  66 CONSTANT: SOUND-UFO-HIT      8
  67
  68 : init-sound ( index cpu filename  -- )
  69   absolute-path swapd [ sounds>> nth AL_BUFFER ] dip
  70   create-buffer-from-wav set-source-param ;
  71
  72 : init-sounds ( cpu -- )
  73   init-openal
  74   [ 9 gen-sources swap (>>sounds) ] keep
  75   [ SOUND-SHOT        "vocab:space-invaders/resources/Shot.wav" init-sound ] keep
  76   [ SOUND-UFO         "vocab:space-invaders/resources/Ufo.wav" init-sound ] keep
  77   [ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep
  78   [ SOUND-BASE-HIT    "vocab:space-invaders/resources/BaseHit.wav" init-sound ] keep
  79   [ SOUND-INVADER-HIT "vocab:space-invaders/resources/InvHit.Wav" init-sound ] keep
  80   [ SOUND-WALK1       "vocab:space-invaders/resources/Walk1.wav" init-sound ] keep
  81   [ SOUND-WALK2       "vocab:space-invaders/resources/Walk2.wav" init-sound ] keep
  82   [ SOUND-WALK3       "vocab:space-invaders/resources/Walk3.wav" init-sound ] keep
  83   [ SOUND-WALK4       "vocab:space-invaders/resources/Walk4.wav" init-sound ] keep
  84   [ SOUND-UFO-HIT    "vocab:space-invaders/resources/UfoHit.wav" init-sound ] keep
  85   f swap (>>looping?) ;
  86
  87 : cpu-init ( cpu -- cpu )
  88   make-opengl-bitmap over (>>bitmap)
  89   [ init-sounds ] keep
  90   [ reset ] keep ;
  91
  92 : <space-invaders> ( -- cpu )
  93   space-invaders new cpu-init ;
  94
  95 : play-invaders-sound ( cpu sound -- )
  96   swap sounds>> nth source-play ;
  97
  98 : stop-invaders-sound ( cpu sound -- )
  99   swap sounds>> nth source-stop ;
 100
 101 : read-port1 ( cpu -- byte )
 102   #! Port 1 maps the keys for space invaders
 103   #! Bit 0 = coin slot
 104   #! Bit 1 = two players button
 105   #! Bit 2 = one player button
 106   #! Bit 4 = player one fire
 107   #! Bit 5 = player one left
 108   #! Bit 6 = player one right
 109   [ port1>> dup HEX: FE bitand ] keep
 110  (>>port1) ;
 111
 112 : read-port2 ( cpu -- byte )
 113   #! Port 2 maps player 2 controls and dip switches
 114   #! Bit 0,1 = number of ships
 115   #! Bit 2   = mode (1=easy, 0=hard)
 116   #! Bit 4   = player two fire
 117   #! Bit 5   = player two left
 118   #! Bit 6   = player two right
 119   #! Bit 7   = show or hide coin info
 120   [ port2i>> HEX: 8F bitand ] keep
 121   port1>> HEX: 70 bitand bitor ;
 122
 123 : read-port3 ( cpu -- byte )
 124   #! Used to compute a special formula
 125   [ port4hi>> 8 shift ] keep
 126   [ port4lo>> bitor ] keep
 127   port2o>> shift -8 shift HEX: FF bitand ;
 128
 129 M: space-invaders read-port ( port cpu -- byte )
 130   #! Read a byte from the hardware port. 'port' should
 131   #! be an 8-bit value.
 132   swap {
 133     { 1 [ read-port1 ] }
 134     { 2 [ read-port2 ] }
 135     { 3 [ read-port3 ] }
 136     [ 2drop 0 ]
 137   } case ;
 138
 139 : write-port2 ( value cpu -- )
 140   #! Setting this value affects the value read from port 3
 141   (>>port2o) ;
 142
 143 :: bit-newly-set? ( old-value new-value bit -- bool )
 144   new-value bit bit? [ old-value bit bit? not ] dip and ;
 145
 146 : port3-newly-set? ( new-value cpu bit -- bool )
 147   [ port3o>> swap ] dip bit-newly-set? ;
 148
 149 : port5-newly-set? ( new-value cpu bit -- bool )
 150   [ port5o>> swap ] dip bit-newly-set? ;
 151
 152 : write-port3 ( value cpu -- )
 153   #! Connected to the sound hardware
 154   #! Bit 0 = spaceship sound (looped)
 155   #! Bit 1 = Shot
 156   #! Bit 2 = Your ship hit
 157   #! Bit 3 = Invader hit
 158   #! Bit 4 = Extended play sound
 159   over 0 bit? over looping?>> not and [
 160     dup SOUND-UFO play-invaders-sound
 161     t over (>>looping?)
 162   ] when
 163   over 0 bit? not over looping?>> and [
 164     dup SOUND-UFO stop-invaders-sound
 165     f over (>>looping?)
 166   ] when
 167   2dup 0 port3-newly-set? [ dup SOUND-UFO  play-invaders-sound ] when
 168   2dup 1 port3-newly-set? [ dup SOUND-SHOT play-invaders-sound ] when
 169   2dup 2 port3-newly-set? [ dup SOUND-BASE-HIT play-invaders-sound ] when
 170   2dup 3 port3-newly-set? [ dup SOUND-INVADER-HIT play-invaders-sound ] when
 171   (>>port3o) ;
 172
 173 : write-port4 ( value cpu -- )
 174   #! Affects the value returned by reading port 3
 175   [ port4hi>> ] keep
 176   [ (>>port4lo) ] keep
 177   (>>port4hi) ;
 178
 179 : write-port5 ( value cpu -- )
 180   #! Plays sounds
 181   #! Bit 0 = invaders sound 1
 182   #! Bit 1 = invaders sound 2
 183   #! Bit 2 = invaders sound 3
 184   #! Bit 3 = invaders sound 4
 185   #! Bit 4 = spaceship hit
 186   #! Bit 5 = amplifier enabled/disabled
 187   2dup 0 port5-newly-set? [ dup SOUND-WALK1 play-invaders-sound ] when
 188   2dup 1 port5-newly-set? [ dup SOUND-WALK2 play-invaders-sound ] when
 189   2dup 2 port5-newly-set? [ dup SOUND-WALK3 play-invaders-sound ] when
 190   2dup 3 port5-newly-set? [ dup SOUND-WALK4 play-invaders-sound ] when
 191   2dup 4 port5-newly-set? [ dup SOUND-UFO-HIT play-invaders-sound ] when
 192   (>>port5o) ;
 193
 194 M: space-invaders write-port ( value port cpu -- )
 195   #! Write a byte to the hardware port, where 'port' is
 196   #! an 8-bit value.
 197   swap {
 198     { 2 [ write-port2 ] }
 199     { 3 [ write-port3 ] }
 200     { 4 [ write-port4 ] }
 201     { 5 [ write-port5 ] }
 202     [ 3drop ]
 203   } case ;
 204
 205 M: space-invaders reset ( cpu -- )
 206   dup call-next-method
 207   0 >>port1
 208   0 >>port2i
 209   0 >>port2o
 210   0 >>port3o
 211   0 >>port4lo
 212   0 >>port4hi
 213   0 >>port5o
 214   drop ;
 215
 216 : gui-step ( cpu -- )
 217   [ read-instruction ] keep ! n cpu
 218   over get-cycles over inc-cycles
 219   [ swap instructions nth call( cpu -- ) ] keep
 220   [ pc>> HEX: FFFF bitand ] keep
 221   (>>pc) ;
 222
 223 : gui-frame/2 ( cpu -- )
 224   [ gui-step ] keep
 225   [ cycles>> ] keep
 226   over 16667 < [ ! cycles cpu
 227     nip gui-frame/2
 228   ] [
 229     [ [ 16667 - ] dip (>>cycles) ] keep
 230     dup last-interrupt>> HEX: 10 = [
 231       HEX: 08 over (>>last-interrupt) HEX: 08 swap interrupt
 232     ] [
 233       HEX: 10 over (>>last-interrupt) HEX: 10 swap interrupt
 234     ] if
 235   ] if ;
 236
 237 : gui-frame ( cpu -- )
 238   dup gui-frame/2 gui-frame/2 ;
 239
 240 : coin-down ( cpu -- )
 241   [ port1>> 1 bitor ] keep (>>port1) ;
 242
 243 : coin-up ( cpu --  )
 244   [ port1>> 255 1 - bitand ] keep (>>port1) ;
 245
 246 : player1-down ( cpu -- )
 247   [ port1>> 4 bitor ] keep (>>port1) ;
 248
 249 : player1-up ( cpu -- )
 250   [ port1>> 255 4 - bitand ] keep (>>port1) ;
 251
 252 : player2-down ( cpu -- )
 253   [ port1>> 2 bitor ] keep (>>port1) ;
 254
 255 : player2-up ( cpu -- )
 256   [ port1>> 255 2 - bitand ] keep (>>port1) ;
 257
 258 : fire-down ( cpu -- )
 259   [ port1>> HEX: 10 bitor ] keep (>>port1) ;
 260
 261 : fire-up ( cpu -- )
 262   [ port1>> 255 HEX: 10 - bitand ] keep (>>port1) ;
 263
 264 : left-down ( cpu -- )
 265   [ port1>> HEX: 20 bitor ] keep (>>port1) ;
 266
 267 : left-up ( cpu -- )
 268   [ port1>> 255 HEX: 20 - bitand ] keep (>>port1) ;
 269
 270 : right-down ( cpu -- )
 271   [ port1>> HEX: 40 bitor ] keep (>>port1) ;
 272
 273 : right-up ( cpu -- )
 274   [ port1>> 255 HEX: 40 - bitand ] keep (>>port1) ;
 275
 276
 277 TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
 278
 279 invaders-gadget H{
 280     { T{ key-down f f "ESC" }    [ t over (>>quit?) dup windowed?>> [ close-window ] [ drop ] if ] }
 281     { T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
 282     { T{ key-up   f f "BACKSPACE" } [ cpu>> coin-up ] }
 283     { T{ key-down f f "1" }         [ cpu>> player1-down ] }
 284     { T{ key-up   f f "1" }         [ cpu>> player1-up ] }
 285     { T{ key-down f f "2" }         [ cpu>> player2-down ] }
 286     { T{ key-up   f f "2" }         [ cpu>> player2-up ] }
 287     { T{ key-down f f "UP" }        [ cpu>> fire-down ] }
 288     { T{ key-up   f f "UP" }        [ cpu>> fire-up ] }
 289     { T{ key-down f f "LEFT" }      [ cpu>> left-down ] }
 290     { T{ key-up   f f "LEFT" }      [ cpu>> left-up ] }
 291     { T{ key-down f f "RIGHT" }     [ cpu>> right-down ] }
 292     { T{ key-up   f f "RIGHT" }     [ cpu>> right-up ] }
 293   } set-gestures
 294
 295 : <invaders-gadget> ( cpu -- gadget )
 296   invaders-gadget  new
 297       swap >>cpu
 298       f >>quit? ;
 299
 300 M: invaders-gadget pref-dim* drop { 224 256 } ;
 301
 302 M: invaders-gadget draw-gadget* ( gadget -- )
 303   0 0 glRasterPos2i
 304   1.0 -1.0 glPixelZoom
 305   [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip
 306   cpu>> bitmap>> glDrawPixels ;
 307
 308 CONSTANT: black { 0 0 0 }
 309 CONSTANT: white { 255 255 255 }
 310 CONSTANT: green { 0 255 0 }
 311 CONSTANT: red   { 255 0 0 }
 312
 313 : addr>xy ( addr -- point )
 314   #! Convert video RAM address to base X Y value. point is a {x y}.
 315   HEX: 2400 - ! n
 316   dup HEX: 1f bitand 8 * 255 swap - ! n y
 317   swap -5 shift swap 2array ;
 318
 319 : plot-bitmap-pixel ( bitmap point color -- )
 320   #! point is a {x y}. color is a {r g b}.
 321   set-bitmap-pixel ;
 322
 323 : get-point-color ( point -- color )
 324   #! Return the color to use for the given x/y position.
 325   first2
 326   {
 327     { [ dup 184 238 between? pick 0 223 between? and ] [ 2drop green ] }
 328     { [ dup 240 247 between? pick 16 133 between? and ] [ 2drop green ] }
 329     { [ dup 247 215 - 247 184 - between? pick 0 223 between? and ] [ 2drop red ] }
 330     [ 2drop white ]
 331   } cond ;
 332
 333 : plot-bitmap-bits ( bitmap point byte bit -- )
 334   #! point is a {x y}.
 335   [ first2 ] 2dip
 336   dup swapd -1 * shift 1 bitand 0 =
 337   [ - 2array ] dip
 338   [ black ] [ dup get-point-color ] if
 339   plot-bitmap-pixel ;
 340
 341 : do-bitmap-update ( bitmap value addr -- )
 342   addr>xy swap
 343   [ 0 plot-bitmap-bits ] 3keep
 344   [ 1 plot-bitmap-bits ] 3keep
 345   [ 2 plot-bitmap-bits ] 3keep
 346   [ 3 plot-bitmap-bits ] 3keep
 347   [ 4 plot-bitmap-bits ] 3keep
 348   [ 5 plot-bitmap-bits ] 3keep
 349   [ 6 plot-bitmap-bits ] 3keep
 350   7 plot-bitmap-bits ;
 351
 352 M: space-invaders update-video ( value addr cpu -- )
 353   over HEX: 2400 >= [
 354     bitmap>> -rot do-bitmap-update
 355   ] [
 356     3drop
 357   ] if ;
 358
 359 : sync-frame ( micros -- micros )
 360   #! Sleep until the time for the next frame arrives.
 361   1000 60 / >fixnum + system:system-micros - dup 0 >
 362   [ milliseconds threads:sleep ] [ drop threads:yield ] if system:system-micros ;
 363
 364 : invaders-process ( micros gadget -- )
 365   #! Run a space invaders gadget inside a
 366   #! concurrent process. Messages can be sent to
 367   #! signal key presses, etc.
 368   dup quit?>> [
 369     2drop
 370   ] [
 371     [ sync-frame ] dip
 372     [ cpu>> gui-frame ] keep
 373     [ relayout-1 ] keep
 374     invaders-process
 375   ] if ;
 376
 377 M: invaders-gadget graft* ( gadget -- )
 378   dup cpu>> init-sounds
 379   f over (>>quit?)
 380   [ system:system-micros swap invaders-process ] curry
 381   "Space invaders" threads:spawn drop ;
 382
 383 M: invaders-gadget ungraft* ( gadget -- )
 384  t swap (>>quit?) ;
 385
 386 : (run) ( title cpu rom-info -- )
 387   over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
 388
 389 CONSTANT: rom-info {
 390       { HEX: 0000 "invaders/invaders.h" }
 391       { HEX: 0800 "invaders/invaders.g" }
 392       { HEX: 1000 "invaders/invaders.f" }
 393       { HEX: 1800 "invaders/invaders.e" }
 394    }
 395
 396 : run-invaders ( -- )
 397   [
 398     "Space Invaders" <space-invaders> rom-info (run)
 399   ] with-ui ;
 400
 401 MAIN: run-invaders