path: root/tests/examplefiles/tal/piano.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
|40 @Audio1 &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

%HALT { #010f DEO }

|0000

	@octave $1
	@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 )
	#0fe3 .System/r DEO2
	#0fc3 .System/g DEO2
	#0f23 .System/b DEO2
	( resize )
	#0180 .Screen/width DEO2
	#00e0 .Screen/height DEO2
	( find center )
	.Screen/width DEI2 #01 SFT2
		DUP2 .center/x STZ2
		#0080 SUB2
		DUP2 .octave-view/x1 STZ2
			#0050 ADD2 .octave-view/x2 STZ2
	.Screen/height DEI2 #01 SFT2 #0010 ADD2
		DUP2 .center/y STZ2
		#0010 ADD2
		DUP2 .octave-view/y1 STZ2
			#0018 ADD2 .octave-view/y2 STZ2
	( place adsr )
	.center/x LDZ2 #0020 SUB2 .adsr-view/x1 STZ2
	.center/y LDZ2 #0010 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
	( setup synth )
	#041c set-env
	#dd set-vol
	;sin-pcm .Audio0/addr DEO2
	;sin-pcm .Audio1/addr DEO2
	#0100
		DUP2 .Audio0/length DEO2
		.Audio1/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

(
@|vectors )

@on-frame ( -> )

	.Mouse/state DEI ?&skip-sft
	[ LIT2 00 &soft $1 ] EQUk ?&no-soft
		soften
		DUP #01 SUB ,&soft STR
		&no-soft
	POP2
	&skip-sft

	[ LIT &last $1 ] .Audio0/output DEI NEQk ?&changed
		POP2 BRK
		&changed
	,&last STR POP

	( redraw )
	[ LIT2 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
			DUP2 #0f AND LTH .Screen/pixel DEO
		.Screen/x DEI2k INC2 INC2 ROT DEO2
			#04 SFT LTH .Screen/pixel DEO
		.Screen/y DEI2k INC2 INC2 ROT DEO2
		INC GTHk ?&loop
	POP2

BRK

@on-control ( -> )

	.Controller/key DEI
	( octave )
	[ LIT "a ] NEQk NIP ?&no-c #30 .octave LDZ #0c MUL ADD play &no-c
	[ LIT "w ] NEQk NIP ?&no-c# #31 .octave LDZ #0c MUL ADD play &no-c#
	[ LIT "s ] NEQk NIP ?&no-d #32 .octave LDZ #0c MUL ADD play &no-d
	[ LIT "e ] NEQk NIP ?&no-d# #33 .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 "t ] NEQk NIP ?&no-f# #36 .octave LDZ #0c MUL ADD play &no-f#
	[ LIT "g ] NEQk NIP ?&no-g #37 .octave LDZ #0c MUL ADD play &no-g
	[ LIT "y ] NEQk NIP ?&no-g# #38 .octave LDZ #0c MUL ADD play &no-g#
	[ LIT "h ] NEQk NIP ?&no-a #39 .octave LDZ #0c MUL ADD play &no-a
	[ LIT "u ] NEQk NIP ?&no-a# #3a .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
	( controls )
	[ LIT "z ] NEQk NIP ?&no-dec .octave LDZk #01 SUB SWP STZ &no-dec
	[ LIT "x ] NEQk NIP ?&no-inc .octave LDZk INC SWP STZ &no-inc
	[ #1b ] NEQk NIP ?&no-esc HALT &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
	POP

	draw-octave

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-knobs-view
	.Mouse/x DEI2 .Mouse/y DEI2 .octave-view within-rect
		?on-touch-octave-view

BRK

@on-touch-wave-view ( -> )

	.Mouse/state DEI #01 GTH ?&paint
	.Mouse/x DEI2 .wave-view/x1 LDZ2 SUB2
		( min ) #0010 GTH2k [ JMP SWP2 POP2 ] set-length

BRK

&paint ( -> )

	.Mouse/y DEI2 .wave-view/y1 LDZ2 SUB2 #20 SFT2 NIP
	.Mouse/x DEI2 .wave-view/x1 LDZ2 SUB2 ;sin-pcm ADD2 STA
	draw-wave
	#10 ;on-frame/soft STA

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-knobs-view ( -> )

	.Mouse/x DEI2 .adsr-view/x1 LDZ2 SUB2 #03 SFT2 NIP #03 DIV
	.Mouse/y DEI2 .adsr-view/y1 LDZ2 SUB2 NIP
	OVR #04 LTH ?on-touch-adsr
	OVR #04 GTH ?on-touch-vol
	POP2

BRK

@on-touch-adsr ( knob value -> )

	STH2
	( mask ) #ffff #000f #03 OVRr STHr SUB #60 SFT SFT2 EOR2
		.Audio0/adsr DEI2 AND2
	( value ) #000f STHr OVR LTHk [ JMP SWP POP ] SUB
	( shift ) #03 STHr SUB #60 SFT SFT2 ORA2
	set-env

BRK

@on-touch-vol ( knob value -> )

	SWP #03 SUB INC INC SWP STH2
	( mask ) #0f OVRr STHr #60 SFT SFT
		.Audio0/volume DEI AND
	( value ) #0f STHr OVR LTHk [ JMP SWP POP ] SUB
	( shift ) #01 STHr SUB #60 SFT SFT ORA
	set-vol

BRK

(
@|core )

@play ( pitch -- )

	DUP #0c DIVk MUL SUB ;draw-octave/last STA
	DUP .Audio0/pitch DEO
		#0c SUB .Audio1/pitch DEO

JMP2r

@set-length ( length* -- )

	DUP2 .Audio0/length DEO2
		.Audio1/length DEO2

!draw-wave

@set-vol ( vol -- )

	DUP .Audio0/volume DEO
		.Audio1/volume DEO

!draw-adsr

@set-env ( adsr* -- )

	DUP2 .Audio0/adsr DEO2
		.Audio1/adsr DEO2

!draw-adsr

@soften ( -- )

	#0100 #0000
	&l
		DUP2 ;sin-pcm ADD2 get-average SWP2 STA POP
		INC2 GTH2k ?&l
	POP2 POP2
	draw-wave

JMP2r

@get-average ( addr* -- addr* average* )

	[ LIT2r 0000 ]
	DUP2 #0001 SUB2 DUP2 #0002 ADD2 SWP2
	&l
		LDAk LITr 00 STH ADD2r
		INC2 GTH2k ?&l
	POP2 POP2
	LDAk #00 SWP DUP2 DUP2 STH2r
	#01 SFT2 ADD2 ADD2 ADD2 #02 SFT2

JMP2r

(
@|drawing )

@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 02 -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 ( -- )

	( background )
	.wave-view/x1 LDZ2 .Screen/x DEO2
	.wave-view/y1 LDZ2 .Screen/y DEO2
	;fill-icn .Screen/addr DEO2
	[ LIT2 75 -Screen/auto ] DEO
	#e0 &lbg
		;dotted-icn .Screen/addr DEO2
		[ LIT2 0c -Screen/sprite ] DEO
		INC DUP ?&lbg
	POP
	.wave-view/x1 LDZ2 .Screen/x DEO2
	( waveform )
	[ LIT2 01 -Screen/auto ] DEO
	;sin-pcm/end ;sin-pcm
	&loop
		DUP2 ;sin-pcm SUB2 .Audio0/length DEI2 DIV2k MUL2 SUB2 ;sin-pcm ADD2 LDA
		#00 SWP #02 SFT2 .wave-view/y1 LDZ2 ADD2 .Screen/y DEO2
		( draw ) DUP2 ;sin-pcm SUB2 NIP .Audio0/length DEI2 NIP #01 SUB GTH INC .Screen/pixel DEO
		INC2 GTH2k ?&loop
	POP2 POP2
	( length line )
	.wave-view/x1 LDZ2 .Audio0/length DEI2 #0001 SUB2 ADD2 .Screen/x DEO2
	.wave-view/y1 LDZ2 .Screen/y DEO2
	;line-icn .Screen/addr DEO2
	[ LIT2 71 -Screen/auto ] DEO
	[ LIT2 05 -Screen/sprite ] DEO
	( range )
	[ LIT2 01 -Screen/auto ] DEO
	.wave-view/x1 LDZ2 .Screen/x DEO2
	.wave-view/y1 LDZ2 #0018 SUB2 .Screen/y DEO2
	.Audio0/length DEI2

!draw-short

@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/index .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 )

@notes-lut [
	30 32 34 35 37 39 3b 3c ]

@dotted-icn [
	0000 0000 0000 0000
	0000 0000 0000 0000
	0000 0000 0000 0000
	0000 0000 0000 0000
	aa00 0000 0000 0000
	0000 0000 0000 0000
	0000 0000 0000 0000
	0000 0000 0000 0000 ]
@line-icn [
	8080 8080 8080 8080
	]
@fill-icn [
	ffff ffff ffff ffff ]
@cursor-icn [
	80c0 e0f0 f8e0 1000 ]
@arrow-icns [
	0010 387c fe10 1000
&down
	0010 1010 fe7c 3810 ]
@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 ]

( pad ) [ 8080 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
( pad ) [ 8080 8080 ]