\ sine wave multiple synthesizer
\ for faster sin calculations with fractional integers a full cycle
\ representing 360 or 2PI is split into 2048 sections
\   0 -->	0
\  45 -->	512
\  90 -->	1024
\ 180 -->	2048
\ 360 -->	0=4096
\ sines are fixed-point integers with 24bits fractional part
\ hs 16.12.97
[ifndef] floats-on  ??cr .( needs floating point package) abort [then]
decimal floats-on
needs rnd	lib.random
[ifndef] #scale  h# 1.000000 constant #scale [then]

2048 cells	  buffer: frac-sine-tab	\ holding sin values
		3 constant #synths
128 3 * cells     buffer: synth-tab

: set-synthi	( level frequency sample-rate syn# -- )
	3 * cells synth-tab + locals| buff srate freq lev |
	lev buff 2 cells+ !
	rnd buff !
	freq 4096 * h# 1.0000 srate */ buff cell+ ! ;
: init-synth
	2048 0
	do	i s>d d>f  2048. d>f f/  PI f* fsin  #scale s>d d>f f* f>d drop
		frac-sine-tab i cells+ !
	loop
	synth-tab 32 3 * cells erase
	#scale  8 /	48000	 64 / 16000 0 set-synthi
\	#scale  64 /	16000	 8 / 16000 1 set-synthi
\	#scale 256 /	16000	 4 / 16000 2 set-synthi

	 ; init-synth
\ synth-tab holds up to 32 synthesized sine waves, each synthi is defined
\ by 3 cells
\ 0: last used angle
\ 1: stepspeed h# 1.0000 means add 1 to angle per synth run
\ 2: 24bit fractional signal level
code (frac-sin)	\ r0: angle, r1: sintab
		\ returns sinus in r0
		\ uses r14, r2,
	r2	4095 #			mov
	r0	r0	r2		and	\ angle within 0-360
	r0	2048 #			cmp	\
	r0	r0	r2 1 #lsr	and	\ scale within 0-180
	r0	r0	2 #lsl		mov
	r0	r1 r0 ib		ldr	\ unsigned sinus
	r0	r0	0 #		gt rsb	\ negate sinus for 180-360
	return end-code
code (synthezize)	\ r0: input/output value, synthesizer output is added to the input
		r6	'body #synths pcr	ldr	\ #synthis is loop index
		r6	0 #			cmp le next
		r1 r2 r3 r4 r5 r6 r7 r14 8  sp	pushm
		r7	r0			mov	\ accumulator
		r5	'body synth-tab pcr	ldr	\ synthi definers
		r1	'body frac-sine-tab pcr	ldr	\ sinus tab
  begin		r3 r4 2		r5 ia!		ldm	\ r3 last angle, r4 stepspeed
  		r3	r3	r4		add
		r3	r5 -2 cells d)		str
		r0	r3	16 #lsr		mov
		' (frac-sin)			dolink branch
		r4	r5 )+			ldr
		r2 r3	r4 r0			smull
		r0	r2	8 #lsl		mov
		r0	r0	r3 24 #lsr	orr
		r7	r7	r0		add
		r6	1			s decr
  eq until	r0	r7			mov
  		r1 r2 r3 r4 r5 r6 r7 r14 8  sp	popm
  		return end-code

code frac-sin	( angle -- fractional-sin )
	r0	top			mov
	r1 'body frac-sine-tab pcr	ldr
	' (frac-sin)			dolink branch
	top	r0			mov c;
code synthezize	( -- signal )
	top	sp			push
	r0	0 #			mov
	' (synthezize)			dolink branch
	top	r0			mov c;
