Part 1 of getting space invaders bit rot fixed
chris.double
parent
8a6cd181c4
commit
be607eae1f
|
|
@ -20,23 +20,27 @@
|
|||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
USING: lazy-lists kernel sequences strings math io arrays ;
|
||||
USING: lazy-lists kernel sequences strings math io arrays errors ;
|
||||
IN: parser-combinators
|
||||
|
||||
TUPLE: parse-result parsed unparsed ;
|
||||
|
||||
: h:t ( object -- head tail )
|
||||
#! Return the head and tail of the object.
|
||||
dup first swap 1 tail ;
|
||||
dup empty? [ dup first swap 1 tail ] unless ;
|
||||
|
||||
: token-parser ( inp sequence -- llist )
|
||||
#! A parser that parses a specific sequence of
|
||||
#! characters.
|
||||
2dup length head over = [
|
||||
swap over length tail <parse-result> lunit
|
||||
[
|
||||
2dup length head over = [
|
||||
swap over length tail <parse-result> lunit
|
||||
] [
|
||||
2drop nil
|
||||
] if
|
||||
] [
|
||||
2drop nil
|
||||
] if ;
|
||||
3drop nil
|
||||
] recover ;
|
||||
|
||||
: token ( string -- parser )
|
||||
#! Return a token parser that parses the given string.
|
||||
|
|
|
|||
|
|
@ -20,8 +20,8 @@
|
|||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
USING: kernel lists math sequences errors vectors prettyprint io namespaces arrays
|
||||
words parser hashtables lazy parser-combinators kernel-internals strings ;
|
||||
USING: kernel math sequences errors vectors prettyprint io namespaces arrays
|
||||
words parser hashtables lazy-lists parser-combinators kernel-internals strings ;
|
||||
IN: cpu-8080
|
||||
|
||||
TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ;
|
||||
|
|
@ -532,7 +532,7 @@ C: cpu ( cpu -- cpu )
|
|||
: peek-instruction ( cpu -- word )
|
||||
#! Return the next instruction from the cpu's program
|
||||
#! counter, but don't increment the counter.
|
||||
[ cpu-pc ] keep read-byte instructions nth car ;
|
||||
[ cpu-pc ] keep read-byte instructions nth first ;
|
||||
|
||||
: cpu. ( cpu -- )
|
||||
[ " PC: " write cpu-pc 16 >base 4 CHAR: \s pad-left write ] keep
|
||||
|
|
@ -618,10 +618,10 @@ SYMBOL: $4
|
|||
#! Copy the tree, replacing each occurence of
|
||||
#! $1, $2, etc with the relevant item from the
|
||||
#! given index.
|
||||
dup cons? [ ( vector tree )
|
||||
uncons ( vector car cdr )
|
||||
dup quotation? over [ ] = not and [ ( vector tree )
|
||||
dup first swap 1 tail ( vector car cdr )
|
||||
>r dupd replace-patterns ( vector v R: cdr )
|
||||
swap r> replace-patterns cons
|
||||
swap r> replace-patterns >r unit r> append
|
||||
] [ ( vector value )
|
||||
dup $1 = [ drop 0 over nth ] when
|
||||
dup $2 = [ drop 1 over nth ] when
|
||||
|
|
@ -863,7 +863,11 @@ SYMBOL: $4
|
|||
#! The instruction is expected to take additional arguments by
|
||||
#! being combined with other parsers. Then 'type' is used for a lookup
|
||||
#! in a pattern hashtable to return the instruction quotation pattern.
|
||||
token swap [ nip [ , \ generate-instruction , ] [ ] make ] cons <@ ;
|
||||
token swap [ nip [ , \ generate-instruction , ] [ ] make ] curry <@ ;
|
||||
|
||||
: >2array< ( array -- v1 v2 )
|
||||
#! Explode a two element array
|
||||
dup first swap second ;
|
||||
|
||||
: NOP-instruction ( -- parser )
|
||||
"NOP" simple-instruction ;
|
||||
|
|
@ -871,74 +875,74 @@ SYMBOL: $4
|
|||
: RET-NN-instruction ( -- parser )
|
||||
"RET-NN" "RET" complex-instruction
|
||||
"nn" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-0-instruction ( -- parser )
|
||||
"RST-0" "RST" complex-instruction
|
||||
"0" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-8-instruction ( -- parser )
|
||||
"RST-8" "RST" complex-instruction
|
||||
"8" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-10H-instruction ( -- parser )
|
||||
"RST-10H" "RST" complex-instruction
|
||||
"10H" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-18H-instruction ( -- parser )
|
||||
"RST-18H" "RST" complex-instruction
|
||||
"18H" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-20H-instruction ( -- parser )
|
||||
"RST-20H" "RST" complex-instruction
|
||||
"20H" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-28H-instruction ( -- parser )
|
||||
"RST-28H" "RST" complex-instruction
|
||||
"28H" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-30H-instruction ( -- parser )
|
||||
"RST-30H" "RST" complex-instruction
|
||||
"30H" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: RST-38H-instruction ( -- parser )
|
||||
"RST-38H" "RST" complex-instruction
|
||||
"38H" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: JP-NN-instruction ( -- parser )
|
||||
"JP-NN" "JP" complex-instruction
|
||||
"nn" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: JP-F|FF,NN-instruction ( -- parser )
|
||||
"JP-F|FF,NN" "JP" complex-instruction
|
||||
all-flags sp <&>
|
||||
",nn" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: JP-(RR)-instruction ( -- parser )
|
||||
"JP-(RR)" "JP" complex-instruction
|
||||
16-bit-registers indirect sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: CALL-NN-instruction ( -- parser )
|
||||
"CALL-NN" "CALL" complex-instruction
|
||||
"nn" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: CALL-F|FF,NN-instruction ( -- parser )
|
||||
"CALL-F|FF,NN" "CALL" complex-instruction
|
||||
all-flags sp <&>
|
||||
",nn" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: RLCA-instruction ( -- parser )
|
||||
"RLCA" simple-instruction ;
|
||||
|
|
@ -975,194 +979,194 @@ SYMBOL: $4
|
|||
|
||||
: DEC-R-instruction ( -- parser )
|
||||
"DEC-R" "DEC" complex-instruction 8-bit-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: DEC-RR-instruction ( -- parser )
|
||||
"DEC-RR" "DEC" complex-instruction 16-bit-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: DEC-(RR)-instruction ( -- parser )
|
||||
"DEC-(RR)" "DEC" complex-instruction
|
||||
16-bit-registers indirect sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: POP-RR-instruction ( -- parser )
|
||||
"POP-RR" "POP" complex-instruction all-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: PUSH-RR-instruction ( -- parser )
|
||||
"PUSH-RR" "PUSH" complex-instruction all-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: INC-R-instruction ( -- parser )
|
||||
"INC-R" "INC" complex-instruction 8-bit-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: INC-RR-instruction ( -- parser )
|
||||
"INC-RR" "INC" complex-instruction 16-bit-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: INC-(RR)-instruction ( -- parser )
|
||||
"INC-(RR)" "INC" complex-instruction
|
||||
all-registers indirect sp <&> just [ uncons swons ] <@ ;
|
||||
all-registers indirect sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: RET-F|FF-instruction ( -- parser )
|
||||
"RET-F|FF" "RET" complex-instruction all-flags sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: AND-N-instruction ( -- parser )
|
||||
"AND-N" "AND" complex-instruction
|
||||
"n" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: AND-R-instruction ( -- parser )
|
||||
"AND-R" "AND" complex-instruction
|
||||
8-bit-registers sp <&> just [ uncons swons ] <@ ;
|
||||
8-bit-registers sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: AND-(RR)-instruction ( -- parser )
|
||||
"AND-(RR)" "AND" complex-instruction
|
||||
16-bit-registers indirect sp <&> just [ uncons swons ] <@ ;
|
||||
16-bit-registers indirect sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: XOR-N-instruction ( -- parser )
|
||||
"XOR-N" "XOR" complex-instruction
|
||||
"n" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: XOR-R-instruction ( -- parser )
|
||||
"XOR-R" "XOR" complex-instruction
|
||||
8-bit-registers sp <&> just [ uncons swons ] <@ ;
|
||||
8-bit-registers sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: XOR-(RR)-instruction ( -- parser )
|
||||
"XOR-(RR)" "XOR" complex-instruction
|
||||
16-bit-registers indirect sp <&> just [ uncons swons ] <@ ;
|
||||
16-bit-registers indirect sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: OR-N-instruction ( -- parser )
|
||||
"OR-N" "OR" complex-instruction
|
||||
"n" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: OR-R-instruction ( -- parser )
|
||||
"OR-R" "OR" complex-instruction
|
||||
8-bit-registers sp <&> just [ uncons swons ] <@ ;
|
||||
8-bit-registers sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: OR-(RR)-instruction ( -- parser )
|
||||
"OR-(RR)" "OR" complex-instruction
|
||||
16-bit-registers indirect sp <&> just [ uncons swons ] <@ ;
|
||||
16-bit-registers indirect sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: CP-N-instruction ( -- parser )
|
||||
"CP-N" "CP" complex-instruction
|
||||
"n" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: CP-R-instruction ( -- parser )
|
||||
"CP-R" "CP" complex-instruction
|
||||
8-bit-registers sp <&> just [ uncons swons ] <@ ;
|
||||
8-bit-registers sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: CP-(RR)-instruction ( -- parser )
|
||||
"CP-(RR)" "CP" complex-instruction
|
||||
16-bit-registers indirect sp <&> just [ uncons swons ] <@ ;
|
||||
16-bit-registers indirect sp <&> just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: ADC-R,N-instruction ( -- parser )
|
||||
"ADC-R,N" "ADC" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
",n" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: ADC-R,R-instruction ( -- parser )
|
||||
"ADC-R,R" "ADC" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: ADC-R,(RR)-instruction ( -- parser )
|
||||
"ADC-R,(RR)" "ADC" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers indirect <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: SBC-R,N-instruction ( -- parser )
|
||||
"SBC-R,N" "SBC" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
",n" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: SBC-R,R-instruction ( -- parser )
|
||||
"SBC-R,R" "SBC" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: SBC-R,(RR)-instruction ( -- parser )
|
||||
"SBC-R,(RR)" "SBC" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers indirect <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: SUB-R-instruction ( -- parser )
|
||||
"SUB-R" "SUB" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: SUB-(RR)-instruction ( -- parser )
|
||||
"SUB-(RR)" "SUB" complex-instruction
|
||||
16-bit-registers indirect sp <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: SUB-N-instruction ( -- parser )
|
||||
"SUB-N" "SUB" complex-instruction
|
||||
"n" token sp <&
|
||||
just [ { } clone swons ] <@ ;
|
||||
just [ { } clone swap curry ] <@ ;
|
||||
|
||||
: ADD-R,N-instruction ( -- parser )
|
||||
"ADD-R,N" "ADD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
",n" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: ADD-R,R-instruction ( -- parser )
|
||||
"ADD-R,R" "ADD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: ADD-RR,RR-instruction ( -- parser )
|
||||
"ADD-RR,RR" "ADD" complex-instruction
|
||||
16-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: ADD-R,(RR)-instruction ( -- parser )
|
||||
"ADD-R,(RR)" "ADD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers indirect <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: LD-RR,NN-instruction
|
||||
#! LD BC,nn
|
||||
"LD-RR,NN" "LD" complex-instruction
|
||||
16-bit-registers sp <&>
|
||||
",nn" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: LD-R,N-instruction
|
||||
#! LD B,n
|
||||
"LD-R,N" "LD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
",n" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: LD-(RR),N-instruction
|
||||
"LD-(RR),N" "LD" complex-instruction
|
||||
16-bit-registers indirect sp <&>
|
||||
",n" token <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: LD-(RR),R-instruction
|
||||
#! LD (BC),A
|
||||
|
|
@ -1170,84 +1174,84 @@ SYMBOL: $4
|
|||
16-bit-registers indirect sp <&>
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: LD-R,R-instruction
|
||||
"LD-R,R" "LD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: LD-RR,RR-instruction
|
||||
"LD-RR,RR" "LD" complex-instruction
|
||||
16-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: LD-R,(RR)-instruction
|
||||
"LD-R,(RR)" "LD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers indirect <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: LD-(NN),RR-instruction
|
||||
"LD-(NN),RR" "LD" complex-instruction
|
||||
"nn" token indirect sp <&
|
||||
"," token <&
|
||||
16-bit-registers <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: LD-(NN),R-instruction
|
||||
"LD-(NN),R" "LD" complex-instruction
|
||||
"nn" token indirect sp <&
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: LD-RR,(NN)-instruction
|
||||
"LD-RR,(NN)" "LD" complex-instruction
|
||||
16-bit-registers sp <&>
|
||||
"," token <&
|
||||
"nn" token indirect <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: LD-R,(NN)-instruction
|
||||
"LD-R,(NN)" "LD" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
"nn" token indirect <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: OUT-(N),R-instruction
|
||||
"OUT-(N),R" "OUT" complex-instruction
|
||||
"n" token indirect sp <&
|
||||
"," token <&
|
||||
8-bit-registers <&>
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: IN-R,(N)-instruction
|
||||
"IN-R,(N)" "IN" complex-instruction
|
||||
8-bit-registers sp <&>
|
||||
"," token <&
|
||||
"n" token indirect <&
|
||||
just [ uncons swons ] <@ ;
|
||||
just [ >2array< swap curry ] <@ ;
|
||||
|
||||
: EX-(RR),RR-instruction
|
||||
"EX-(RR),RR" "EX" complex-instruction
|
||||
16-bit-registers indirect sp <&>
|
||||
"," token <&
|
||||
16-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: EX-RR,RR-instruction
|
||||
"EX-RR,RR" "EX" complex-instruction
|
||||
16-bit-registers sp <&>
|
||||
"," token <&
|
||||
16-bit-registers <&>
|
||||
just [ unswons unswons >r swap append r> cons ] <@ ;
|
||||
just [ >2array< swap >2array< swap >r append r> curry ] <@ ;
|
||||
|
||||
: 8080-generator-parser
|
||||
NOP-instruction
|
||||
|
|
@ -1355,7 +1359,6 @@ SYMBOL: last-opcode
|
|||
last-instruction global hash unit scan 16 base> ( [word] opcode -- )
|
||||
dup last-opcode global set-hash instructions set-nth ; parsing
|
||||
|
||||
|
||||
INSTRUCTION: NOP ; opcode 00 cycles 04
|
||||
INSTRUCTION: LD BC,nn ; opcode 01 cycles 10
|
||||
INSTRUCTION: LD (BC),A ; opcode 02 cycles 07
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
USING: alien cpu-8080 errors generic io kernel kernel-internals
|
||||
lists math namespaces sequences styles threads gadgets gadgets-layouts opengl arrays
|
||||
math namespaces sequences styles threads gadgets gadgets opengl arrays
|
||||
concurrency ;
|
||||
IN: space-invaders
|
||||
|
||||
|
|
@ -161,21 +161,22 @@ TUPLE: right-up-msg ;
|
|||
<right-down-msg> over send [ 10 sleep <right-up-msg> swap send ] spawn drop ;
|
||||
|
||||
: set-key-actions ( gadget -- )
|
||||
H{
|
||||
{ [ "ESCAPE" ] [ invaders-gadget-process "stop" swap send ] }
|
||||
{ [ "BACKSPACE" ] [ invaders-gadget-process coin-key-pressed ] }
|
||||
{ [ "1" ] [ invaders-gadget-process player1-key-pressed ] }
|
||||
{ [ "2" ] [ invaders-gadget-process player2-key-pressed ] }
|
||||
{ [ "UP" ] [ invaders-gadget-process fire-key-pressed ] }
|
||||
{ [ "LEFT" ] [ invaders-gadget-process left-key-pressed ] }
|
||||
{ [ "RIGHT" ] [ invaders-gadget-process right-key-pressed ] }
|
||||
} add-actions ;
|
||||
! H{
|
||||
! { [ "ESCAPE" ] [ invaders-gadget-process "stop" swap send ] }
|
||||
! { [ "BACKSPACE" ] [ invaders-gadget-process coin-key-pressed ] }
|
||||
! { [ "1" ] [ invaders-gadget-process player1-key-pressed ] }
|
||||
! { [ "2" ] [ invaders-gadget-process player2-key-pressed ] }
|
||||
! { [ "UP" ] [ invaders-gadget-process fire-key-pressed ] }
|
||||
! { [ "LEFT" ] [ invaders-gadget-process left-key-pressed ] }
|
||||
! { [ "RIGHT" ] [ invaders-gadget-process right-key-pressed ] }
|
||||
! } set-gestures
|
||||
drop ;
|
||||
|
||||
C: invaders-gadget ( gadget -- )
|
||||
dup delegate>gadget
|
||||
dup set-key-actions ;
|
||||
|
||||
M: invaders-gadget pref-dim* drop { 224 256 0 0 } ;
|
||||
M: invaders-gadget pref-dim* drop { 224 256 0 } ;
|
||||
|
||||
M: invaders-gadget draw-gadget* ( gadget -- )
|
||||
0 0 glRasterPos2i
|
||||
|
|
@ -322,6 +323,6 @@ M: right-up-msg handle-invaders-message ( gadget message -- quit? )
|
|||
: run ( -- process )
|
||||
<space-invaders> "invaders.rom" over load-rom
|
||||
<invaders-gadget> [ set-invaders-gadget-cpu ] keep
|
||||
dup "Space Invaders" open-window
|
||||
dup [ millis swap invaders-process ] cons spawn
|
||||
dup "Space Invaders" open-titled-window
|
||||
dup [ millis swap invaders-process ] curry spawn
|
||||
swap dupd set-invaders-gadget-process ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue