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

Fix bitrot in space-invaders and cpu.8080 vocabs

db4
Chris Double 2009-10-15 18:08:30 +13:00
parent 77216b9d68
commit d62714e403
25 changed files with 1931 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
extra/cpu/8080/8080-docs.factor Normal file
View File

@ -0,0 +1,16 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax sequences strings cpu.8080.emulator ;
IN: cpu.8080
ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator"
"The cpu-8080 library provides an emulator for the Intel 8080 CPU"
" instruction set. It is complete enough to emulate some 8080"
" based arcade games." $nl
"The emulated CPU can load 'ROM' files from disk using the "
{ $link load-rom } " and " { $link load-rom* } " words. These expect "
"the " { $link rom-root } " variable to be set to the path "
"containing the ROM file's." ;
ABOUT: { "cpu-8080" "cpu-8080" }

251
extra/cpu/8080/8080.factor Executable file
View File

@ -0,0 +1,251 @@
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
USING: cpu.8080.emulator tools.time ;
IN: cpu.8080
INSTRUCTION: NOP ; opcode 00 cycles 04
INSTRUCTION: LD BC,nn ; opcode 01 cycles 10
INSTRUCTION: LD (BC),A ; opcode 02 cycles 07
INSTRUCTION: INC BC ; opcode 03 cycles 06
INSTRUCTION: INC B ; opcode 04 cycles 05
INSTRUCTION: DEC B ; opcode 05 cycles 05
INSTRUCTION: LD B,n ; opcode 06 cycles 07
INSTRUCTION: RLCA ; opcode 07 cycles 04
! INSTRUCTION: NOP ; opcode 08 cycles 04
INSTRUCTION: ADD HL,BC ; opcode 09 cycles 11
INSTRUCTION: LD A,(BC) ; opcode 0A cycles 07
INSTRUCTION: DEC BC ; opcode 0B cycles 06
INSTRUCTION: INC C ; opcode 0C cycles 05
INSTRUCTION: DEC C ; opcode 0D cycles 05
INSTRUCTION: LD C,n ; opcode 0E cycles 07
INSTRUCTION: RRCA ; opcode 0F cycles 04
INSTRUCTION: LD DE,nn ; opcode 11 cycles 10
INSTRUCTION: LD (DE),A ; opcode 12 cycles 07
INSTRUCTION: INC DE ; opcode 13 cycles 06
INSTRUCTION: INC D ; opcode 14 cycles 05
INSTRUCTION: DEC D ; opcode 15 cycles 05
INSTRUCTION: LD D,n ; opcode 16 cycles 07
INSTRUCTION: RLA ; opcode 17 cycles 04
INSTRUCTION: ADD HL,DE ; opcode 19 cycles 11
INSTRUCTION: LD A,(DE) ; opcode 1A cycles 07
INSTRUCTION: DEC DE ; opcode 1B cycles 06
INSTRUCTION: INC E ; opcode 1C cycles 05
INSTRUCTION: DEC E ; opcode 1D cycles 05
INSTRUCTION: LD E,n ; opcode 1E cycles 07
INSTRUCTION: RRA ; opcode 1F cycles 04
INSTRUCTION: LD HL,nn ; opcode 21 cycles 10
INSTRUCTION: LD (nn),HL ; opcode 22 cycles 16
INSTRUCTION: INC HL ; opcode 23 cycles 06
INSTRUCTION: INC H ; opcode 24 cycles 05
INSTRUCTION: DEC H ; opcode 25 cycles 05
INSTRUCTION: LD H,n ; opcode 26 cycles 07
INSTRUCTION: DAA ; opcode 27 cycles 04
INSTRUCTION: ADD HL,HL ; opcode 29 cycles 11
INSTRUCTION: LD HL,(nn) ; opcode 2A cycles 16
INSTRUCTION: DEC HL ; opcode 2B cycles 06
INSTRUCTION: INC L ; opcode 2C cycles 05
INSTRUCTION: DEC L ; opcode 2D cycles 05
INSTRUCTION: LD L,n ; opcode 2E cycles 07
INSTRUCTION: CPL ; opcode 2F cycles 04
INSTRUCTION: LD SP,nn ; opcode 31 cycles 10
INSTRUCTION: LD (nn),A ; opcode 32 cycles 13
INSTRUCTION: INC SP ; opcode 33 cycles 06
INSTRUCTION: INC (HL) ; opcode 34 cycles 10
INSTRUCTION: DEC (HL) ; opcode 35 cycles 10
INSTRUCTION: LD (HL),n ; opcode 36 cycles 10
INSTRUCTION: SCF ; opcode 37 cycles 04
INSTRUCTION: ADD HL,SP ; opcode 39 cycles 11
INSTRUCTION: LD A,(nn) ; opcode 3A cycles 13
INSTRUCTION: DEC SP ; opcode 3B cycles 06
INSTRUCTION: INC A ; opcode 3C cycles 05
INSTRUCTION: DEC A ; opcode 3D cycles 05
INSTRUCTION: LD A,n ; opcode 3E cycles 07
INSTRUCTION: CCF ; opcode 3F cycles 04
INSTRUCTION: LD B,B ; opcode 40 cycles 05
INSTRUCTION: LD B,C ; opcode 41 cycles 05
INSTRUCTION: LD B,D ; opcode 42 cycles 05
INSTRUCTION: LD B,E ; opcode 43 cycles 05
INSTRUCTION: LD B,H ; opcode 44 cycles 05
INSTRUCTION: LD B,L ; opcode 45 cycles 05
INSTRUCTION: LD B,(HL) ; opcode 46 cycles 07
INSTRUCTION: LD B,A ; opcode 47 cycles 05
INSTRUCTION: LD C,B ; opcode 48 cycles 05
INSTRUCTION: LD C,C ; opcode 49 cycles 05
INSTRUCTION: LD C,D ; opcode 4A cycles 05
INSTRUCTION: LD C,E ; opcode 4B cycles 05
INSTRUCTION: LD C,H ; opcode 4C cycles 05
INSTRUCTION: LD C,L ; opcode 4D cycles 05
INSTRUCTION: LD C,(HL) ; opcode 4E cycles 07
INSTRUCTION: LD C,A ; opcode 4F cycles 05
INSTRUCTION: LD D,B ; opcode 50 cycles 05
INSTRUCTION: LD D,C ; opcode 51 cycles 05
INSTRUCTION: LD D,D ; opcode 52 cycles 05
INSTRUCTION: LD D,E ; opcode 53 cycles 05
INSTRUCTION: LD D,H ; opcode 54 cycles 05
INSTRUCTION: LD D,L ; opcode 55 cycles 05
INSTRUCTION: LD D,(HL) ; opcode 56 cycles 07
INSTRUCTION: LD D,A ; opcode 57 cycles 05
INSTRUCTION: LD E,B ; opcode 58 cycles 05
INSTRUCTION: LD E,C ; opcode 59 cycles 05
INSTRUCTION: LD E,D ; opcode 5A cycles 05
INSTRUCTION: LD E,E ; opcode 5B cycles 05
INSTRUCTION: LD E,H ; opcode 5C cycles 05
INSTRUCTION: LD E,L ; opcode 5D cycles 05
INSTRUCTION: LD E,(HL) ; opcode 5E cycles 07
INSTRUCTION: LD E,A ; opcode 5F cycles 05
INSTRUCTION: LD H,B ; opcode 60 cycles 05
INSTRUCTION: LD H,C ; opcode 61 cycles 05
INSTRUCTION: LD H,D ; opcode 62 cycles 05
INSTRUCTION: LD H,E ; opcode 63 cycles 05
INSTRUCTION: LD H,H ; opcode 64 cycles 05
INSTRUCTION: LD H,L ; opcode 65 cycles 05
INSTRUCTION: LD H,(HL) ; opcode 66 cycles 07
INSTRUCTION: LD H,A ; opcode 67 cycles 05
INSTRUCTION: LD L,B ; opcode 68 cycles 05
INSTRUCTION: LD L,C ; opcode 69 cycles 05
INSTRUCTION: LD L,D ; opcode 6A cycles 05
INSTRUCTION: LD L,E ; opcode 6B cycles 05
INSTRUCTION: LD L,H ; opcode 6C cycles 05
INSTRUCTION: LD L,L ; opcode 6D cycles 05
INSTRUCTION: LD L,(HL) ; opcode 6E cycles 07
INSTRUCTION: LD L,A ; opcode 6F cycles 05
INSTRUCTION: LD (HL),B ; opcode 70 cycles 07
INSTRUCTION: LD (HL),C ; opcode 71 cycles 07
INSTRUCTION: LD (HL),D ; opcode 72 cycles 07
INSTRUCTION: LD (HL),E ; opcode 73 cycles 07
INSTRUCTION: LD (HL),H ; opcode 74 cycles 07
INSTRUCTION: LD (HL),L ; opcode 75 cycles 07
INSTRUCTION: HALT ; opcode 76 cycles 07
INSTRUCTION: LD (HL),A ; opcode 77 cycles 07
INSTRUCTION: LD A,B ; opcode 78 cycles 05
INSTRUCTION: LD A,C ; opcode 79 cycles 05
INSTRUCTION: LD A,D ; opcode 7A cycles 05
INSTRUCTION: LD A,E ; opcode 7B cycles 05
INSTRUCTION: LD A,H ; opcode 7C cycles 05
INSTRUCTION: LD A,L ; opcode 7D cycles 05
INSTRUCTION: LD A,(HL) ; opcode 7E cycles 07
INSTRUCTION: LD A,A ; opcode 7F cycles 05
INSTRUCTION: ADD A,B ; opcode 80 cycles 04
INSTRUCTION: ADD A,C ; opcode 81 cycles 04
INSTRUCTION: ADD A,D ; opcode 82 cycles 04
INSTRUCTION: ADD A,E ; opcode 83 cycles 04
INSTRUCTION: ADD A,H ; opcode 84 cycles 04
INSTRUCTION: ADD A,L ; opcode 85 cycles 04
INSTRUCTION: ADD A,(HL) ; opcode 86 cycles 07
INSTRUCTION: ADD A,A ; opcode 87 cycles 04
INSTRUCTION: ADC A,B ; opcode 88 cycles 04
INSTRUCTION: ADC A,C ; opcode 89 cycles 04
INSTRUCTION: ADC A,D ; opcode 8A cycles 04
INSTRUCTION: ADC A,E ; opcode 8B cycles 04
INSTRUCTION: ADC A,H ; opcode 8C cycles 04
INSTRUCTION: ADC A,L ; opcode 8D cycles 04
INSTRUCTION: ADC A,(HL) ; opcode 8E cycles 07
INSTRUCTION: ADC A,A ; opcode 8F cycles 04
INSTRUCTION: SUB B ; opcode 90 cycles 04
INSTRUCTION: SUB C ; opcode 91 cycles 04
INSTRUCTION: SUB D ; opcode 92 cycles 04
INSTRUCTION: SUB E ; opcode 93 cycles 04
INSTRUCTION: SUB H ; opcode 94 cycles 04
INSTRUCTION: SUB L ; opcode 95 cycles 04
INSTRUCTION: SUB (HL) ; opcode 96 cycles 07
INSTRUCTION: SUB A ; opcode 97 cycles 04
INSTRUCTION: SBC A,B ; opcode 98 cycles 04
INSTRUCTION: SBC A,C ; opcode 99 cycles 04
INSTRUCTION: SBC A,D ; opcode 9A cycles 04
INSTRUCTION: SBC A,E ; opcode 9B cycles 04
INSTRUCTION: SBC A,H ; opcode 9C cycles 04
INSTRUCTION: SBC A,L ; opcode 9D cycles 04
INSTRUCTION: SBC A,(HL) ; opcode 9E cycles 07
INSTRUCTION: SBC A,A ; opcode 9F cycles 04
INSTRUCTION: AND B ; opcode A0 cycles 04
INSTRUCTION: AND C ; opcode A1 cycles 04
INSTRUCTION: AND D ; opcode A2 cycles 04
INSTRUCTION: AND E ; opcode A3 cycles 04
INSTRUCTION: AND H ; opcode A4 cycles 04
INSTRUCTION: AND L ; opcode A5 cycles 04
INSTRUCTION: AND (HL) ; opcode A6 cycles 07
INSTRUCTION: AND A ; opcode A7 cycles 04
INSTRUCTION: XOR B ; opcode A8 cycles 04
INSTRUCTION: XOR C ; opcode A9 cycles 04
INSTRUCTION: XOR D ; opcode AA cycles 04
INSTRUCTION: XOR E ; opcode AB cycles 04
INSTRUCTION: XOR H ; opcode AC cycles 04
INSTRUCTION: XOR L ; opcode AD cycles 04
INSTRUCTION: XOR (HL) ; opcode AE cycles 07
INSTRUCTION: XOR A ; opcode AF cycles 04
INSTRUCTION: OR B ; opcode B0 cycles 04
INSTRUCTION: OR C ; opcode B1 cycles 04
INSTRUCTION: OR D ; opcode B2 cycles 04
INSTRUCTION: OR E ; opcode B3 cycles 04
INSTRUCTION: OR H ; opcode B4 cycles 04
INSTRUCTION: OR L ; opcode B5 cycles 04
INSTRUCTION: OR (HL) ; opcode B6 cycles 07
INSTRUCTION: OR A ; opcode B7 cycles 04
INSTRUCTION: CP B ; opcode B8 cycles 04
INSTRUCTION: CP C ; opcode B9 cycles 04
INSTRUCTION: CP D ; opcode BA cycles 04
INSTRUCTION: CP E ; opcode BB cycles 04
INSTRUCTION: CP H ; opcode BC cycles 04
INSTRUCTION: CP L ; opcode BD cycles 04
INSTRUCTION: CP (HL) ; opcode BE cycles 07
INSTRUCTION: CP A ; opcode BF cycles 04
INSTRUCTION: RET NZ ; opcode C0 cycles 05
INSTRUCTION: POP BC ; opcode C1 cycles 10
INSTRUCTION: JP NZ,nn ; opcode C2 cycles 10
INSTRUCTION: JP nn ; opcode C3 cycles 10
INSTRUCTION: CALL NZ,nn ; opcode C4 cycles 11
INSTRUCTION: PUSH BC ; opcode C5 cycles 11
INSTRUCTION: ADD A,n ; opcode C6 cycles 07
INSTRUCTION: RST 0 ; opcode C7 cycles 11
INSTRUCTION: RET Z ; opcode C8 cycles 05
INSTRUCTION: RET nn ; opcode C9 cycles 10
INSTRUCTION: JP Z,nn ; opcode CA cycles 10
INSTRUCTION: CALL Z,nn ; opcode CC cycles 11
INSTRUCTION: CALL nn ; opcode CD cycles 17
INSTRUCTION: ADC A,n ; opcode CE cycles 07
INSTRUCTION: RST 8 ; opcode CF cycles 11
INSTRUCTION: RET NC ; opcode D0 cycles 05
INSTRUCTION: POP DE ; opcode D1 cycles 10
INSTRUCTION: JP NC,nn ; opcode D2 cycles 10
INSTRUCTION: OUT (n),A ; opcode D3 cycles 10
INSTRUCTION: CALL NC,nn ; opcode D4 cycles 11
INSTRUCTION: PUSH DE ; opcode D5 cycles 11
INSTRUCTION: SUB n ; opcode D6 cycles 07
INSTRUCTION: RST 10H ; opcode D7 cycles 11
INSTRUCTION: RET C ; opcode D8 cycles 05
INSTRUCTION: JP C,nn ; opcode DA cycles 10
INSTRUCTION: IN A,(n) ; opcode DB cycles 10
INSTRUCTION: CALL C,nn ; opcode DC cycles 11
INSTRUCTION: SBC A,n ; opcode DE cycles 07
INSTRUCTION: RST 18H ; opcode DF cycles 11
INSTRUCTION: RET PO ; opcode E0 cycles 05
INSTRUCTION: POP HL ; opcode E1 cycles 10
INSTRUCTION: JP PO,nn ; opcode E2 cycles 10
INSTRUCTION: EX (SP),HL ; opcode E3 cycles 04
INSTRUCTION: CALL PO,nn ; opcode E4 cycles 11
INSTRUCTION: PUSH HL ; opcode E5 cycles 11
INSTRUCTION: AND n ; opcode E6 cycles 07
INSTRUCTION: RST 20H ; opcode E7 cycles 11
INSTRUCTION: RET PE ; opcode E8 cycles 05
INSTRUCTION: JP (HL) ; opcode E9 cycles 04
INSTRUCTION: JP PE,nn ; opcode EA cycles 10
INSTRUCTION: EX DE,HL ; opcode EB cycles 04
INSTRUCTION: CALL PE,nn ; opcode EC cycles 11
INSTRUCTION: XOR n ; opcode EE cycles 07
INSTRUCTION: RST 28H ; opcode EF cycles 11
INSTRUCTION: RET P ; opcode F0 cycles 05
INSTRUCTION: POP AF ; opcode F1 cycles 10
INSTRUCTION: JP P,nn ; opcode F2 cycles 10
INSTRUCTION: DI ; opcode F3 cycles 04
INSTRUCTION: CALL P,nn ; opcode F4 cycles 11
INSTRUCTION: PUSH AF ; opcode F5 cycles 11
INSTRUCTION: OR n ; opcode F6 cycles 07
INSTRUCTION: RST 30H ; opcode F7 cycles 11
INSTRUCTION: RET M ; opcode F8 cycles 05
INSTRUCTION: LD SP,HL ; opcode F9 cycles 06
INSTRUCTION: JP M,nn ; opcode FA cycles 10
INSTRUCTION: EI ; opcode FB cycles 04
INSTRUCTION: CALL M,nn ; opcode FC cycles 11
INSTRUCTION: CP n ; opcode FE cycles 07
INSTRUCTION: RST 38H ; opcode FF cycles 11

