95 lines
2.7 KiB
Tal
95 lines
2.7 KiB
Tal
( a blank file )
|
|
|
|
%+ { ADD } %- { SUB } %/ { DIV }
|
|
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
|
|
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
|
|
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
|
|
|
|
%DEBUG { ;print-hex JSR2 #0a .Console/write DEO }
|
|
%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }
|
|
|
|
%RTN { JMP2r }
|
|
|
|
( devices )
|
|
|
|
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|
|
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|
|
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|
|
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|40 @Audio1 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|50 @Audio2 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|60 @Audio3 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|
|
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
|
|
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|
|
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|
|
|
|
( variables )
|
|
|
|
|0000
|
|
|
|
@lista $3
|
|
@listb $3
|
|
@listc $3
|
|
|
|
( program )
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0fe5 .System/r DEO2
|
|
#0fc5 .System/g DEO2
|
|
#0f25 .System/b DEO2
|
|
|
|
#01 .lista STZ
|
|
#02 .lista INC STZ
|
|
#03 .lista #02 + STZ
|
|
|
|
#10 .listb STZ
|
|
#20 .listb INC STZ
|
|
#30 .listb #02 + STZ
|
|
|
|
.lista .listb .listc ;add-lists-loop JSR2
|
|
|
|
.listc LDZ DEBUG
|
|
.listc INC LDZ DEBUG
|
|
.listc #02 + LDZ DEBUG
|
|
|
|
BRK
|
|
|
|
( Write a Forth word to add together two integer
|
|
vectors (a.k.a. arrays) of three elements each. )
|
|
|
|
@add-lists-linear ( a b c -- )
|
|
|
|
STH
|
|
( a[0] b[0] + ) LDZk STH SWP LDZk STHr + STHkr STZ
|
|
( a[1] b[1] + ) INC LDZk STH SWP INC LDZk STHr + STHkr INC STZ
|
|
( a[2] b[2] + ) INC LDZ SWP INC LDZ + STHr #02 + STZ
|
|
|
|
RTN
|
|
|
|
@add-lists-loop ( a b c -- )
|
|
|
|
STH
|
|
#00 #03
|
|
&loop
|
|
( get incr ) OVR STH
|
|
( get a[x] ) OVR2 STHkr ADD LDZ
|
|
( get b[x] ) SWP STHkr ADD LDZ
|
|
( set c[x] ) ADD STHr STHkr ADD STZ
|
|
( incr ) SWP INC SWP
|
|
LTHk ,&loop JCN
|
|
POP2 POP2 POPr
|
|
|
|
JMP2r
|
|
|
|
@print-hex ( value -- )
|
|
|
|
STHk #04 SFT ,&parse JSR .Console/write DEO
|
|
STHr #0f AND ,&parse JSR .Console/write DEO
|
|
RTN
|
|
&parse ( value -- char )
|
|
DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN
|
|
|
|
RTN |