~rabbits/orca-toy

3a7e7feab1026761230928c415d0d982cea90997 — Devine Lu Linvega 1 year, 3 months ago e792707
Progress on voices manager
2 files changed, 46 insertions(+), 28 deletions(-)

M src/library.tal
M src/orca.tal
M src/library.tal => src/library.tal +4 -4
@@ 426,14 426,14 @@ JMP2r
	&*

	STH2k
	( channel ) get-port-right1-value [ ,&ch STR ]
	( channel ) get-port-right1-value [ ,&chn STR ]
	( octave ) STH2kr INC2 get-port-right1-value
	( note ) STH2kr #0003 ADD2 get-port-right-raw
	( has note ) DUP LIT ". NEQ ?&has-note [ POP2 POP2r JMP2r ] &has-note
	( has bang ) get-bang ?&is-bang [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r write-type
	( get note ) chrmid SWP [ #0c MUL ] ADD
	( play ) .Audio0/pitch [ LIT &ch $1 ] #03 AND #40 SFT ADD DEO
	( play ) .Audio0/pitch [ LIT &chn $1 ] #03 AND #40 SFT ADD DEO

JMP2r



@@ 441,7 441,7 @@ JMP2r
	&*

	INC2k STH2k
	( channel ) get-port-right-value ,&ch STR
	( channel ) get-port-right-value ,&chn STR
	( octave ) INC2r STH2kr get-port-right-value #0c MUL
	( note ) INC2r STH2kr get-port-right-raw chrmid ADD ,&pitch STR
	( velocity ) INC2r STH2kr get-port-right-value 


@@ 450,7 450,7 @@ JMP2r
	get-bang ?&has-bang POP2 JMP2r &has-bang
	,&pitch LDR ?&has-pitch POP2 JMP2r &has-pitch
	.types/io ROT ROT write-type
	[ LIT2 &ch $1 &pitch $1 ] [ LIT2 &len $1 &vel $1 ] add-voice
	[ LIT2 &chn $1 &pitch $1 ] [ LIT2 &len $1 &vel $1 ] add-voice

JMP2r


M src/orca.tal => src/orca.tal +42 -24
@@ 38,7 38,7 @@
	@head &x $1 &y $1 &addr $2
	@variables $24
	@signal &midi $1 &midi-last $1
	@voices $20
	@voices $20 &end

|0100 ( -> )



@@ 699,43 699,61 @@ JMP2r
(
@|voices )

@add-voice ( ch vel pitch len -- )
@send-voice ( voice -- )

	( send midi )

JMP2r

@release-voice ( voice -- )

	( send midi )

JMP2r

@add-voice ( chn pitch len vel -- )

	( save )
	next-voice STHk STZ2
	INCr INCr STHr STZ2
	( send )

JMP2r

( release if already playing )
	OVR2 ,&t STR2
	#2000
	&l
		DUP #20 SFT .voices ADD LDZk #00 EQU ?&no-voice
			INCk INC LDZ2 [ LIT2 &t $2 ] NEQ2 ?&no-voice
				DUP release-voice
			&no-voice
			POP
		INC GTHk ?&l
	POP2

@next-voice ( -- voice )

	.voices
	.voices/end .voices
	&l
		LDZk #00 EQU ?&end
		#04 ADD GTHk ?&l
	&end NIP

JMP2r

@manage-voices ( -- )

JMP2r

	( iterate thru channels )

	#1000 &while EQUk ?&end
		( note ) DUPk ADD .voices ADD LDZk
		( remaining length ) SWP INC LDZ
		( next channel if already 0 ) DUP #00 EQU ?&next-chan
		( update remaining length ) #01 SUB ROTk DUP ADD .voices ADD INC STZ POP
		( send note-off when length reaches 0 )
		#00 NEQ ?&no-off
			( channel ) OVR .Console/write DEO
			( note ) DUP .Console/write DEO
			( off ) #00 .Console/write DEO
		&no-off
	#2000
	&l
		DUP #20 SFT .voices ADD LDZk #00 EQU ?&no-voice
			LDZk #01 SUB OVR STZ
			LDZk #00 NEQ ?&no-voice
			( TODO: send midi event )
			&no-voice
		POP
		INC
	!&while
		&end POP2 JMP2r

	&next-chan POP2 INC
	,&while JMP
		INC GTHk ?&l
	POP2

JMP2r