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