tracker with audio device 0

This commit is contained in:
sejo 2021-07-10 23:10:50 -05:00
parent 6c33b689df
commit 95b7cc5f79
2 changed files with 500 additions and 0 deletions

BIN
roms/tracker.rom Normal file

Binary file not shown.

500
sketches/tracker.tal Normal file
View File

@ -0,0 +1,500 @@
( a blank file )
%RTN { JMP2r }
%inc-ptr-reg-nib { .ptr-register-nibbles LDZ #01 ADD #7f AND .ptr-register-nibbles STZ }
%inc-ptr-reg-byt { .ptr-register-nibbles LDZ #02 ADD #7f AND .ptr-register-nibbles STZ }
%dec-ptr-reg-nib { .ptr-register-nibbles LDZ #01 SUB #7f AND .ptr-register-nibbles STZ }
%dec-ptr-reg-byt { .ptr-register-nibbles LDZ #02 SUB #7f AND .ptr-register-nibbles STZ }
%debug-digit { DUP #30 ADD .Console/write DEO }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $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 ]
|70 @Midi [ &vector $2 &channel $1 &note $1 &velocity $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 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( constants )
%die-color-normal { #53 } ( #53 )
%die-color-invert { #5b }
%column-size { #08 }
%col-sep { #0024 }
%pos-x-dev0 { #000d }
%pos-x-dev1 { #005e }
%pos-x-dev2 { #00ae }
%pos-y-dev { #0010 }
( top left corner of registers column )
%pos-x-registers { #0010 }
%pos-y-registers { #0010 }
( variables )
|0000
( )
@ptr-register-nibbles $1
@framecount0 $1
@framecount1 $1
@framecount2 $1
@beat0 $1
@beat1 $1
@beat2 $1
( temp variables )
@die-color $1
@high-nibble $1
@low-nibble $1
( registers )
@registers
@dev0
&period $1 &pattern $1 &beatcount $1 &adsr $2 &volume $1 &sample $2
&melody $8
@dev1
&period $1 &pattern $1 &beatcount $1 &adsr $2 &volume $1 &sample $2
&melody $8
@dev2
&period $1 &pattern $1 &beatcount $1 &adsr $2 &volume $1 &sample $2
&melody $8
( program )
@main
|0100 ( -> )
( theme )
#1dd8 .System/r DEO2
#1c92 .System/g DEO2
#1c47 .System/b DEO2
#1f .dev0/period STZ
#ff .dev0/pattern STZ
#70 .dev0/beatcount STZ
#1ff1 .dev0/adsr STZ2
#aa .dev0/volume STZ
#0100 .dev0/sample STZ2
#2d29 .dev0/melody STZ2
#2629 .dev0/melody #02 ADD STZ2
#2d29 .dev0/melody #04 ADD STZ2
#262d .dev0/melody #06 ADD STZ2
#00 .ptr-register-nibbles STZ
;on-frame .Screen/vector DEO2
;on-controller .Controller/vector DEO2
BRK
@on-frame ( -> )
;update-dev0 JSR2
&draw-registers
pos-x-dev0 pos-y-dev #00
;draw-bytes JSR2
pos-x-dev0 col-sep ADD2 pos-y-dev #08
;draw-bytes JSR2
pos-x-dev1 #0010 #10
;draw-bytes JSR2
pos-x-dev1 col-sep ADD2 #0010 #18
;draw-bytes JSR2
pos-x-dev2 #0010 #20
;draw-bytes JSR2
pos-x-dev2 col-sep ADD2 #0010 #28
;draw-bytes JSR2
BRK
@update-dev0 ( -- )
#00 ,&played STR
.framecount0 LDZ #01 ADD DUP .framecount0 STZ ( inc frame counter )
.dev0/period LDZ LTH ( is it less than period? )
,&done JCN
#00 .framecount0 STZ ( reset frame counter )
.beat0 LDZ
.dev0/beatcount LDZ #04 SFT GTH ( is it greater than beat count ? )
,&reset-beat JCN
,&check-pattern JMP
&played $1
&done
RTN
&reset-beat
( reset beat when equal to beat count )
#00 .beat0 STZ
&check-pattern
.dev0/pattern LDZ ( load pattern )
.beat0 LDZ ( check bit number beat in pattern: ) ( DUP #30 ADD .Console/write DEO )
SFT ( shift pattern beat bits to the right )
#01 AND ( mask bit DUP #30 ADD .Console/write DEO )
,&play-sound JCN ( if pattern bit is 1, play sound )
,&inc-beat JMP ( finish if pattern bit is 0 )
&play-sound
.dev0/sample LDZ2 #0fff AND2 ( get rid of highest nibble )
.Audio0/length DEO2 ( set sample length )
#00 .dev0/sample LDZ #30 AND #03 SFT ( get sample number with offset ) ( #02 MUL ) ( short offset )
;samples ADD2 LDA2 ( get sample address )
.Audio0/addr DEO2
.dev0/adsr LDZ2 .Audio0/adsr DEO2
.dev0/volume LDZ .Audio0/volume DEO
.beat0 LDZ .dev0/melody ADD ( get pitch from melody )
LDZ .Audio0/pitch DEO
#01 ,&played STR
&inc-beat
.dev0/beatcount LDZ #f0 AND .beat0 LDZ ORA .dev0/beatcount STZ
( draw beat )
pos-x-dev0 .beat0 LDZ ,&played LDR ;draw-beat JSR2
.beat0 LDZ #01 ADD #07 AND .beat0 STZ ( increment and save beat )
RTN
@draw-beat ( x2 beat played -- )
,&played JCN
&notplayed
#23 ,&color STR
,&start JMP
&played
#22 ,&color STR
,&start JMP
&color $1
&start
;square .Screen/addr DEO2
STH ( store beat )
col-sep ADD2 #000c ADD2
.Screen/x DEO2
( clear beats )
#00
&loop
STHk
#00 SWP #10 MUL pos-y-dev ADD2 STH2k .Screen/y DEO2
#20 .Screen/color DEO
STH2r #0008 ADD2 .Screen/y DEO2
#20 .Screen/color DEO
STHr #01 ADD DUP
#08 LTH ,&loop JCN
POP
STHr ( recover beat )
#00 SWP #10 MUL pos-y-dev ADD2 STH2k .Screen/y DEO2
,&color LDR .Screen/color DEO
STH2r #0008 ADD2 .Screen/y DEO2
,&color LDR .Screen/color DEO
RTN
@on-controller ( -> )
.Controller/button DEI
DUP #10 AND ,&up JCN
DUP #20 AND ,&down JCN
DUP #40 AND ,&left JCN
DUP #80 AND ,&right JCN
DUP #01 AND ,&inc-nibble JCN
DUP #02 AND ,&dec-nibble JCN
POP
&keys
.Controller/key DEI
DUP LIT 'j EQU ,&down JCN
DUP LIT 'k EQU ,&up JCN
DUP LIT '+ EQU ,&inc-nibble JCN
DUP LIT '- EQU ,&dec-nibble JCN
POP BRK
( registers )
&down
inc-ptr-reg-byt
POP BRK
&up
dec-ptr-reg-byt
POP BRK
&left
inc-ptr-reg-nib
POP BRK
&right
dec-ptr-reg-nib
POP BRK
&inc-nibble ( increment nibble )
#01 ;add-to-nibble JSR2
( ;increment-nibble JSR2 )
POP BRK
&dec-nibble ( dec nibble )
#ff ;add-to-nibble JSR2
POP BRK
BRK
@add-to-nibble ( a -- ) ( add a to nibble pointed by ptr-register-nibbles )
,&num STR
,&start JMP
&num $1
&start
.ptr-register-nibbles LDZ ( get register address )
#01 SFT #00 SWP ;registers ADD2 ( calculate register address+offset )
STH2k ( store and keep address+offset )
LDA ( get register contents )
DUP ( duplicate byte )
#04 SFT #0f AND .high-nibble STZ ( store high nibble )
#0f AND .low-nibble STZ ( store low nibble )
.ptr-register-nibbles LDZ
#01 AND ( are we in high 1 or low 0 nibble? )
,&inc-high-nibble JCN
&inc-low-nibble
.low-nibble LDZ ,&num LDR ADD #0f AND ( increment and mask low nibble )
.low-nibble STZ
,&finish JMP
&inc-high-nibble
.high-nibble LDZ ,&num LDR ADD #0f AND ( increment and mask low nibble )
.high-nibble STZ
&finish
.high-nibble LDZ #40 SFT .low-nibble LDZ ORA ( reassemble byte )
STH2r ( recover byte address )
STA
RTN
@draw-bytes ( x2 y2 ptr-offset -- )
( can be modified to be: x2 y2 ptr-addrZ ptr-offset bytesaddrA -- )
;registers ,&addr STR2 ( starting address of bytes )
,&offset STR ( starting offset of these bytes )
.ptr-register-nibbles ,&ptr-addr STR ( address of pointer to bytes )
,&start JMP
&addr $2
&offset $1
&ptr-addr $1
&start
,&offset LDR
( #00 )
&loop
STH
OVR2 OVR2 ( duplicate x2 y2 )
STHkr ( copy counter )
#00 SWP ,&addr LDR2 ADD2 LDA ( add counter as offset to address )
,&ptr-addr LDR LDZ ( load pointer )
#01 SFT ( shift right to get byte number )
STHkr ( retrieve counter, copying )
NEQ ,&normal-mode JCN
( byte is selected )
,&ptr-addr LDR LDZ ( load pointer )
#01 AND #01 ADD ( get rightmost bit and add one to get mode )
,&draw JMP
&normal-mode
#00 ( mode )
&draw
;draw-byte JSR2
#0010 ADD2 ( increment y )
STHr ( recover counter )
#01 ADD DUP column-size ,&offset LDR ADD NEQ ,&loop JCN
POP POP2 POP2 ( pop counter, x and y )
RTN
@draw-byte ( x2 y2 byte mode -- )
DUP
#01 AND ,&low-nibble-mode STR ( mode 1 )
#01 SFT #01 AND ,&high-nibble-mode STR ( mode 2 )
,&start JMP
&high-nibble-mode $1
&low-nibble-mode $1
&start
STH ( stash byte )
OVR2 OVR2 ( duplicate coordinates )
STHr DUP STH ( restore, duplicate, stash byte )
#04 SFT #0f AND ( get high nibble )
,&high-nibble-mode LDR
;draw-nibble JSR2 ( draw high nibble )
SWP2 #0010 ADD2 SWP2 ( increment x )
STHr ( restore byte )
#0f AND ( get low nibble )
,&low-nibble-mode LDR
;draw-nibble JSR2 ( draw low nibble )
RTN
@draw-nibble ( x2 y2 num mode -- )
,&set-invert JCN ( check mode: 0 is normal, nonzero is inverted )
&set-normal
die-color-normal .die-color STZ
,&start JMP
&set-invert
die-color-invert .die-color STZ
&start
( bit 3 )
STH
.Screen/y DEO2
.Screen/x DEO2
STHr DUP STH
#03 SFT #01 AND ,&bit-3-on JCN
&bit-3-off
;nibble-dice-empty/tl .Screen/addr DEO2
,&bit-3-draw JMP
&bit-3-on
;nibble-dice-dot/tl .Screen/addr DEO2
&bit-3-draw
.die-color LDZ .Screen/color DEO
( bit 2 )
STHr DUP STH
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 ( increment x )
#02 SFT #01 AND ,&bit-2-on JCN
&bit-2-off
;nibble-dice-empty/tr .Screen/addr DEO2
,&bit-2-draw JMP
&bit-2-on
;nibble-dice-dot/tr .Screen/addr DEO2
&bit-2-draw
.die-color LDZ .Screen/color DEO
( bit 0 )
STHr DUP STH
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2 ( increment y )
#01 AND ,&bit-0-on JCN
&bit-0-off
;nibble-dice-empty/br .Screen/addr DEO2
,&bit-0-draw JMP
&bit-0-on
;nibble-dice-dot/br .Screen/addr DEO2
&bit-0-draw
.die-color LDZ .Screen/color DEO
( bit 1 )
STHr
.Screen/x DEI2 #0008 SUB2 .Screen/x DEO2 ( decrement x )
#01 SFT #01 AND ,&bit-1-on JCN
&bit-1-off
;nibble-dice-empty/bl .Screen/addr DEO2
,&bit-1-draw JMP
&bit-1-on
;nibble-dice-dot/bl .Screen/addr DEO2
&bit-1-draw
.die-color LDZ .Screen/color DEO
RTN
( sprites )
@square
ffff ffff ffff ffff
@nibble-dice-empty ( top left, top right, bottom left, bottom right )
&tl 00 1f 3f 7f 7f 7f 7f 7f 00 1f 3f 7f 7f 7f 7f 7f
&tr 00 f8 fc fe fe fe fe fe 00 f8 fc fe fe fe fe fe
&bl 7f 7f 7f 7f 7f 3f 1f 00 7f 7f 7f 7f 7f 3f 1f 00
&br fe fe fe fe fe fc f8 00 fe fe fe fe fe fc f8 00
@nibble-dice-dot ( top left, top right, bottom left, bottom right )
&tl 00 1f 3f 7f 7f 7f 7f 7f 00 1f 3f 73 61 61 73 7f
&tr 00 f8 fc fe fe fe fe fe 00 f8 fc ce 86 86 ce fe
&bl 7f 7f 7f 7f 7f 3f 1f 00 7f 73 61 61 73 3f 1f 00
&br fe fe fe fe fe fc f8 00 fe ce 86 86 ce fc f8 00
( samples )
@samples
:saw ( 0 )
:piano ( 1 )
:main ( 2 )
:tri ( 3 )
:sin
( from the audio.channels.tal uxn example )
@saw
0003 0609 0c0f 1215 181b 1e21 2427 2a2d
3033 3639 3b3e 4143 4649 4b4e 5052 5557
595b 5e60 6264 6667 696b 6c6e 7071 7274
7576 7778 797a 7b7b 7c7d 7d7e 7e7e 7e7e
7f7e 7e7e 7e7e 7d7d 7c7b 7b7a 7978 7776
7574 7271 706e 6c6b 6967 6664 6260 5e5b
5957 5552 504e 4b49 4643 413e 3b39 3633
302d 2a27 2421 1e1b 1815 120f 0c09 0603
00fd faf7 f4f1 eeeb e8e5 e2df dcd9 d6d3
d0cd cac7 c5c2 bfbd bab7 b5b2 b0ae aba9
a7a5 a2a0 9e9c 9a99 9795 9492 908f 8e8c
8b8a 8988 8786 8585 8483 8382 8282 8282
8182 8282 8282 8383 8485 8586 8788 898a
8b8c 8e8f 9092 9495 9799 9a9c 9ea0 a2a5
a7a9 abae b0b2 b5b7 babd bfc2 c5c7 cacd
d0d3 d6d9 dcdf e2e5 e8eb eef1 f4f7 fafd
@tri
8082 8486 888a 8c8e 9092 9496 989a 9c9e
a0a2 a4a6 a8aa acae b0b2 b4b6 b8ba bcbe
c0c2 c4c6 c8ca ccce d0d2 d4d6 d8da dcde
e0e2 e4e6 e8ea ecee f0f2 f4f6 f8fa fcfe
fffd fbf9 f7f5 f3f1 efed ebe9 e7e5 e3e1
dfdd dbd9 d7d5 d3d1 cfcd cbc9 c7c5 c3c1
bfbd bbb9 b7b5 b3b1 afad aba9 a7a5 a3a1
9f9d 9b99 9795 9391 8f8d 8b89 8785 8381
7f7d 7b79 7775 7371 6f6d 6b69 6765 6361
5f5d 5b59 5755 5351 4f4d 4b49 4745 4341
3f3d 3b39 3735 3331 2f2d 2b29 2725 2321
1f1d 1b19 1715 1311 0f0d 0b09 0705 0301
0103 0507 090b 0d0f 1113 1517 191b 1d1f
2123 2527 292b 2d2f 3133 3537 393b 3d3f
4143 4547 494b 4d4f 5153 5557 595b 5d5f
6163 6567 696b 6d6f 7173 7577 797b 7d7f
@sin
8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
b0b3 b6b9 bbbe c1c3 c6c9 cbce d0d2 d5d7
d9db dee0 e2e4 e6e7 e9eb ecee f0f1 f2f4
f5f6 f7f8 f9fa fbfb fcfd fdfe fefe fefe
fffe fefe fefe fdfd fcfb fbfa f9f8 f7f6
f5f4 f2f1 f0ee eceb e9e7 e6e4 e2e0 dedb
d9d7 d5d2 d0ce cbc9 c6c3 c1be bbb9 b6b3
b0ad aaa7 a4a1 9e9b 9895 928f 8c89 8683
807d 7a77 7471 6e6b 6865 625f 5c59 5653
504d 4a47 4542 3f3d 3a37 3532 302e 2b29
2725 2220 1e1c 1a19 1715 1412 100f 0e0c
0b0a 0908 0706 0505 0403 0302 0202 0202
0102 0202 0202 0303 0405 0506 0708 090a
0b0c 0e0f 1012 1415 1719 1a1c 1e20 2225
2729 2b2e 3032 3537 3a3d 3f42 4547 4a4d
5053 5659 5c5f 6265 686b 6e71 7477 7a7d
@piano
8182 8588 8d91 959b a1a6 aaad b2b5 b8bd
c1c7 cbd0 d5d9 dde1 e5e5 e4e4 e1dc d7d1
cbc5 bfb8 b2ac a6a2 9c97 928d 8884 807c
7977 7574 7372 7272 7273 7372 706d 6964
605b 5650 4d49 4643 4342 4244 4548 4a4d
5052 5556 5758 5554 5150 4c4a 4744 423f
3d3c 3a38 3835 3431 3030 2f31 3336 393e
4449 4e54 5a60 666b 7175 7b82 8990 989e
a6ab b1b6 babd bebf bfbe bbb9 b6b3 b0ae
aaa8 a6a3 a19e 9c9a 9997 9696 9798 9b9e
a1a4 a6a9 a9ac adad adae aeaf b0b0 b1b1
b3b3 b4b4 b4b3 b3b1 b0ad abab a9a9 a8a8
a7a5 a19d 9891 8b84 7e77 726e 6b6b 6b6c
6f71 7477 7776 7370 6c65 5e56 4e48 423f
3d3c 3b3a 3a39 3838 3839 393a 3c3e 4146
4a50 575b 6064 686a 6e70 7274 7677 7a7d