math
math.order
openal
+ openal.alut
opengl.gl
sequences
ui
: init-sounds ( cpu -- )
init-openal
- [ 9 gen-sources swap (>>sounds) ] keep
- [ SOUND-SHOT "resource:extra/space-invaders/resources/Shot.wav" init-sound ] keep
- [ SOUND-UFO "resource:extra/space-invaders/resources/Ufo.wav" init-sound ] keep
+ [ 9 gen-sources swap sounds<< ] keep
+ [ SOUND-SHOT "vocab:space-invaders/resources/Shot.wav" init-sound ] keep
+ [ SOUND-UFO "vocab:space-invaders/resources/Ufo.wav" init-sound ] keep
[ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep
- [ SOUND-BASE-HIT "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] keep
- [ SOUND-INVADER-HIT "resource:extra/space-invaders/resources/InvHit.Wav" init-sound ] keep
- [ SOUND-WALK1 "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep
- [ SOUND-WALK2 "resource:extra/space-invaders/resources/Walk2.wav" init-sound ] keep
- [ SOUND-WALK3 "resource:extra/space-invaders/resources/Walk3.wav" init-sound ] keep
- [ SOUND-WALK4 "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep
- [ SOUND-UFO-HIT "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
- f swap (>>looping?) ;
+ [ SOUND-BASE-HIT "vocab:space-invaders/resources/BaseHit.wav" init-sound ] keep
+ [ SOUND-INVADER-HIT "vocab:space-invaders/resources/InvHit.Wav" init-sound ] keep
+ [ SOUND-WALK1 "vocab:space-invaders/resources/Walk1.wav" init-sound ] keep
+ [ SOUND-WALK2 "vocab:space-invaders/resources/Walk2.wav" init-sound ] keep
+ [ SOUND-WALK3 "vocab:space-invaders/resources/Walk3.wav" init-sound ] keep
+ [ SOUND-WALK4 "vocab:space-invaders/resources/Walk4.wav" init-sound ] keep
+ [ SOUND-UFO-HIT "vocab:space-invaders/resources/UfoHit.wav" init-sound ] keep
+ f swap looping?<< ;
: cpu-init ( cpu -- cpu )
- make-opengl-bitmap over (>>bitmap)
+ make-opengl-bitmap over bitmap<<
[ init-sounds ] keep
[ reset ] keep ;
#! Bit 4 = player one fire
#! Bit 5 = player one left
#! Bit 6 = player one right
- [ port1>> dup HEX: FE bitand ] keep
- (>>port1) ;
+ [ port1>> dup 0xFE bitand ] keep
+ port1<< ;
: read-port2 ( cpu -- byte )
#! Port 2 maps player 2 controls and dip switches
#! Bit 5 = player two left
#! Bit 6 = player two right
#! Bit 7 = show or hide coin info
- [ port2i>> HEX: 8F bitand ] keep
- port1>> HEX: 70 bitand bitor ;
+ [ port2i>> 0x8F bitand ] keep
+ port1>> 0x70 bitand bitor ;
: read-port3 ( cpu -- byte )
#! Used to compute a special formula
[ port4hi>> 8 shift ] keep
[ port4lo>> bitor ] keep
- port2o>> shift -8 shift HEX: FF bitand ;
+ port2o>> shift -8 shift 0xFF bitand ;
M: space-invaders read-port ( port cpu -- byte )
#! Read a byte from the hardware port. 'port' should
: write-port2 ( value cpu -- )
#! Setting this value affects the value read from port 3
- (>>port2o) ;
+ port2o<< ;
:: bit-newly-set? ( old-value new-value bit -- bool )
new-value bit bit? [ old-value bit bit? not ] dip and ;
#! Bit 4 = Extended play sound
over 0 bit? over looping?>> not and [
dup SOUND-UFO play-invaders-sound
- t over (>>looping?)
+ t over looping?<<
] when
over 0 bit? not over looping?>> and [
dup SOUND-UFO stop-invaders-sound
- f over (>>looping?)
+ f over looping?<<
] when
2dup 0 port3-newly-set? [ dup SOUND-UFO play-invaders-sound ] when
2dup 1 port3-newly-set? [ dup SOUND-SHOT play-invaders-sound ] when
2dup 2 port3-newly-set? [ dup SOUND-BASE-HIT play-invaders-sound ] when
2dup 3 port3-newly-set? [ dup SOUND-INVADER-HIT play-invaders-sound ] when
- (>>port3o) ;
+ port3o<< ;
: write-port4 ( value cpu -- )
#! Affects the value returned by reading port 3
[ port4hi>> ] keep
- [ (>>port4lo) ] keep
- (>>port4hi) ;
+ [ port4lo<< ] keep
+ port4hi<< ;
: write-port5 ( value cpu -- )
#! Plays sounds
2dup 2 port5-newly-set? [ dup SOUND-WALK3 play-invaders-sound ] when
2dup 3 port5-newly-set? [ dup SOUND-WALK4 play-invaders-sound ] when
2dup 4 port5-newly-set? [ dup SOUND-UFO-HIT play-invaders-sound ] when
- (>>port5o) ;
+ port5o<< ;
M: space-invaders write-port ( value port cpu -- )
#! Write a byte to the hardware port, where 'port' is
[ read-instruction ] keep ! n cpu
over get-cycles over inc-cycles
[ swap instructions nth call( cpu -- ) ] keep
- [ pc>> HEX: FFFF bitand ] keep
- (>>pc) ;
+ [ pc>> 0xFFFF bitand ] keep
+ pc<< ;
: gui-frame/2 ( cpu -- )
[ gui-step ] keep
over 16667 < [ ! cycles cpu
nip gui-frame/2
] [
- [ [ 16667 - ] dip (>>cycles) ] keep
- dup last-interrupt>> HEX: 10 = [
- HEX: 08 over (>>last-interrupt) HEX: 08 swap interrupt
+ [ [ 16667 - ] dip cycles<< ] keep
+ dup last-interrupt>> 0x10 = [
+ 0x08 over last-interrupt<< 0x08 swap interrupt
] [
- HEX: 10 over (>>last-interrupt) HEX: 10 swap interrupt
+ 0x10 over last-interrupt<< 0x10 swap interrupt
] if
] if ;
dup gui-frame/2 gui-frame/2 ;
: coin-down ( cpu -- )
- [ port1>> 1 bitor ] keep (>>port1) ;
+ [ port1>> 1 bitor ] keep port1<< ;
: coin-up ( cpu -- )
- [ port1>> 255 1 - bitand ] keep (>>port1) ;
+ [ port1>> 255 1 - bitand ] keep port1<< ;
: player1-down ( cpu -- )
- [ port1>> 4 bitor ] keep (>>port1) ;
+ [ port1>> 4 bitor ] keep port1<< ;
: player1-up ( cpu -- )
- [ port1>> 255 4 - bitand ] keep (>>port1) ;
+ [ port1>> 255 4 - bitand ] keep port1<< ;
: player2-down ( cpu -- )
- [ port1>> 2 bitor ] keep (>>port1) ;
+ [ port1>> 2 bitor ] keep port1<< ;
: player2-up ( cpu -- )
- [ port1>> 255 2 - bitand ] keep (>>port1) ;
+ [ port1>> 255 2 - bitand ] keep port1<< ;
: fire-down ( cpu -- )
- [ port1>> HEX: 10 bitor ] keep (>>port1) ;
+ [ port1>> 0x10 bitor ] keep port1<< ;
: fire-up ( cpu -- )
- [ port1>> 255 HEX: 10 - bitand ] keep (>>port1) ;
+ [ port1>> 255 0x10 - bitand ] keep port1<< ;
: left-down ( cpu -- )
- [ port1>> HEX: 20 bitor ] keep (>>port1) ;
+ [ port1>> 0x20 bitor ] keep port1<< ;
: left-up ( cpu -- )
- [ port1>> 255 HEX: 20 - bitand ] keep (>>port1) ;
+ [ port1>> 255 0x20 - bitand ] keep port1<< ;
: right-down ( cpu -- )
- [ port1>> HEX: 40 bitor ] keep (>>port1) ;
+ [ port1>> 0x40 bitor ] keep port1<< ;
: right-up ( cpu -- )
- [ port1>> 255 HEX: 40 - bitand ] keep (>>port1) ;
+ [ port1>> 255 0x40 - bitand ] keep port1<< ;
TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
invaders-gadget H{
- { T{ key-down f f "ESC" } [ t over (>>quit?) dup windowed?>> [ close-window ] [ drop ] if ] }
+ { T{ key-down f f "ESC" } [ t over quit?<< dup windowed?>> [ close-window ] [ drop ] if ] }
{ T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
{ T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] }
{ T{ key-down f f "1" } [ cpu>> player1-down ] }
: addr>xy ( addr -- point )
#! Convert video RAM address to base X Y value. point is a {x y}.
- HEX: 2400 - ! n
- dup HEX: 1f bitand 8 * 255 swap - ! n y
+ 0x2400 - ! n
+ dup 0x1f bitand 8 * 255 swap - ! n y
swap -5 shift swap 2array ;
: plot-bitmap-pixel ( bitmap point color -- )
7 plot-bitmap-bits ;
M: space-invaders update-video ( value addr cpu -- )
- over HEX: 2400 >= [
+ over 0x2400 >= [
bitmap>> -rot do-bitmap-update
] [
3drop
] if ;
-: sync-frame ( millis -- millis )
+: sync-frame ( micros -- micros )
#! Sleep until the time for the next frame arrives.
- 1000 60 / >fixnum + system:millis - dup 0 >
- [ milliseconds threads:sleep ] [ drop threads:yield ] if system:millis ;
+ 1000 60 / >fixnum + gmt timestamp>micros - dup 0 >
+ [ milliseconds threads:sleep ] [ drop threads:yield ] if gmt timestamp>micros ;
-: invaders-process ( millis gadget -- )
+: invaders-process ( micros gadget -- )
#! Run a space invaders gadget inside a
#! concurrent process. Messages can be sent to
#! signal key presses, etc.
M: invaders-gadget graft* ( gadget -- )
dup cpu>> init-sounds
- f over (>>quit?)
- [ system:millis swap invaders-process ] curry
+ f over quit?<<
+ [ gmt timestamp>micros swap invaders-process ] curry
"Space invaders" threads:spawn drop ;
M: invaders-gadget ungraft* ( gadget -- )
- t swap (>>quit?) ;
+ t swap quit?<< ;
: (run) ( title cpu rom-info -- )
over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
CONSTANT: rom-info {
- { HEX: 0000 "invaders/invaders.h" }
- { HEX: 0800 "invaders/invaders.g" }
- { HEX: 1000 "invaders/invaders.f" }
- { HEX: 1800 "invaders/invaders.e" }
+ { 0x0000 "invaders/invaders.h" }
+ { 0x0800 "invaders/invaders.g" }
+ { 0x1000 "invaders/invaders.f" }
+ { 0x1800 "invaders/invaders.e" }
}
: run-invaders ( -- )
projects / factor.git / blobdiff