0
unmaintained/space-invaders/authors.txt → extra/cpu/8080/authors.txt
View File

1
extra/cpu/8080/emulator/authors.txt Normal file
View File

@ -0,0 +1 @@
Chris Double

36
extra/cpu/8080/emulator/emulator-docs.factor Normal file
View File

@ -0,0 +1,36 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax sequences strings ;
IN: cpu.8080.emulator
HELP: load-rom
{ $values { "filename" string } { "cpu" cpu } }
{ $description
"Read the ROM file into the cpu's memory starting at address 0000. "
"The filename is relative to the path stored in the " { $link rom-root }
" variable. An exception is thrown if this variable is not set."
}
{ $see-also load-rom* } ;
HELP: load-rom*
{ $values { "seq" sequence } { "cpu" cpu } }
{ $description
"Loads one or more ROM files into the cpu's memory. Each file is "
"loaded at a particular starting address. 'seq' is a sequence of "
"2 element arrays. The first element is the address and the second "
"element is the file to load at that address." $nl
"The filenames are relative to the path stored in the " { $link rom-root }
" variable. An exception is thrown if this variable is not set."
}
{ $examples
{ $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
}
{ $see-also load-rom } ;
HELP: rom-root
{ $description
"Holds the path where the ROM files are stored. Used for expanding "
"the relative filenames passed to " { $link load-rom } " and "
{ $link load-rom* } "."
}
{ $see-also load-rom load-rom* } ;

1407
extra/cpu/8080/emulator/emulator.factor Executable file
View File

File diff suppressed because it is too large Load Diff

1
extra/cpu/8080/emulator/summary.txt Normal file
View File

@ -0,0 +1 @@
Intel 8080 CPU Emulator

1
extra/cpu/8080/emulator/tags.txt Normal file
View File

@ -0,0 +1 @@
emulators

1
extra/cpu/8080/summary.txt Normal file
View File

@ -0,0 +1 @@
Intel 8080 CPU Emulator

1
extra/cpu/8080/tags.txt Normal file
View File

@ -0,0 +1 @@
emulators

70
extra/cpu/8080/test/test.factor Executable file
View File

@ -0,0 +1,70 @@
USING:
accessors
combinators
cpu.8080
cpu.8080.emulator
io
io.files
io.encodings.ascii
kernel
math
math.bits
sequences
tools.time
;
IN: cpu.8080.test
: step ( cpu -- )
#! Run a single 8080 instruction
[ read-instruction ] keep ! n cpu
over get-cycles over inc-cycles
[ swap instructions nth call( cpu -- ) ] keep
[ pc>> HEX: FFFF bitand ] keep
[ (>>pc) ] keep
process-interrupts ;
: test-step ( cpu -- cpu )
[ step ] keep dup cpu. ;
: invaders ( -- seq )
{
{ HEX: 0000 "invaders/invaders.h" }
{ HEX: 0800 "invaders/invaders.g" }
{ HEX: 1000 "invaders/invaders.f" }
{ HEX: 1800 "invaders/invaders.e" }
} ;
: test-cpu ( -- cpu )
<cpu> invaders over load-rom* dup cpu. ;
: test-n ( n -- )
test-cpu swap [ test-step ] times drop ;
: run-n ( cpu n -- cpu )
[ dup step ] times ;
: each-8bit ( n quot -- )
[ 8 <bits> ] dip each ; inline
: >ppm ( cpu filename -- cpu )
#! Dump the current screen image to a ppm image file with the given name.
ascii [
"P3" print
"256 224" print
"1" print
224 [
32 [
over 32 * over + HEX: 2400 + ! cpu h w addr
[ pick ] dip swap ram>> nth [
[
" 0 0 0" write
] [
" 1 1 1" write
] if
] each-8bit drop
] each drop nl
] each
] with-file-writer ;
: time-test ( -- )
test-cpu [ 1000000 run-n drop ] time ;

1
extra/space-invaders/authors.txt Normal file
View File

@ -0,0 +1 @@
Chris Double

0
unmaintained/space-invaders/resources/BaseHit.wav → extra/space-invaders/resources/BaseHit.wav
View File

0
unmaintained/space-invaders/resources/InvHit.Wav → extra/space-invaders/resources/InvHit.Wav
View File

0
unmaintained/space-invaders/resources/Shot.wav → extra/space-invaders/resources/Shot.wav
View File

0
unmaintained/space-invaders/resources/Ufo.wav → extra/space-invaders/resources/Ufo.wav
View File

0
unmaintained/space-invaders/resources/UfoHit.wav → extra/space-invaders/resources/UfoHit.wav
View File

0
unmaintained/space-invaders/resources/Walk1.wav → extra/space-invaders/resources/Walk1.wav
View File

0
unmaintained/space-invaders/resources/Walk2.wav → extra/space-invaders/resources/Walk2.wav
View File

0
unmaintained/space-invaders/resources/Walk3.wav → extra/space-invaders/resources/Walk3.wav
View File

0
unmaintained/space-invaders/resources/Walk4.wav → extra/space-invaders/resources/Walk4.wav
View File

0
unmaintained/space-invaders/space-invaders-docs.factor → extra/space-invaders/space-invaders-docs.factor
View File

264
unmaintained/space-invaders/space-invaders.factor → extra/space-invaders/space-invaders.factor
View File

@ -1,19 +1,41 @@
! 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: cpu.8080 cpu.8080.emulator openal math alien.c-types USING:
sequences kernel shuffle arrays io.files combinators ui.gestures accessors
ui.gadgets ui.render opengl.gl system match alien.c-types
ui byte-arrays combinators.lib qualified ; alien.data
arrays
byte-arrays
calendar
combinators
cpu.8080
cpu.8080.emulator
io.files
kernel
math
openal
opengl.gl
sequences
ui
ui.gadgets
ui.gestures
ui.render
;
QUALIFIED: threads QUALIFIED: threads
QUALIFIED: system
IN: space-invaders IN: space-invaders
TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ; <<
: game-width 224 ; inline "uchar" require-c-array
: game-height 256 ; inline >>
TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ;
CONSTANT: game-width 224
CONSTANT: game-height 256
: make-opengl-bitmap ( -- array ) : make-opengl-bitmap ( -- array )
game-height game-width 3 * * <byte-array> ; game-height game-width 3 * * uchar <c-array> ;
: bitmap-index ( point -- index ) : bitmap-index ( point -- index )
#! Point is a {x y}. #! Point is a {x y}.
@ -22,37 +44,37 @@ TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap s
: set-bitmap-pixel ( color point array -- ) : set-bitmap-pixel ( color point array -- )
#! 'color' is a {r g b}. Point is {x y}. #! 'color' is a {r g b}. Point is {x y}.
[ bitmap-index ] dip ! color index array [ bitmap-index ] dip ! color index array
[ [ first ] 2dip set-uchar-nth ] 3keep [ [ first ] 2dip set-nth ] 3keep
[ [ second ] 2dip [ 1 + ] dip set-uchar-nth ] 3keep [ [ second ] 2dip [ 1 + ] dip set-nth ] 3keep
[ third ] 2dip [ 2 + ] dip set-uchar-nth ; [ third ] 2dip [ 2 + ] dip set-nth ;
: 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
[ uint-nth ] 2keep [ nth ] 2keep
[ [ 1 + ] dip uchar-nth ] 2keep [ [ 1 + ] dip nth ] 2keep
[ 2 + ] dip uchar-nth 3array ; [ 2 + ] dip nth 3array ;
: SOUND-SHOT ( -- number ) 0 ; CONSTANT: SOUND-SHOT 0
: SOUND-UFO ( -- number ) 1 ; CONSTANT: SOUND-UFO 1
: SOUND-BASE-HIT ( -- number ) 2 ; CONSTANT: SOUND-BASE-HIT 2
: SOUND-INVADER-HIT ( -- number ) 3 ; CONSTANT: SOUND-INVADER-HIT 3
: SOUND-WALK1 ( -- number ) 4 ; CONSTANT: SOUND-WALK1 4
: SOUND-WALK2 ( -- number ) 5 ; CONSTANT: SOUND-WALK2 5
: SOUND-WALK3 ( -- number ) 6 ; CONSTANT: SOUND-WALK3 6
: SOUND-WALK4 ( -- number ) 7 ; CONSTANT: SOUND-WALK4 7
: SOUND-UFO-HIT ( -- number ) 8 ; CONSTANT: SOUND-UFO-HIT 8
: init-sound ( index cpu filename -- ) : init-sound ( index cpu filename -- )
swapd >r space-invaders-sounds nth AL_BUFFER r> 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 set-space-invaders-sounds ] keep [ 9 gen-sources swap (>>sounds) ] keep
[ SOUND-SHOT "resource:extra/space-invaders/resources/Shot.wav" init-sound ] 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 [ SOUND-UFO "resource:extra/space-invaders/resources/Ufo.wav" init-sound ] keep
[ space-invaders-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 ] keep
[ SOUND-BASE-HIT "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] 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-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-WALK1 "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep
@ -60,19 +82,19 @@ TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap s
[ SOUND-WALK3 "resource:extra/space-invaders/resources/Walk3.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-WALK4 "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep
[ SOUND-UFO-HIT "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep [ SOUND-UFO-HIT "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
f swap set-space-invaders-looping? ; f swap (>>looping?) ;
: <space-invaders> ( -- cpu ) : <space-invaders> ( -- cpu )
<cpu> space-invaders construct-delegate space-invaders new
make-opengl-bitmap over set-space-invaders-bitmap make-opengl-bitmap over (>>bitmap)
[ init-sounds ] keep [ init-sounds ] keep
[ reset ] keep ; [ reset ] keep ;
: play-invaders-sound ( cpu sound -- ) : play-invaders-sound ( cpu sound -- )
swap space-invaders-sounds nth source-play ; swap sounds>> nth source-play ;
: stop-invaders-sound ( cpu sound -- ) : stop-invaders-sound ( cpu sound -- )
swap space-invaders-sounds nth source-stop ; swap sounds>> nth source-stop ;
: read-port1 ( cpu -- byte ) : read-port1 ( cpu -- byte )
#! Port 1 maps the keys for space invaders #! Port 1 maps the keys for space invaders
@ -82,8 +104,8 @@ TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap s
#! 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
[ space-invaders-port1 dup HEX: FE bitand ] keep [ port1>> dup HEX: FE bitand ] keep
set-space-invaders-port1 ; (>>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
@ -93,14 +115,14 @@ TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap s
#! 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
[ space-invaders-port2i HEX: 8F bitand ] keep [ port2i>> HEX: 8F bitand ] keep
space-invaders-port1 HEX: 70 bitand bitor ; port1>> HEX: 70 bitand bitor ;
: read-port3 ( cpu -- byte ) : read-port3 ( cpu -- byte )
#! Used to compute a special formula #! Used to compute a special formula
[ space-invaders-port4hi 8 shift ] keep [ port4hi>> 8 shift ] keep
[ space-invaders-port4lo bitor ] keep [ port4lo>> bitor ] keep
space-invaders-port2o shift -8 shift HEX: FF bitand ; port2o>> shift -8 shift HEX: FF bitand ;
M: space-invaders read-port ( port cpu -- byte ) M: space-invaders read-port ( port cpu -- byte )
#! Read a byte from the hardware port. 'port' should #! Read a byte from the hardware port. 'port' should
@ -114,16 +136,16 @@ M: space-invaders read-port ( port cpu -- byte )
: write-port2 ( value cpu -- ) : write-port2 ( value cpu -- )
#! Setting this value affects the value read from port 3 #! Setting this value affects the value read from port 3
set-space-invaders-port2o ; (>>port2o) ;
: bit-newly-set? ( old-value new-value bit -- bool ) : bit-newly-set? ( old-value new-value bit -- bool )
tuck bit? >r bit? not r> and ; tuck bit? [ bit? not ] dip and ;
: port3-newly-set? ( new-value cpu bit -- bool ) : port3-newly-set? ( new-value cpu bit -- bool )
>r space-invaders-port3o swap r> bit-newly-set? ; [ port3o>> swap ] dip bit-newly-set? ;
: port5-newly-set? ( new-value cpu bit -- bool ) : port5-newly-set? ( new-value cpu bit -- bool )
>r space-invaders-port5o swap r> bit-newly-set? ; [ port5o>> swap ] dip bit-newly-set? ;
: write-port3 ( value cpu -- ) : write-port3 ( value cpu -- )
#! Connected to the sound hardware #! Connected to the sound hardware
@ -132,25 +154,25 @@ M: space-invaders read-port ( port cpu -- byte )
#! 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 space-invaders-looping? not and [ over 0 bit? over looping?>> not and [
dup SOUND-UFO play-invaders-sound dup SOUND-UFO play-invaders-sound
t over set-space-invaders-looping? t over (>>looping?)
] when ] when
over 0 bit? not over space-invaders-looping? and [ over 0 bit? not over looping?>> and [
dup SOUND-UFO stop-invaders-sound dup SOUND-UFO stop-invaders-sound
f over set-space-invaders-looping? f over (>>looping?)
] when ] when
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
2dup 3 port3-newly-set? [ dup SOUND-INVADER-HIT play-invaders-sound ] when 2dup 3 port3-newly-set? [ dup SOUND-INVADER-HIT play-invaders-sound ] when
set-space-invaders-port3o ; (>>port3o) ;
: write-port4 ( value cpu -- ) : write-port4 ( value cpu -- )
#! Affects the value returned by reading port 3 #! Affects the value returned by reading port 3
[ space-invaders-port4hi ] keep [ port4hi>> ] keep
[ set-space-invaders-port4lo ] keep [ (>>port4lo) ] keep
set-space-invaders-port4hi ; (>>port4hi) ;
: write-port5 ( value cpu -- ) : write-port5 ( value cpu -- )
#! Plays sounds #! Plays sounds
@ -165,7 +187,7 @@ M: space-invaders read-port ( port cpu -- byte )
2dup 2 port5-newly-set? [ dup SOUND-WALK3 play-invaders-sound ] when 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 3 port5-newly-set? [ dup SOUND-WALK4 play-invaders-sound ] when
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
set-space-invaders-port5o ; (>>port5o) ;
M: space-invaders write-port ( value port cpu -- ) M: space-invaders write-port ( value port cpu -- )
#! Write a byte to the hardware port, where 'port' is #! Write a byte to the hardware port, where 'port' is
@ -179,33 +201,34 @@ M: space-invaders write-port ( value port cpu -- )
} case ; } case ;
M: space-invaders reset ( cpu -- ) M: space-invaders reset ( cpu -- )
[ delegate reset ] keep dup call-next-method
[ 0 swap set-space-invaders-port1 ] keep 0 >>port1
[ 0 swap set-space-invaders-port2i ] keep 0 >>port2i
[ 0 swap set-space-invaders-port2o ] keep 0 >>port2o
[ 0 swap set-space-invaders-port3o ] keep 0 >>port3o
[ 0 swap set-space-invaders-port4lo ] keep 0 >>port4lo
[ 0 swap set-space-invaders-port4hi ] keep 0 >>port4hi
0 swap set-space-invaders-port5o ; 0 >>port5o
drop ;
: gui-step ( cpu -- ) : gui-step ( cpu -- )
[ read-instruction ] keep ! n cpu [ read-instruction ] keep ! n cpu
over get-cycles over inc-cycles over get-cycles over inc-cycles
[ swap instructions case ] keep [ swap instructions nth call( cpu -- ) ] keep
[ cpu-pc HEX: FFFF bitand ] keep [ pc>> HEX: FFFF bitand ] keep
set-cpu-pc ; (>>pc) ;
: gui-frame/2 ( cpu -- ) : gui-frame/2 ( cpu -- )
[ gui-step ] keep [ gui-step ] keep
[ cpu-cycles ] keep [ cycles>> ] keep
over 16667 < [ ! cycles cpu over 16667 < [ ! cycles cpu
nip gui-frame/2 nip gui-frame/2
] [ ] [
[ >r 16667 - r> set-cpu-cycles ] keep [ [ 16667 - ] dip (>>cycles) ] keep
dup cpu-last-interrupt HEX: 10 = [ dup last-interrupt>> HEX: 10 = [
HEX: 08 over set-cpu-last-interrupt HEX: 08 swap interrupt HEX: 08 over (>>last-interrupt) HEX: 08 swap interrupt
] [ ] [
HEX: 10 over set-cpu-last-interrupt HEX: 10 swap interrupt HEX: 10 over (>>last-interrupt) HEX: 10 swap interrupt
] if ] if
] if ; ] if ;
@ -213,77 +236,77 @@ 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 -- )
[ space-invaders-port1 1 bitor ] keep set-space-invaders-port1 ; [ port1>> 1 bitor ] keep (>>port1) ;
: coin-up ( cpu -- ) : coin-up ( cpu -- )
[ space-invaders-port1 255 1 - bitand ] keep set-space-invaders-port1 ; [ port1>> 255 1 - bitand ] keep (>>port1) ;
: player1-down ( cpu -- ) : player1-down ( cpu -- )
[ space-invaders-port1 4 bitor ] keep set-space-invaders-port1 ; [ port1>> 4 bitor ] keep (>>port1) ;
: player1-up ( cpu -- ) : player1-up ( cpu -- )
[ space-invaders-port1 255 4 - bitand ] keep set-space-invaders-port1 ; [ port1>> 255 4 - bitand ] keep (>>port1) ;
: player2-down ( cpu -- ) : player2-down ( cpu -- )
[ space-invaders-port1 2 bitor ] keep set-space-invaders-port1 ; [ port1>> 2 bitor ] keep (>>port1) ;
: player2-up ( cpu -- ) : player2-up ( cpu -- )
[ space-invaders-port1 255 2 - bitand ] keep set-space-invaders-port1 ; [ port1>> 255 2 - bitand ] keep (>>port1) ;
: fire-down ( cpu -- ) : fire-down ( cpu -- )
[ space-invaders-port1 HEX: 10 bitor ] keep set-space-invaders-port1 ; [ port1>> HEX: 10 bitor ] keep (>>port1) ;
: fire-up ( cpu -- ) : fire-up ( cpu -- )
[ space-invaders-port1 255 HEX: 10 - bitand ] keep set-space-invaders-port1 ; [ port1>> 255 HEX: 10 - bitand ] keep (>>port1) ;
: left-down ( cpu -- ) : left-down ( cpu -- )
[ space-invaders-port1 HEX: 20 bitor ] keep set-space-invaders-port1 ; [ port1>> HEX: 20 bitor ] keep (>>port1) ;
: left-up ( cpu -- ) : left-up ( cpu -- )
[ space-invaders-port1 255 HEX: 20 - bitand ] keep set-space-invaders-port1 ; [ port1>> 255 HEX: 20 - bitand ] keep (>>port1) ;
: right-down ( cpu -- ) : right-down ( cpu -- )
[ space-invaders-port1 HEX: 40 bitor ] keep set-space-invaders-port1 ; [ port1>> HEX: 40 bitor ] keep (>>port1) ;
: right-up ( cpu -- ) : right-up ( cpu -- )
[ space-invaders-port1 255 HEX: 40 - bitand ] keep set-space-invaders-port1 ; [ port1>> 255 HEX: 40 - bitand ] keep (>>port1) ;
TUPLE: invaders-gadget cpu quit? ; TUPLE: invaders-gadget < gadget cpu quit? ;
invaders-gadget H{ invaders-gadget H{
{ T{ key-down f f "ESC" } [ t swap set-invaders-gadget-quit? ] } { T{ key-down f f "ESC" } [ t swap (>>quit?) ] }
{ T{ key-down f f "BACKSPACE" } [ invaders-gadget-cpu coin-down ] } { T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
{ T{ key-up f f "BACKSPACE" } [ invaders-gadget-cpu coin-up ] } { T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] }
{ T{ key-down f f "1" } [ invaders-gadget-cpu player1-down ] } { T{ key-down f f "1" } [ cpu>> player1-down ] }
{ T{ key-up f f "1" } [ invaders-gadget-cpu player1-up ] } { T{ key-up f f "1" } [ cpu>> player1-up ] }
{ T{ key-down f f "2" } [ invaders-gadget-cpu player2-down ] } { T{ key-down f f "2" } [ cpu>> player2-down ] }
{ T{ key-up f f "2" } [ invaders-gadget-cpu player2-up ] } { T{ key-up f f "2" } [ cpu>> player2-up ] }
{ T{ key-down f f "UP" } [ invaders-gadget-cpu fire-down ] } { T{ key-down f f "UP" } [ cpu>> fire-down ] }
{ T{ key-up f f "UP" } [ invaders-gadget-cpu fire-up ] } { T{ key-up f f "UP" } [ cpu>> fire-up ] }
{ T{ key-down f f "LEFT" } [ invaders-gadget-cpu left-down ] } { T{ key-down f f "LEFT" } [ cpu>> left-down ] }
{ T{ key-up f f "LEFT" } [ invaders-gadget-cpu left-up ] } { T{ key-up f f "LEFT" } [ cpu>> left-up ] }
{ T{ key-down f f "RIGHT" } [ invaders-gadget-cpu right-down ] } { T{ key-down f f "RIGHT" } [ cpu>> right-down ] }
{ T{ key-up f f "RIGHT" } [ invaders-gadget-cpu right-up ] } { T{ key-up f f "RIGHT" } [ cpu>> right-up ] }
} set-gestures } set-gestures
: <invaders-gadget> ( cpu -- gadget ) : <invaders-gadget> ( cpu -- gadget )
invaders-gadget construct-gadget invaders-gadget new
[ set-invaders-gadget-cpu ] keep swap >>cpu
f over set-invaders-gadget-quit? ; f >>quit? ;
M: invaders-gadget pref-dim* drop { 224 256 0 } ; M: invaders-gadget pref-dim* drop { 224 256 } ;
M: invaders-gadget draw-gadget* ( gadget -- ) M: invaders-gadget draw-gadget* ( gadget -- )
0 0 glRasterPos2i 0 0 glRasterPos2i
1.0 -1.0 glPixelZoom 1.0 -1.0 glPixelZoom
>r 224 256 GL_RGB GL_UNSIGNED_BYTE r> [ 224 256 GL_RGB GL_UNSIGNED_BYTE ] dip
invaders-gadget-cpu space-invaders-bitmap glDrawPixels ; cpu>> bitmap>> glDrawPixels ;
: black { 0 0 0 } ; CONSTANT: black { 0 0 0 }
: white { 255 255 255 } ; CONSTANT: white { 255 255 255 }
: green { 0 255 0 } ; CONSTANT: green { 0 255 0 }
: 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}.
@ -297,7 +320,7 @@ M: invaders-gadget draw-gadget* ( gadget -- )
: within ( n a b -- bool ) : within ( n a b -- bool )
#! n >= a and n <= b #! n >= a and n <= b
rot tuck swap <= >r swap >= r> and ; rot tuck swap <= [ swap >= ] dip and ;
: get-point-color ( point -- color ) : get-point-color ( point -- color )
#! Return the color to use for the given x/y position. #! Return the color to use for the given x/y position.
@ -330,47 +353,50 @@ M: invaders-gadget draw-gadget* ( gadget -- )
M: space-invaders update-video ( value addr cpu -- ) M: space-invaders update-video ( value addr cpu -- )
over HEX: 2400 >= [ over HEX: 2400 >= [
space-invaders-bitmap -rot do-bitmap-update bitmap>> -rot do-bitmap-update
] [ ] [
3drop 3drop
] if ; ] if ;
: sync-frame ( millis -- millis ) : sync-frame ( millis -- millis )
#! Sleep until the time for the next frame arrives. #! Sleep until the time for the next frame arrives.
1000 60 / >fixnum + millis - dup 0 > 1000 60 / >fixnum + system:millis - dup 0 >
[ threads:sleep ] [ drop threads:yield ] if millis ; [ milliseconds threads:sleep ] [ drop threads:yield ] if system:millis ;
: invaders-process ( millis gadget -- ) : invaders-process ( millis gadget -- )
#! Run a space invaders gadget inside a #! Run a space invaders gadget inside a
#! concurrent process. Messages can be sent to #! concurrent process. Messages can be sent to
#! signal key presses, etc. #! signal key presses, etc.
dup invaders-gadget-quit? [ dup quit?>> [
2drop 2drop
] [ ] [
[ sync-frame ] dip [ sync-frame ] dip
[ invaders-gadget-cpu gui-frame ] keep [ cpu>> gui-frame ] keep
[ relayout-1 ] keep [ relayout-1 ] keep
invaders-process invaders-process
] if ; ] if ;
M: invaders-gadget graft* ( gadget -- ) M: invaders-gadget graft* ( gadget -- )
dup invaders-gadget-cpu init-sounds dup cpu>> init-sounds
f over set-invaders-gadget-quit? f over (>>quit?)
[ millis swap invaders-process ] curry [ system:millis swap invaders-process ] curry
"Space invaders" threads:spawn drop ; "Space invaders" threads:spawn drop ;
M: invaders-gadget ungraft* ( gadget -- ) M: invaders-gadget ungraft* ( gadget -- )
t swap set-invaders-gadget-quit? ; t swap (>>quit?) ;
: (run) ( title cpu rom-info -- ) : (run) ( title cpu rom-info -- )
over load-rom* <invaders-gadget> swap open-window ; over load-rom* <invaders-gadget> swap open-window ;
: run ( -- ) : run ( -- )
"Space Invaders" <space-invaders> { [
{ HEX: 0000 "invaders/invaders.h" } "Space Invaders" <space-invaders> {
{ HEX: 0800 "invaders/invaders.g" } { HEX: 0000 "invaders/invaders.h" }
{ HEX: 1000 "invaders/invaders.f" } { HEX: 0800 "invaders/invaders.g" }
{ HEX: 1800 "invaders/invaders.e" } { HEX: 1000 "invaders/invaders.f" }
} [ (run) ] with-ui ; { HEX: 1800 "invaders/invaders.e" }
}
(run)
] with-ui ;
MAIN: run MAIN: run

0
unmaintained/space-invaders/summary.txt → extra/space-invaders/summary.txt
View File

0
unmaintained/space-invaders/tags.txt → extra/space-invaders/tags.txt
View File