steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

space-invaders: some cleanup.

db4
John Benediktsson 2014-12-12 11:00:16 -08:00
parent b50286f137
commit b477611142
1 changed files with 82 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
extra/space-invaders/space-invaders.factor
View File

@ -1,38 +1,18 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: USING: accessors alien.c-types alien.data arrays
accessors combinators cpu.8080 cpu.8080.emulator io.pathnames kernel
alien.c-types locals math math.order openal openal.alut opengl.gl sequences
alien.data specialized-arrays ui ui.gadgets ui.gestures ui.render ;
arrays
byte-arrays
calendar
combinators
cpu.8080
cpu.8080.emulator
io.files
io.pathnames
kernel
locals
math
math.order
openal
openal.alut
opengl.gl
sequences
ui
ui.gadgets
ui.gestures
ui.render
specialized-arrays
;
QUALIFIED: threads QUALIFIED: threads
QUALIFIED: system QUALIFIED: system
SPECIALIZED-ARRAY: uchar SPECIALIZED-ARRAY: uchar
IN: space-invaders IN: space-invaders
TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ; TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo
port4hi port5o bitmap sounds looping? ;
CONSTANT: game-width 224 CONSTANT: game-width 224
CONSTANT: game-height 256 CONSTANT: game-height 256
@ -52,9 +32,9 @@ CONSTANT: game-height 256
: get-bitmap-pixel ( point array -- color ) : get-bitmap-pixel ( point array -- color )
#! Point is a {x y}. color is a {r g b} #! Point is a {x y}. color is a {r g b}
[ bitmap-index ] dip [ bitmap-index ] dip
[ nth ] 2keep [ nth ]
[ [ 1 + ] dip nth ] 2keep [ [ 1 + ] dip nth ]
[ 2 + ] dip nth 3array ; [ [ 2 + ] dip nth ] 2tri 3array ;
CONSTANT: SOUND-SHOT 0 CONSTANT: SOUND-SHOT 0
CONSTANT: SOUND-UFO 1 CONSTANT: SOUND-UFO 1
@ -68,22 +48,23 @@ CONSTANT: SOUND-UFO-HIT 8
: init-sound ( index cpu filename -- ) : init-sound ( index cpu filename -- )
absolute-path swapd [ sounds>> nth AL_BUFFER ] dip absolute-path swapd [ sounds>> nth AL_BUFFER ] dip
create-buffer-from-wav set-source-param ; create-buffer-from-wav set-source-param ;
: init-sounds ( cpu -- ) : init-sounds ( cpu -- )
init-openal init-openal {
[ 9 gen-sources swap sounds<< ] keep [ 9 gen-sources swap sounds<< ]
[ SOUND-SHOT "vocab:space-invaders/resources/Shot.wav" init-sound ] keep [ SOUND-SHOT "vocab:space-invaders/resources/Shot.wav" init-sound ]
[ SOUND-UFO "vocab:space-invaders/resources/Ufo.wav" init-sound ] keep [ SOUND-UFO "vocab:space-invaders/resources/Ufo.wav" init-sound ]
[ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep [ sounds>> SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ]
[ SOUND-BASE-HIT "vocab:space-invaders/resources/BaseHit.wav" init-sound ] keep [ SOUND-BASE-HIT "vocab:space-invaders/resources/BaseHit.wav" init-sound ]
[ SOUND-INVADER-HIT "vocab:space-invaders/resources/InvHit.Wav" init-sound ] keep [ SOUND-INVADER-HIT "vocab:space-invaders/resources/InvHit.Wav" init-sound ]
[ SOUND-WALK1 "vocab:space-invaders/resources/Walk1.wav" init-sound ] keep [ SOUND-WALK1 "vocab:space-invaders/resources/Walk1.wav" init-sound ]
[ SOUND-WALK2 "vocab:space-invaders/resources/Walk2.wav" init-sound ] keep [ SOUND-WALK2 "vocab:space-invaders/resources/Walk2.wav" init-sound ]
[ SOUND-WALK3 "vocab:space-invaders/resources/Walk3.wav" init-sound ] keep [ SOUND-WALK3 "vocab:space-invaders/resources/Walk3.wav" init-sound ]
[ SOUND-WALK4 "vocab:space-invaders/resources/Walk4.wav" init-sound ] keep [ SOUND-WALK4 "vocab:space-invaders/resources/Walk4.wav" init-sound ]
[ SOUND-UFO-HIT "vocab:space-invaders/resources/UfoHit.wav" init-sound ] keep [ SOUND-UFO-HIT "vocab:space-invaders/resources/UfoHit.wav" init-sound ]
f swap looping?<< ; [ f swap looping?<< ]
} cleave ;
: cpu-init ( cpu -- cpu ) : cpu-init ( cpu -- cpu )
make-opengl-bitmap >>bitmap make-opengl-bitmap >>bitmap
@ -107,8 +88,7 @@ CONSTANT: SOUND-UFO-HIT 8
#! Bit 4 = player one fire #! Bit 4 = player one fire
#! Bit 5 = player one left #! Bit 5 = player one left
#! Bit 6 = player one right #! Bit 6 = player one right
[ port1>> dup 0xFE bitand ] keep [ dup 0xFE bitand ] change-port1 drop ;
port1<< ;
: read-port2 ( cpu -- byte ) : read-port2 ( cpu -- byte )
#! Port 2 maps player 2 controls and dip switches #! Port 2 maps player 2 controls and dip switches
@ -118,8 +98,8 @@ CONSTANT: SOUND-UFO-HIT 8
#! Bit 5 = player two left #! Bit 5 = player two left
#! Bit 6 = player two right #! Bit 6 = player two right
#! Bit 7 = show or hide coin info #! Bit 7 = show or hide coin info
[ port2i>> 0x8F bitand ] keep [ port2i>> 0x8F bitand ]
port1>> 0x70 bitand bitor ; [ port1>> 0x70 bitand bitor ] bi ;
: read-port3 ( cpu -- byte ) : read-port3 ( cpu -- byte )
#! Used to compute a special formula #! Used to compute a special formula
@ -127,7 +107,7 @@ CONSTANT: SOUND-UFO-HIT 8
[ port4lo>> bitor ] keep [ port4lo>> bitor ] keep
port2o>> shift -8 shift 0xFF bitand ; port2o>> shift -8 shift 0xFF bitand ;
M: space-invaders read-port ( port cpu -- byte ) M: space-invaders read-port
#! Read a byte from the hardware port. 'port' should #! Read a byte from the hardware port. 'port' should
#! be an 8-bit value. #! be an 8-bit value.
swap { swap {
@ -142,7 +122,7 @@ M: space-invaders read-port ( port cpu -- byte )
port2o<< ; port2o<< ;
:: bit-newly-set? ( old-value new-value bit -- bool ) :: bit-newly-set? ( old-value new-value bit -- bool )
new-value bit bit? [ old-value bit bit? not ] dip and ; old-value bit bit? not new-value bit bit? and ;
: port3-newly-set? ( new-value cpu bit -- bool ) : port3-newly-set? ( new-value cpu bit -- bool )
[ port3o>> swap ] dip bit-newly-set? ; [ port3o>> swap ] dip bit-newly-set? ;
@ -153,18 +133,21 @@ M: space-invaders read-port ( port cpu -- byte )
: write-port3 ( value cpu -- ) : write-port3 ( value cpu -- )
#! Connected to the sound hardware #! Connected to the sound hardware
#! Bit 0 = spaceship sound (looped) #! Bit 0 = spaceship sound (looped)
#! Bit 1 = Shot #! Bit 1 = Shot
#! Bit 2 = Your ship hit #! Bit 2 = Your ship hit
#! Bit 3 = Invader hit #! Bit 3 = Invader hit
#! Bit 4 = Extended play sound #! Bit 4 = Extended play sound
over 0 bit? over looping?>> not and [ over 0 bit? [
dup SOUND-UFO play-invaders-sound dup looping?>> [
t >>looping? dup SOUND-UFO play-invaders-sound
] when t >>looping?
over 0 bit? not over looping?>> and [ ] unless
dup SOUND-UFO stop-invaders-sound ] [
f >>looping? dup looping?>> [
] when dup SOUND-UFO stop-invaders-sound
f >>looping?
] when
] if
2dup 0 port3-newly-set? [ dup SOUND-UFO play-invaders-sound ] 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 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 2 port3-newly-set? [ dup SOUND-BASE-HIT play-invaders-sound ] when
@ -173,9 +156,7 @@ M: space-invaders read-port ( port cpu -- byte )
: write-port4 ( value cpu -- ) : write-port4 ( value cpu -- )
#! Affects the value returned by reading port 3 #! Affects the value returned by reading port 3
[ port4hi>> ] keep [ port4hi>> ] [ port4lo<< ] [ port4hi<< ] tri ;
[ port4lo<< ] keep
port4hi<< ;
: write-port5 ( value cpu -- ) : write-port5 ( value cpu -- )
#! Plays sounds #! Plays sounds
@ -192,9 +173,9 @@ M: space-invaders read-port ( port cpu -- byte )
2dup 4 port5-newly-set? [ dup SOUND-UFO-HIT 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 -- ) M: space-invaders write-port
#! Write a byte to the hardware port, where 'port' is #! Write a byte to the hardware port, where 'port' is
#! an 8-bit value. #! an 8-bit value.
swap { swap {
{ 2 [ write-port2 ] } { 2 [ write-port2 ] }
{ 3 [ write-port3 ] } { 3 [ write-port3 ] }
@ -203,7 +184,7 @@ M: space-invaders write-port ( value port cpu -- )
[ 3drop ] [ 3drop ]
} case ; } case ;
M: space-invaders reset ( cpu -- ) M: space-invaders reset
dup call-next-method dup call-next-method
0 >>port1 0 >>port1
0 >>port2i 0 >>port2i
@ -239,46 +220,45 @@ M: space-invaders reset ( cpu -- )
dup gui-frame/2 gui-frame/2 ; dup gui-frame/2 gui-frame/2 ;
: coin-down ( cpu -- ) : coin-down ( cpu -- )
[ port1>> 1 bitor ] keep port1<< ; [ 1 bitor ] change-port1 drop ;
: coin-up ( cpu -- ) : coin-up ( cpu -- )
[ port1>> 255 1 - bitand ] keep port1<< ; [ 255 1 - bitand ] change-port1 drop ;
: player1-down ( cpu -- ) : player1-down ( cpu -- )
[ port1>> 4 bitor ] keep port1<< ; [ 4 bitor ] change-port1 drop ;
: player1-up ( cpu -- ) : player1-up ( cpu -- )
[ port1>> 255 4 - bitand ] keep port1<< ; [ 255 4 - bitand ] change-port1 drop ;
: player2-down ( cpu -- ) : player2-down ( cpu -- )
[ port1>> 2 bitor ] keep port1<< ; [ 2 bitor ] change-port1 drop ;
: player2-up ( cpu -- ) : player2-up ( cpu -- )
[ port1>> 255 2 - bitand ] keep port1<< ; [ 255 2 - bitand ] change-port1 drop ;
: fire-down ( cpu -- ) : fire-down ( cpu -- )
[ port1>> 0x10 bitor ] keep port1<< ; [ 0x10 bitor ] change-port1 drop ;
: fire-up ( cpu -- ) : fire-up ( cpu -- )
[ port1>> 255 0x10 - bitand ] keep port1<< ; [ 255 0x10 - bitand ] change-port1 drop ;
: left-down ( cpu -- ) : left-down ( cpu -- )
[ port1>> 0x20 bitor ] keep port1<< ; [ 0x20 bitor ] change-port1 drop ;
: left-up ( cpu -- ) : left-up ( cpu -- )
[ port1>> 255 0x20 - bitand ] keep port1<< ; [ 255 0x20 - bitand ] change-port1 drop ;
: right-down ( cpu -- ) : right-down ( cpu -- )
[ port1>> 0x40 bitor ] keep port1<< ; [ 0x40 bitor ] change-port1 drop ;
: right-up ( cpu -- ) : right-up ( cpu -- )
[ port1>> 255 0x40 - bitand ] keep port1<< ; [ 255 0x40 - bitand ] change-port1 drop ;
TUPLE: invaders-gadget < gadget cpu quit? windowed? ; TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
invaders-gadget H{ invaders-gadget H{
{ T{ key-down f f "ESC" } [ t >>quit? dup windowed?>> [ close-window ] [ drop ] if ] } { T{ key-down f f "ESC" } [ t >>quit? dup windowed?>> [ close-window ] [ drop ] if ] }
{ T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] } { T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
{ T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] } { T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] }
{ T{ key-down f f "1" } [ cpu>> player1-down ] } { T{ key-down f f "1" } [ cpu>> player1-down ] }
@ -300,16 +280,16 @@ invaders-gadget H{
M: invaders-gadget pref-dim* drop { 224 256 } ; M: invaders-gadget pref-dim* drop { 224 256 } ;
M: invaders-gadget draw-gadget* ( gadget -- ) M: invaders-gadget draw-gadget*
0 0 glRasterPos2i 0 0 glRasterPos2i
1.0 -1.0 glPixelZoom 1.0 -1.0 glPixelZoom
[ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip
cpu>> bitmap>> glDrawPixels ; cpu>> bitmap>> glDrawPixels ;
CONSTANT: black { 0 0 0 } CONSTANT: black { 0 0 0 }
CONSTANT: white { 255 255 255 } CONSTANT: white { 255 255 255 }
CONSTANT: green { 0 255 0 } CONSTANT: green { 0 255 0 }
CONSTANT: red { 255 0 0 } CONSTANT: red { 255 0 0 }
: addr>xy ( addr -- point ) : addr>xy ( addr -- point )
#! Convert video RAM address to base X Y value. point is a {x y}. #! Convert video RAM address to base X Y value. point is a {x y}.
@ -340,17 +320,9 @@ CONSTANT: red { 255 0 0 }
plot-bitmap-pixel ; plot-bitmap-pixel ;
: do-bitmap-update ( bitmap value addr -- ) : do-bitmap-update ( bitmap value addr -- )
addr>xy swap addr>xy swap 8 iota [ plot-bitmap-bits ] with with with each ;
[ 0 plot-bitmap-bits ] 3keep
[ 1 plot-bitmap-bits ] 3keep
[ 2 plot-bitmap-bits ] 3keep
[ 3 plot-bitmap-bits ] 3keep
[ 4 plot-bitmap-bits ] 3keep
[ 5 plot-bitmap-bits ] 3keep
[ 6 plot-bitmap-bits ] 3keep
7 plot-bitmap-bits ;
M: space-invaders update-video ( value addr cpu -- ) M: space-invaders update-video
over 0x2400 >= [ over 0x2400 >= [
bitmap>> -rot do-bitmap-update bitmap>> -rot do-bitmap-update
] [ ] [
@ -359,8 +331,9 @@ M: space-invaders update-video ( value addr cpu -- )
: sync-frame ( micros -- micros ) : sync-frame ( micros -- micros )
#! Sleep until the time for the next frame arrives. #! Sleep until the time for the next frame arrives.
1000 60 / >fixnum + gmt timestamp>micros - dup 0 > 16,667 + system:nano-count - dup 0 >
[ milliseconds threads:sleep ] [ drop threads:yield ] if gmt timestamp>micros ; [ 1,000 * threads:sleep ] [ drop threads:yield ] if
system:nano-count ;
: invaders-process ( micros gadget -- ) : invaders-process ( micros gadget -- )
#! Run a space invaders gadget inside a #! Run a space invaders gadget inside a
@ -369,24 +342,22 @@ M: space-invaders update-video ( value addr cpu -- )
dup quit?>> [ dup quit?>> [
2drop 2drop
] [ ] [
[ sync-frame ] dip [ sync-frame ] dip {
[ cpu>> gui-frame ] keep [ cpu>> gui-frame ]
[ relayout-1 ] keep [ relayout-1 ]
invaders-process [ invaders-process ]
} cleave
] if ; ] if ;
M: invaders-gadget graft* ( gadget -- ) M: invaders-gadget graft*
dup cpu>> init-sounds dup cpu>> init-sounds
f >>quit? f >>quit?
[ gmt timestamp>micros swap invaders-process ] curry [ system:nano-count swap invaders-process ] curry
"Space invaders" threads:spawn drop ; "Space invaders" threads:spawn drop ;
M: invaders-gadget ungraft* ( gadget -- ) M: invaders-gadget ungraft*
t swap quit?<< ; t swap quit?<< ;
: (run) ( title cpu rom-info -- )
over load-rom* <invaders-gadget> t >>windowed? swap open-window ;
CONSTANT: rom-info { CONSTANT: rom-info {
{ 0x0000 "invaders/invaders.h" } { 0x0000 "invaders/invaders.h" }
{ 0x0800 "invaders/invaders.g" } { 0x0800 "invaders/invaders.g" }
@ -394,9 +365,12 @@ CONSTANT: rom-info {
{ 0x1800 "invaders/invaders.e" } { 0x1800 "invaders/invaders.e" }
} }
: run-invaders ( -- ) : run-invaders ( -- )
[ [
"Space Invaders" <space-invaders> rom-info (run) <space-invaders>
rom-info over load-rom*
<invaders-gadget> t >>windowed?
"Space Invaders" open-window
] with-ui ; ] with-ui ;
MAIN: run-invaders MAIN: run-invaders