( piano )

%+  { ADD } %-   { SUB }  %*  { MUL } %/   { DIV }
%<  { LTH } %>   { GTH }  %=  { EQU } %!   { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }

%RTN  { JMP2r }
%TOS  { #00 SWP }
%MOD  { DUP2 / * - }
%LTS2 { #8000 ++ SWP2 #8000 ++ >> }
%GTS2 { #8000 ++ SWP2 #8000 ++ << }
%INCR { SWP #01 + SWP }
%2//  { #01 SFT2 }
%4//  { #02 SFT2 }
%8//  { #03 SFT2 }
%8**  { #30 SFT2 }

%WAVEFORM { #1000 }

( devices )

|00 @System     [ &vector $2 &pad      $6 &r      $2 &g     $2 &b      $2 ]
|10 @Console    [ &pad    $8 &char     $1 &byte   $1 &short $2 &string $2 ]
|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 ]
|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 &chord  $1 ]
|a0 @File       [ &vector $2 &success  $2 &offset $2 &pad   $2 &name  $2 &length $2 &load $2 &save $2 ]

( variables )

|0000

@last-note   $1
@octave      $1
@color       $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 ]

( program )

|0100 ( -> )
	
	( theme ) 
	#0fe5 .System/r DEO2 
	#0fc5 .System/g DEO2 
	#0f25 .System/b DEO2

	( vectors ) 
	;on-frame   .Screen/vector DEO2
	;on-control .Controller/vector DEO2
	;on-mouse   .Mouse/vector DEO2
	;on-midi    .Midi/vector DEO2

	( load waveform )
	;piano-path  .File/name DEO2 #0100 .File/length DEO2 WAVEFORM .File/load DEO2
	;violin-path .File/name DEO2 #0100 .File/length DEO2 WAVEFORM #0100 ++  .File/load DEO2
	;sin-path   .File/name DEO2 #0100 .File/length DEO2 WAVEFORM #0200 ++ .File/load DEO2
	;tri-path   .File/name DEO2 #0100 .File/length DEO2 WAVEFORM #0300 ++ .File/load DEO2
	;sqr-path   .File/name DEO2 #0100 .File/length DEO2 WAVEFORM #0400 ++ .File/load DEO2
	;saw-path   .File/name DEO2 #0100 .File/length DEO2 WAVEFORM #0500 ++ .File/load DEO2

	( find center )
	.Screen/width DEI2 2// .center/x STZ2
	.Screen/height DEI2 2// .center/y STZ2

	( place octave )
	.center/x LDZ2 #0080 -- .octave-view/x1 STZ2
	.center/y LDZ2 #0008 ++ .octave-view/y1 STZ2
	.octave-view/x1 LDZ2 #0050 ++ .octave-view/x2 STZ2
	.octave-view/y1 LDZ2 #0018 ++ .octave-view/y2 STZ2

	( place adsr )
	.center/x LDZ2 #0020 -- .adsr-view/x1 STZ2
	.center/y LDZ2 #0008 ++ .adsr-view/y1 STZ2
	.adsr-view/x1 LDZ2 #00a0 ++ .adsr-view/x2 STZ2
	.adsr-view/y1 LDZ2 #0018 ++ .adsr-view/y2 STZ2

	( place waveform )
	.center/x LDZ2 #0080 -- .wave-view/x1 STZ2
	.center/y LDZ2 #0020 -- .wave-view/y1 STZ2
	.wave-view/x1 LDZ2 #0100 ++ .wave-view/x2 STZ2
	.wave-view/y1 LDZ2 #0020 ++ .wave-view/y2 STZ2

	( default settings )
	#ff .last-note STZ
	#041c .Audio0/adsr DEO2
	#88 .Audio0/volume DEO
	WAVEFORM .Audio0/addr DEO2
	#0100 .Audio0/length DEO2

	( inital drawing ) 
	;draw-octave JSR2
	;draw-adsr JSR2
	;draw-wave JSR2

BRK

@on-frame ( -> )
	
	.adsr-view/y2 LDZ2 #0020 -- .Screen/y DEO2

	#00 #10
	&loop
		.adsr-view/x2 LDZ2 #003a -- .Screen/x DEO2
		OVR #10 SWP - .Audio0/output DEI #0f AND < .Screen/color DEO
		.adsr-view/x2 LDZ2 #003a -- #0002 ++ .Screen/x DEO2
		OVR #10 SWP - .Audio0/output DEI #04 SFT < .Screen/color DEO
		.Screen/y DEI2 #0002 ++ .Screen/y DEO2
		( incr ) INCR
		LTHk ,&loop JCN
	POP2

BRK

@on-control ( -> )

	( clear last cursor )
	.pointer/x LDZ2 .Screen/x DEO2 
	.pointer/y LDZ2 .Screen/y DEO2 
	#30 .Screen/color DEO

	.Controller/key DEI
	DUP #61 ! ,&no-c JCN
		#00 .last-note STZ ;notes LDA ;play JSR2 &no-c
	DUP #73 ! ,&no-d JCN
		#01 .last-note STZ ;notes #0001 ++ LDA ;play JSR2 &no-d
	DUP #64 ! ,&no-e JCN
		#02 .last-note STZ ;notes #0002 ++ LDA ;play JSR2 &no-e
	DUP #66 ! ,&no-f JCN
		#03 .last-note STZ ;notes #0003 ++ LDA ;play JSR2 &no-f
	DUP #67 ! ,&no-g JCN
		#04 .last-note STZ ;notes #0004 ++ LDA ;play JSR2 &no-g
	DUP #68 ! ,&no-a JCN
		#05 .last-note STZ ;notes #0005 ++ LDA ;play JSR2 &no-a
	DUP #6a ! ,&no-b JCN
		#06 .last-note STZ ;notes #0006 ++ LDA ;play JSR2 &no-b
	DUP #6b ! ,&no-c2 JCN
		#07 .last-note STZ ;notes #0007 ++ LDA ;play JSR2 &no-c2
	POP

	( release )
	#00 .Controller/key DEO

	.Controller/button DEI #f0 AND
	DUP #04 SFT #01 AND #01 ! ,&no-up JCN
		( move ) .Audio0/addr DEI2 #0001 -- .Audio0/addr DEO2 &no-up
	DUP #05 SFT #01 AND #01 ! ,&no-down JCN
		( move ) .Audio0/addr DEI2 #0001 ++ .Audio0/addr DEO2 &no-down
	DUP #06 SFT #01 AND #01 ! ,&no-left JCN
		( move ) .Audio0/addr DEI2 #0010 -- .Audio0/addr DEO2 &no-left
	DUP #07 SFT #01 AND #01 ! ,&no-right JCN
		( move ) .Audio0/addr DEI2 #0010 ++ .Audio0/addr DEO2 &no-right
	POP

	;draw-octave JSR2
	;draw-wave JSR2

BRK

@on-midi ( -> )
	
	.Midi/note DEI #00 ! #01 JCN [ BRK ]
	.Midi/note DEI .Audio0/pitch .Midi/channel DEI #04 MOD #10 * + DEO

BRK

@on-mouse ( -> )

	;draw-cursor JSR2 
	
	.Mouse/state DEI #00 ! #01 JCN [ BRK ]

	.Mouse/x DEI2 .Mouse/y DEI2 .wave-view ;within-rect JSR2 
		;on-touch-wave-view JCN2
	.Mouse/x DEI2 .Mouse/y DEI2 .adsr-view ;within-rect JSR2 
		;on-touch-adsr-view JCN2
	.Mouse/x DEI2 .Mouse/y DEI2 .octave-view ;within-rect JSR2 
		;on-touch-octave-view JCN2

BRK

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

	.Mouse/x DEI2 .wave-view/x1 LDZ2 -- .Audio0/length DEO2
	;draw-wave JSR2
	;draw-cursor JSR2 

BRK

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

	.Mouse/x DEI2 .octave-view/x1 LDZ2 -- 8// SWP POP #09 ! ,&no-mod JCN
		.Mouse/y DEI2 .octave-view/y1 LDZ2 -- 8// SWP POP 
		DUP #00 ! ,&no-incr JCN
			.octave LDZ #01 + .octave STZ &no-incr
		DUP #02 ! ,&no-decr JCN
			.octave LDZ #01 - .octave STZ &no-decr
		POP
		( release ) #00 .Mouse/state DEO
		;draw-octave JSR2
		BRK
	&no-mod

	.Mouse/x DEI2 .octave-view/x1 LDZ2 -- 8// SWP POP #06 > ,&no-key JCN
		.Mouse/x DEI2 .octave-view/x1 LDZ2 -- 8// DUP2 SWP POP .last-note STZ ;notes ++ LDA ;play JSR2
		( release ) #00 .Mouse/state DEO
		;draw-octave JSR2
	&no-key

BRK 

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

	.Mouse/x DEI2 .adsr-view/x1 LDZ2 -- 8// SWP POP #03 /
	DUP #00 ! ,&no-a JCN
		.Audio0/adsr DEI
		#10 .Mouse/state DEI #10 = #e0 * + +
		.Audio0/adsr DEO &no-a
	DUP #01 ! ,&no-d JCN
		.Audio0/adsr DEI
		DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
		.Audio0/adsr DEO &no-d
	DUP #02 ! ,&no-s JCN
		.Audio0/adsr #01 + DEI
		#10 .Mouse/state DEI #10 = #e0 * + +
		.Audio0/adsr #01 + DEO &no-s
	DUP #03 ! ,&no-r JCN
		.Audio0/adsr #01 + DEI
		DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
		.Audio0/adsr #01 + DEO &no-r
	DUP #05 ! ,&no-left JCN
		.Audio0/volume DEI 
		#10 .Mouse/state DEI #10 = #e0 * + +
		.Audio0/volume DEO &no-left
	DUP #06 ! ,&no-right JCN
		.Audio0/volume DEI
		DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
		.Audio0/volume DEO &no-right
	POP

	( release ) #00 .Mouse/state DEO
	;draw-adsr JSR2
	;draw-cursor JSR2 

BRK

@play ( pitch -- )
	
	.octave LDZ #0c * + .Audio0/pitch DEO

RTN

@draw-cursor ( -- )
	
	( clear last cursor )
	;cursor .Screen/addr DEO2 
	.pointer/x LDZ2 .Screen/x DEO2 
	.pointer/y LDZ2 .Screen/y DEO2 
	#30 .Screen/color DEO
	( record pointer positions )
	.Mouse/x DEI2 .pointer/x STZ2 
	.Mouse/y DEI2 .pointer/y STZ2
	( draw new cursor )
	.pointer/x LDZ2 .Screen/x DEO2 
	.pointer/y LDZ2 .Screen/y DEO2 
	( colorize on state )
	#31 [ .Mouse/state DEI #00 ! ] + .Screen/color DEO

RTN

@draw-octave ( -- )
	
	.octave-view/x1 LDZ2 .octave-view/y1 LDZ2

	OVR2 OVR2 ;keys-left-icns #21 .last-note LDZ #00 = + ;draw-key JSR2
	OVR2 #0008 ++ OVR2 ;keys-middle-icns #21 .last-note LDZ #01 = + ;draw-key JSR2
	OVR2 #0010 ++ OVR2 ;keys-right-icns #21 .last-note LDZ #02 = + ;draw-key JSR2
	OVR2 #0018 ++ OVR2 ;keys-left-icns #21 .last-note LDZ #03 = + ;draw-key JSR2
	OVR2 #0020 ++ OVR2 ;keys-middle-icns #21 .last-note LDZ #04 = + ;draw-key JSR2
	OVR2 #0028 ++ OVR2 ;keys-middle-icns #21 .last-note LDZ #05 = + ;draw-key JSR2
	SWP2 #0030 ++ SWP2 ;keys-right-icns #21 .last-note LDZ #06 = + ;draw-key JSR2

	.octave-view/x1 LDZ2 #0048 ++ .Screen/x DEO2

	;arrow-icns .Screen/addr DEO2
	.octave-view/y1 LDZ2 .Screen/y DEO2
	#21 .Screen/color DEO

	;arrow-icns #0008 ++ .Screen/addr DEO2
	.octave-view/y1 LDZ2 #0010 ++ .Screen/y DEO2
	#21 .Screen/color DEO

	;font-hex .octave LDZ #03 + #00 SWP 8** ++ .Screen/addr DEO2
	.octave-view/y1 LDZ2 #0008 ++ .Screen/y DEO2
	#23 .Screen/color DEO

RTN

@draw-key ( x* y* addr* color -- )
		
	STH
	.Screen/addr DEO2 
	SWP2 .Screen/x DEO2
	DUP2 #0018 ++
	&loop
		( move ) OVR2 .Screen/y DEO2
		( draw ) STHkr .Screen/color DEO
		( incr ) .Screen/addr DEI2 #0008 ++ .Screen/addr DEO2  
		( incr ) SWP2 #0008 ++ SWP2
		LTH2k ,&loop JCN
	POP2 POP2 
	POPr

RTN

@draw-adsr ( -- )
	
	( adsr )
	.adsr-view/x1 LDZ2 .adsr-view/y1 LDZ2
		.Audio0/adsr DEI #04 SFT
		;draw-knob JSR2
	.adsr-view/x1 LDZ2 #0018 ++ .adsr-view/y1 LDZ2
		.Audio0/adsr DEI #0f AND
		;draw-knob JSR2
	.adsr-view/x1 LDZ2 #0030 ++ .adsr-view/y1 LDZ2
		.Audio0/adsr #01 + DEI #04 SFT
		;draw-knob JSR2
	.adsr-view/x1 LDZ2 #0048 ++ .adsr-view/y1 LDZ2
		.Audio0/adsr #01 + DEI #0f AND
		;draw-knob JSR2
	( volume )
	.adsr-view/x2 LDZ2 #0028 -- .adsr-view/y1 LDZ2
		.Audio0/volume DEI #04 SFT
		;draw-knob JSR2
	.adsr-view/x2 LDZ2 #0010 -- .adsr-view/y1 LDZ2
		.Audio0/volume DEI #0f AND
		;draw-knob JSR2

RTN

@draw-wave ( -- )
	
	( clear )
	.wave-view/x1 LDZ2
	.wave-view/y1 LDZ2
	.wave-view/x2 LDZ2 #0001 ++
	.wave-view/y2 LDZ2
	#00 ;fill-rect JSR2

	#01 ;draw-wave-length JSR2

	.wave-view/x1 LDZ2 .Screen/x DEO2

	( waveform )
	#00 #ff
	&loop
		( dotted line )
		OVR #01 AND ,&no-dot JCN 
			.wave-view/y1 LDZ2 #0010 ++ .Screen/y DEO2
			#03 .Screen/color DEO
		&no-dot
		OVR TOS .Audio0/addr DEI2 ++ LDA 
		#02 /
		TOS 4// .wave-view/y1 LDZ2 ++ .Screen/y DEO2
		.Screen/x DEI2 #0001 ++ .Screen/x DEO2
		( draw ) OVR .Audio0/length DEI2 SWP POP > #02 * #01 + .Screen/color DEO
		( incr ) INCR
		LTHk ,&loop JCN
	POP2

	( range )
	.wave-view/x1 LDZ2 .Screen/x DEO2
	.wave-view/y1 LDZ2 #0010 -- .Screen/y DEO2
	.Audio0/addr DEI2 #22 ;draw-short JSR2
	.wave-view/x2 LDZ2 #0020 -- .Screen/x DEO2
	.Audio0/length DEI2 #22 ;draw-short JSR2

RTN

@draw-wave-length ( color -- )
	
	STH
	.wave-view/x1 LDZ2 .Audio0/length DEI2 ++ .Screen/x DEO2
	.wave-view/y1 LDZ2 DUP2 #0020 ++
	&loop
		OVR2 .Screen/y DEO2
		( draw ) STHkr .Screen/color DEO
		( incr ) SWP2 #0001 ++ SWP2
		LTH2k ,&loop JCN
	POP2 POP2
	POPr

RTN

@draw-knob ( x* y* value -- )

	( load ) STH .Screen/y DEO2  .Screen/x DEO2
	;knob-icns .Screen/addr DEO2 
	( draw ) #21 .Screen/color DEO
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2 
	;knob-icns #0008 ++ .Screen/addr DEO2 
	( draw ) #21 .Screen/color DEO
	.Screen/y DEI2 #0008 ++ .Screen/y DEO2 
	;knob-icns #0018 ++ .Screen/addr DEO2 
	( draw ) #21 .Screen/color DEO
	.Screen/x DEI2 #0008 -- .Screen/x DEO2 
	;knob-icns #0010 ++ .Screen/addr DEO2 
	( draw ) #21 .Screen/color DEO
	.Screen/x DEI2 #0004 ++ .Screen/x DEO2
	.Screen/y DEI2 #0008 ++ .Screen/y DEO2
	;font-hex #00 STHkr #08 * ++ .Screen/addr DEO2
	( draw ) #21 .Screen/color DEO
	.Screen/x DEI2 #0004 -- #00 #00 STHkr ;knob-offsetx ++ LDA ++ .Screen/x DEO2
	.Screen/y DEI2 #0010 -- #00 #00 STHr ;knob-offsety ++ LDA ++ .Screen/y DEO2
	;knob-icns #0020 ++ .Screen/addr DEO2
	( draw ) #25 .Screen/color DEO

RTN

@draw-short ( short* color -- )

	STH SWP 
	DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
	( draw ) STHkr .Screen/color DEO
	#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	( draw ) STHkr .Screen/color DEO
	DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	( draw ) STHkr .Screen/color DEO
	#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	( draw ) STHr .Screen/color DEO

RTN

@fill-rect ( x1* y1* x2* y2* color -- )
	
	.color STZ
	( x1 x2 y1 y2 ) ROT2 SWP2
	&ver
		( save ) OVR2 .Screen/y DEO2
		STH2 STH2 OVR2 OVR2
		&hor
			( save ) OVR2 .Screen/x DEO2
			( draw ) .color LDZ .Screen/color DEO
			( incr ) SWP2 #0001 ++ SWP2
			OVR2 OVR2 LTS2 ,&hor JCN
		POP2 POP2 STH2r STH2r
		( incr ) SWP2 #0001 ++ SWP2
		OVR2 OVR2 LTS2 ,&ver JCN
	POP2 POP2 POP2 POP2

RTN

@within-rect ( x* y* rect -- flag )
	
	STH
	( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
	( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
	SWP2
	( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
	( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
	POP2 POP2 POPr
	#01 
RTN
	&skip
	POP2 POP2 POPr
	#00

RTN

@cursor 
	80c0 e0f0 f8e0 1000 

@arrow-icns 
	0010 387c fe10 1000
	0010 1010 fe7c 3810 

@notes 
	3c 3e 40 41 43 45 47
	48 4a 4c 4d 4f 51 53 

@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
	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 ( 0-F )
	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 

@piano-path "projects/sounds/piano.pcm $1
@violin-path "projects/sounds/violin.pcm $1
@sin-path "projects/sounds/sin.pcm $1
@tri-path "projects/sounds/tri.pcm $1
@sqr-path "projects/sounds/sqr.pcm $1
@saw-path "projects/sounds/saw.pcm $1