460 lines
11 KiB
Tal
460 lines
11 KiB
Tal
( Piano:
|
|
Play notes with the keyboard or the controller )
|
|
|
|
|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 &auto $1 &pad $1 &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
|
|
|80 @Controller &vector $2 &button $1 &key $1
|
|
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
|
|
|
|
|0000
|
|
|
|
@last-note $1
|
|
@octave $1
|
|
@pointer &x $2 &y $2
|
|
@center &x $2 &y $2
|
|
@adsr-view &x1 $2 &y1 $2 &x2 $2 &y2 $2
|
|
@wave-view &x1 $2 &y1 $2 &x2 $2 &y2 $2
|
|
@octave-view &x1 $2 &y1 $2 &x2 $2 &y2 $2
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0fe5 .System/r DEO2
|
|
#0fc5 .System/g DEO2
|
|
#0f25 .System/b DEO2
|
|
( find center )
|
|
.Screen/width DEI2 #01 SFT2 .center/x STZ2
|
|
.Screen/height DEI2 #01 SFT2 #0018 ADD2 .center/y STZ2
|
|
( place octave )
|
|
.center/x LDZ2 #0080 SUB2 .octave-view/x1 STZ2
|
|
.center/y LDZ2 #0008 ADD2 .octave-view/y1 STZ2
|
|
.octave-view/x1 LDZ2 #0050 ADD2 .octave-view/x2 STZ2
|
|
.octave-view/y1 LDZ2 #0018 ADD2 .octave-view/y2 STZ2
|
|
( place adsr )
|
|
.center/x LDZ2 #0020 SUB2 .adsr-view/x1 STZ2
|
|
.center/y LDZ2 #0008 ADD2 .adsr-view/y1 STZ2
|
|
.adsr-view/x1 LDZ2 #00a0 ADD2 .adsr-view/x2 STZ2
|
|
.adsr-view/y1 LDZ2 #0018 ADD2 .adsr-view/y2 STZ2
|
|
( place waveform )
|
|
.center/x LDZ2 #0080 SUB2 .wave-view/x1 STZ2
|
|
.center/y LDZ2 #0040 SUB2 .wave-view/y1 STZ2
|
|
.wave-view/x1 LDZ2 #0100 ADD2 .wave-view/x2 STZ2
|
|
.wave-view/y1 LDZ2 #0040 ADD2 .wave-view/y2 STZ2
|
|
#041c .Audio0/adsr DEO2
|
|
#dd .Audio0/volume DEO
|
|
;sin-pcm .Audio0/addr DEO2
|
|
#0100 .Audio0/length DEO2
|
|
( inital drawing )
|
|
draw-octave
|
|
draw-adsr
|
|
draw-wave
|
|
( unlock )
|
|
;on-frame .Screen/vector DEO2
|
|
;on-control .Controller/vector DEO2
|
|
;on-mouse .Mouse/vector DEO2
|
|
;on-message .Console/vector DEO2
|
|
|
|
BRK
|
|
|
|
@on-frame ( -> )
|
|
|
|
#00 .Screen/auto DEO
|
|
.adsr-view/y2 LDZ2 #0020 SUB2 .Screen/y DEO2
|
|
#1000
|
|
&loop
|
|
.adsr-view/x2 LDZ2 #003a SUB2 .Screen/x DEO2
|
|
#10 OVR SUB .Audio0/output DEI #0f AND LTH .Screen/pixel DEO
|
|
.adsr-view/x2 LDZ2 #003a SUB2 INC2 INC2 .Screen/x DEO2
|
|
#10 OVR SUB .Audio0/output DEI #04 SFT LTH .Screen/pixel DEO
|
|
.Screen/y DEI2k INC2 INC2 ROT DEO2
|
|
INC GTHk ?&loop
|
|
POP2
|
|
|
|
BRK
|
|
|
|
@on-control ( -> )
|
|
|
|
( clear last cursor )
|
|
.pointer/x LDZ2 .Screen/x DEO2
|
|
.pointer/y LDZ2 .Screen/y DEO2
|
|
#40 .Screen/sprite DEO
|
|
|
|
.Controller/key DEI
|
|
[ LIT "a ] NEQk NIP ?&no-c #30 .octave LDZ #0c MUL ADD play &no-c
|
|
[ LIT "s ] NEQk NIP ?&no-d #32 .octave LDZ #0c MUL ADD play &no-d
|
|
[ LIT "d ] NEQk NIP ?&no-e #34 .octave LDZ #0c MUL ADD play &no-e
|
|
[ LIT "f ] NEQk NIP ?&no-f #35 .octave LDZ #0c MUL ADD play &no-f
|
|
[ LIT "g ] NEQk NIP ?&no-g #37 .octave LDZ #0c MUL ADD play &no-g
|
|
[ LIT "h ] NEQk NIP ?&no-a #39 .octave LDZ #0c MUL ADD play &no-a
|
|
[ LIT "j ] NEQk NIP ?&no-b #3b .octave LDZ #0c MUL ADD play &no-b
|
|
[ LIT "k ] NEQk NIP ?&no-c2 #3c .octave LDZ #0c MUL ADD play &no-c2
|
|
[ #1b ] NEQk NIP ?&no-esc #010f DEO &no-esc
|
|
POP
|
|
|
|
( release )
|
|
#00 .Controller/key DEO
|
|
|
|
.Controller/button DEI
|
|
[ #11 ] NEQk NIP ?&cu #3c play &cu
|
|
[ #21 ] NEQk NIP ?&cd #3d play &cd
|
|
[ #41 ] NEQk NIP ?&cl #3e play &cl
|
|
[ #81 ] NEQk NIP ?&cr #3f play &cr
|
|
[ #12 ] NEQk NIP ?&au #40 play &au
|
|
[ #22 ] NEQk NIP ?&ad #41 play &ad
|
|
[ #42 ] NEQk NIP ?&al #42 play &al
|
|
[ #82 ] NEQk NIP ?&ar #43 play &ar
|
|
[ #14 ] NEQk NIP ?&su #44 play &su
|
|
[ #24 ] NEQk NIP ?&sd #45 play &sd
|
|
[ #44 ] NEQk NIP ?&sl #46 play &sl
|
|
[ #84 ] NEQk NIP ?&sr #47 play &sr
|
|
[ #40 ] NEQk NIP ?&l .Audio0/addr DEI2 #0010 SUB2 .Audio0/addr DEO2 &l
|
|
[ #80 ] NEQk NIP ?&r .Audio0/addr DEI2 #0010 ADD2 .Audio0/addr DEO2 &r
|
|
POP
|
|
|
|
draw-octave
|
|
draw-wave
|
|
|
|
BRK
|
|
|
|
@on-message ( -> )
|
|
|
|
.Console/read DEI play
|
|
draw-octave
|
|
|
|
BRK
|
|
|
|
@on-mouse ( -> )
|
|
|
|
#00 .Mouse/state DEI NEQ #41 ADD ;cursor-icn update-cursor
|
|
|
|
.Mouse/state DEI ?on-mouse-touch
|
|
|
|
BRK
|
|
|
|
@on-mouse-touch ( -> )
|
|
|
|
.Mouse/x DEI2 .Mouse/y DEI2 .wave-view within-rect
|
|
?on-touch-wave-view
|
|
.Mouse/x DEI2 .Mouse/y DEI2 .adsr-view within-rect
|
|
?on-touch-adsr-view
|
|
.Mouse/x DEI2 .Mouse/y DEI2 .octave-view within-rect
|
|
?on-touch-octave-view
|
|
|
|
BRK
|
|
|
|
@on-touch-wave-view ( -> )
|
|
|
|
.Mouse/x DEI2 .wave-view/x1 LDZ2 SUB2 .Audio0/length DEO2
|
|
draw-wave
|
|
|
|
BRK
|
|
|
|
@on-touch-octave-view ( -> )
|
|
|
|
.Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 NIP #09 NEQ ?&no-mod
|
|
.Mouse/y DEI2 .octave-view/y1 LDZ2 SUB2 #03 SFT2 NIP
|
|
[ #00 ] NEQk NIP ?&no-incr
|
|
.octave LDZ #03 EQU ?&no-incr
|
|
.octave LDZ INC .octave STZ &no-incr
|
|
[ #02 ] NEQk NIP ?&no-decr
|
|
.octave LDZ #ff EQU ?&no-decr
|
|
.octave LDZ #01 SUB .octave STZ &no-decr
|
|
POP
|
|
( release ) #00 .Mouse/state DEO
|
|
draw-octave
|
|
BRK
|
|
&no-mod
|
|
|
|
.Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 NIP #06 GTH ?&no-key
|
|
.Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 ;notes-lut ADD2 LDA .octave LDZ #0c MUL ADD play
|
|
( release ) #00 .Mouse/state DEO
|
|
draw-octave
|
|
&no-key
|
|
|
|
BRK
|
|
|
|
@on-touch-adsr-view ( -> )
|
|
|
|
.Mouse/x DEI2 .adsr-view/x1 LDZ2 SUB2 #03 SFT2 NIP #03 DIV
|
|
[ #00 ] NEQk NIP ?&no-a
|
|
.Audio0/adsr DEI touch2 .Audio0/adsr DEO &no-a
|
|
[ #01 ] NEQk NIP ?&no-d
|
|
.Audio0/adsr DEI touch .Audio0/adsr DEO &no-d
|
|
[ #02 ] NEQk NIP ?&no-s
|
|
.Audio0/adsr INC DEI touch2 .Audio0/adsr INC DEO &no-s
|
|
[ #03 ] NEQk NIP ?&no-r
|
|
.Audio0/adsr INC DEI touch .Audio0/adsr INC DEO &no-r
|
|
[ #05 ] NEQk NIP ?&no-left
|
|
.Audio0/volume DEI touch2 .Audio0/volume DEO &no-left
|
|
[ #06 ] NEQk NIP ?&no-right
|
|
.Audio0/volume DEI touch .Audio0/volume DEO &no-right
|
|
POP
|
|
|
|
( release ) #00 .Mouse/state DEO
|
|
draw-adsr
|
|
|
|
BRK
|
|
@touch
|
|
DUP #f0 AND STH #01 .Mouse/state DEI #01 GTH #0e MUL ADD ADD #0f AND STHr ADD JMP2r
|
|
@touch2
|
|
#10 .Mouse/state DEI #01 GTH #e0 MUL ADD ADD JMP2r
|
|
|
|
(
|
|
@|core )
|
|
|
|
@play ( pitch -- )
|
|
|
|
DUP #0c DIVk MUL SUB ;draw-octave/last STA
|
|
.Audio0/pitch DEO
|
|
|
|
JMP2r
|
|
|
|
@update-cursor ( color addr* -- )
|
|
|
|
[ LIT2 00 -Screen/auto ] DEO
|
|
#40 draw-cursor
|
|
.Mouse/x DEI2 ,draw-cursor/x STR2
|
|
.Mouse/y DEI2 ,draw-cursor/y STR2
|
|
.Screen/addr DEO2
|
|
|
|
@draw-cursor ( color -- )
|
|
|
|
[ LIT2 &x $2 ] .Screen/x DEO2
|
|
[ LIT2 &y $2 ] .Screen/y DEO2
|
|
.Screen/sprite DEO
|
|
|
|
JMP2r
|
|
|
|
@draw-octave ( -- )
|
|
|
|
( arrows )
|
|
[ LIT2 02 -Screen/auto ] DEO
|
|
.octave-view/x1 LDZ2 #0048 ADD2 .Screen/x DEO2
|
|
.octave-view/y1 LDZ2 .Screen/y DEO2
|
|
;arrow-icns .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
;font-hex .octave LDZ #03 ADD #00 SWP #30 SFT2 ADD2 .Screen/addr DEO2
|
|
[ LIT2 03 -Screen/sprite ] DEO
|
|
;arrow-icns/down .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
( octave )
|
|
.octave-view/x1 LDZ2 .Screen/x DEO2
|
|
.octave-view/y1 LDZ2 .Screen/y DEO2
|
|
[ LIT2 06 -Screen/auto ] DEO
|
|
[ LITr &last ff ]
|
|
;keys-left-icns STHkr #00 EQU INC draw-key
|
|
;keys-middle-icns STHkr #02 EQU INC draw-key
|
|
;keys-right-icns STHkr #04 EQU INC draw-key
|
|
;keys-left-icns STHkr #05 EQU INC draw-key
|
|
;keys-middle-icns STHkr #07 EQU INC draw-key
|
|
;keys-middle-icns STHkr #09 EQU INC draw-key
|
|
;keys-right-icns STHr #0b EQU INC
|
|
|
|
( >> )
|
|
|
|
@draw-key ( addr* color -- )
|
|
|
|
STH
|
|
.Screen/addr DEO2
|
|
.Screen/y DEI2
|
|
STHr .Screen/sprite DEOk DEOk DEO
|
|
.Screen/x DEI2k #0008 ADD2 ROT DEO2
|
|
.Screen/y DEO2
|
|
|
|
JMP2r
|
|
|
|
@draw-adsr ( -- )
|
|
|
|
( adsr )
|
|
.adsr-view/x1 LDZ2 .adsr-view/y1 LDZ2
|
|
.Audio0/adsr DEI #04 SFT draw-knob
|
|
.adsr-view/x1 LDZ2 #0018 ADD2 .adsr-view/y1 LDZ2
|
|
.Audio0/adsr DEI #0f AND draw-knob
|
|
.adsr-view/x1 LDZ2 #0030 ADD2 .adsr-view/y1 LDZ2
|
|
.Audio0/adsr INC DEI #04 SFT draw-knob
|
|
.adsr-view/x1 LDZ2 #0048 ADD2 .adsr-view/y1 LDZ2
|
|
.Audio0/adsr INC DEI #0f AND draw-knob
|
|
( volume )
|
|
.adsr-view/x2 LDZ2 #0028 SUB2 .adsr-view/y1 LDZ2
|
|
.Audio0/volume DEI #04 SFT draw-knob
|
|
.adsr-view/x2 LDZ2 #0010 SUB2 .adsr-view/y1 LDZ2
|
|
.Audio0/volume DEI #0f AND
|
|
|
|
!draw-knob
|
|
|
|
@draw-wave ( -- )
|
|
|
|
( #01 draw-wave-length )
|
|
( dotted zero )
|
|
|
|
.wave-view/x1 LDZ2 .Screen/x DEO2
|
|
|
|
( waveform )
|
|
[ LIT2 01 -Screen/auto ] DEO
|
|
;sin-pcm/end ;sin-pcm
|
|
&loop
|
|
LDAk #00 SWP #02 SFT2 .wave-view/y1 LDZ2 ADD2 .Screen/y DEO2
|
|
( draw ) DUP2 ;sin-pcm SUB2 NIP .Audio0/length DEI2 NIP GTH INC INC .Screen/pixel DEO
|
|
INC2 GTH2k ?&loop
|
|
POP2 POP2
|
|
|
|
( range )
|
|
#01 .Screen/auto DEO
|
|
.wave-view/x1 LDZ2 .Screen/x DEO2
|
|
.wave-view/y1 LDZ2 #0010 SUB2 .Screen/y DEO2
|
|
.Audio0/addr DEI2 draw-short
|
|
.wave-view/x2 LDZ2 #0020 SUB2 .Screen/x DEO2
|
|
.Audio0/length DEI2 draw-short
|
|
#00 .Screen/auto DEO
|
|
|
|
JMP2r
|
|
|
|
@draw-wave-length ( color -- )
|
|
|
|
( clear background )
|
|
#f2 .Screen/auto DEO
|
|
.wave-view/x1 LDZ2 DUP2 .Screen/x DEO2
|
|
.wave-view/y1 LDZ2 DUP2 .Screen/y DEO2
|
|
,&wipe JSR
|
|
.Screen/y DEO2
|
|
#0080 ADD2 .Screen/x DEO2
|
|
,&wipe JSR
|
|
#00 .Screen/auto DEO
|
|
|
|
STH
|
|
.wave-view/x1 LDZ2 .Audio0/length DEI2 ADD2 .Screen/x DEO2
|
|
.wave-view/y1 LDZ2 DUP2 #0020 ADD2 SWP2
|
|
&loop
|
|
DUP2 .Screen/y DEO2
|
|
( draw ) STHkr .Screen/pixel DEO
|
|
INC2 GTH2k ?&loop
|
|
POP2 POP2
|
|
POPr
|
|
|
|
JMP2r
|
|
&wipe #00 .Screen/sprite DEOk DEOk DEOk DEO JMP2r
|
|
|
|
@draw-knob ( x* y* value -- )
|
|
|
|
STH
|
|
OVR2 OVR2 .Screen/y DEO2 .Screen/x DEO2
|
|
( circle )
|
|
;knob-icns .Screen/addr DEO2
|
|
[ LIT2 16 -Screen/auto ] DEO
|
|
[ LIT2 01 -Screen/sprite ] DEOk DEO
|
|
( value )
|
|
#0010 ADD2 .Screen/y DEO2
|
|
#0004 ADD2 .Screen/x DEO2
|
|
;font-hex #00 STHkr #30 SFT ADD2 .Screen/addr DEO2
|
|
[ LIT2 00 -Screen/auto ] DEO
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
( marker )
|
|
.Screen/x DEI2 #0004 SUB2 #0000 STHkr ;knob-offsetx ADD2 LDA ADD2 .Screen/x DEO2
|
|
.Screen/y DEI2 #0010 SUB2 #0000 STHr ;knob-offsety ADD2 LDA ADD2 .Screen/y DEO2
|
|
;knob-icns #0020 ADD2 .Screen/addr DEO2
|
|
[ LIT2 05 -Screen/sprite ] DEO
|
|
|
|
JMP2r
|
|
|
|
@draw-short ( short* -- )
|
|
|
|
SWP draw-byte
|
|
|
|
@draw-byte ( byte -- )
|
|
|
|
DUP #04 SFT draw-hex #0f AND
|
|
|
|
@draw-hex ( char -- )
|
|
|
|
#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
|
|
[ LIT2 02 -Screen/sprite ] DEO
|
|
|
|
JMP2r
|
|
|
|
@within-rect ( x* y* rect -- flag )
|
|
|
|
STH
|
|
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ?&skip
|
|
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip
|
|
SWP2
|
|
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip
|
|
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip
|
|
POP2 POP2 POPr
|
|
#01
|
|
JMP2r
|
|
&skip
|
|
POP2 POP2 POPr
|
|
#00
|
|
|
|
JMP2r
|
|
|
|
@phex ( short* -- ) SWP phex/b &b DUP #04 SFT phex/c &c #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
|
|
|
|
(
|
|
|
|
@|assets )
|
|
|
|
@cursor-icn [
|
|
80c0 e0f0 f8e0 1000 ]
|
|
@arrow-icns [
|
|
0010 387c fe10 1000
|
|
&down
|
|
0010 1010 fe7c 3810 ]
|
|
@notes-lut [
|
|
30 32 34 35
|
|
37 39 3b 3c ]
|
|
@keys-left-icns [
|
|
7c7c 7c7c 7c7c 7c7c
|
|
7c7c 7c7c 7c7c 7e7f
|
|
7f7f 7f7f 7f7f 3e00 ]
|
|
@keys-middle-icns [
|
|
1c1c 1c1c 1c1c 1c1c
|
|
1c1c 1c1c 1c1c 3e7f
|
|
7f7f 7f7f 7f7f 3e00 ]
|
|
@keys-right-icns [
|
|
1f1f 1f1f 1f1f 1f1f
|
|
1f1f 1f1f 1f1f 3f7f
|
|
7f7f 7f7f 7f7f 3e00 ]
|
|
@knob-icns [
|
|
0003 0c10 2020 4040
|
|
00c0 3008 0404 0202
|
|
4040 2020 100c 0300
|
|
0202 0404 0830 c000
|
|
&index
|
|
0000 183c 3c18 0000 ]
|
|
@knob-offsetx [
|
|
01 00 00 00 00 01 02 03
|
|
05 06 07 08 08 08 08 07 ]
|
|
@knob-offsety [
|
|
07 06 05 03 02 01 00 00
|
|
00 00 01 02 03 05 06 07 ]
|
|
@font-hex [
|
|
007c 8282 8282 827c 0030 1010 1010 1010
|
|
007c 8202 7c80 80fe 007c 8202 1c02 827c
|
|
000c 1424 4484 fe04 00fe 8080 7c02 827c
|
|
007c 8280 fc82 827c 007c 8202 1e02 0202
|
|
007c 8282 7c82 827c 007c 8282 7e02 827c
|
|
007c 8202 7e82 827e 00fc 8282 fc82 82fc
|
|
007c 8280 8080 827c 00fc 8282 8282 82fc
|
|
007c 8280 f080 827c 007c 8280 f080 8080 ]
|
|
@sin-pcm [
|
|
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 ]
|
|
&end
|