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