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     specialized-arrays
  26 ;
  27 QUALIFIED: threads
  28 QUALIFIED: system
  29 SPECIALIZED-ARRAY: uchar
  30 IN: space-invaders
  31
  32 TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ;
  33 CONSTANT: game-width 224
  34 CONSTANT: game-height 256
  35
  36 : make-opengl-bitmap ( -- array )
  37   game-height game-width 3 * * uchar <c-array> ;
  38
  39 : bitmap-index ( point -- index )
  40   #! Point is a {x y}.
  41   first2 game-width 3 * * swap 3 * + ;
  42
  43 :: set-bitmap-pixel ( bitmap point color -- )
  44     color point bitmap
  45
  46     point color :> 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        "resource:extra/space-invaders/resources/Shot.wav" init-sound ] keep
  76   [ SOUND-UFO         "resource:extra/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    "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] keep
  79   [ SOUND-INVADER-HIT "resource:extra/space-invaders/resources/InvHit.Wav" init-sound ] keep
  80   [ SOUND-WALK1       "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep
  81   [ SOUND-WALK2       "resource:extra/space-invaders/resources/Walk2.wav" init-sound ] keep
  82   [ SOUND-WALK3       "resource:extra/space-invaders/resources/Walk3.wav" init-sound ] keep
  83   [ SOUND-WALK4       "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep
  84   [ SOUND-UFO-HIT    "resource:extra/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   tuck 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 : within ( n a b -- bool )
 324   #! n >= a and n <= b
 325   rot tuck swap <= [ swap >= ] dip and ;
 326
 327 : get-point-color ( point -- color )
 328   #! Return the color to use for the given x/y position.
 329   first2
 330   {
 331     { [ dup 184 238 within pick 0 223 within and ] [ 2drop green ] }
 332     { [ dup 240 247 within pick 16 133 within and ] [ 2drop green ] }
 333     { [ dup 247 215 - 247 184 - within pick 0 223 within and ] [ 2drop red ] }
 334     [ 2drop white ]
 335   } cond ;
 336
 337 : plot-bitmap-bits ( bitmap point byte bit -- )
 338   #! point is a {x y}.
 339   [ first2 ] 2dip
 340   dup swapd -1 * shift 1 bitand 0 =
 341   [ - 2array ] dip
 342   [ black ] [ dup get-point-color ] if
 343   plot-bitmap-pixel ;
 344
 345 : do-bitmap-update ( bitmap value addr -- )
 346   addr>xy swap
 347   [ 0 plot-bitmap-bits ] 3keep
 348   [ 1 plot-bitmap-bits ] 3keep
 349   [ 2 plot-bitmap-bits ] 3keep
 350   [ 3 plot-bitmap-bits ] 3keep
 351   [ 4 plot-bitmap-bits ] 3keep
 352   [ 5 plot-bitmap-bits ] 3keep
 353   [ 6 plot-bitmap-bits ] 3keep
 354   7 plot-bitmap-bits ;
 355
 356 M: space-invaders update-video ( value addr cpu -- )
 357   over HEX: 2400 >= [
 358     bitmap>> -rot do-bitmap-update
 359   ] [
 360     3drop
 361   ] if ;
 362
 363 : sync-frame ( millis -- millis )
 364   #! Sleep until the time for the next frame arrives.
 365   1000 60 / >fixnum + system:millis - dup 0 >
 366   [ milliseconds threads:sleep ] [ drop threads:yield ] if system:millis ;
 367
 368 : invaders-process ( millis gadget -- )
 369   #! Run a space invaders gadget inside a
 370   #! concurrent process. Messages can be sent to
 371   #! signal key presses, etc.
 372   dup quit?>> [
 373     2drop
 374   ] [
 375     [ sync-frame ] dip
 376     [ cpu>> gui-frame ] keep
 377     [ relayout-1 ] keep
 378     invaders-process
 379   ] if ;
 380
 381 M: invaders-gadget graft* ( gadget -- )
 382   dup cpu>> init-sounds
 383   f over (>>quit?)
 384   [ system:millis swap invaders-process ] curry
 385   "Space invaders" threads:spawn drop ;
 386
 387 M: invaders-gadget ungraft* ( gadget -- )
 388  t swap (>>quit?) ;
 389
 390 : (run) ( title cpu rom-info -- )
 391   over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
 392
 393 CONSTANT: rom-info {
 394       { HEX: 0000 "invaders/invaders.h" }
 395       { HEX: 0800 "invaders/invaders.g" }
 396       { HEX: 1000 "invaders/invaders.f" }
 397       { HEX: 1800 "invaders/invaders.e" }
 398    }
 399
 400 : run-invaders ( -- )
 401   [
 402     "Space Invaders" <space-invaders> rom-info (run)
 403   ] with-ui ;
 404
 405 MAIN: run-invaders