space-invaders: some cleanup.
parent
b50286f137
commit
b477611142
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue