/'
	BASS simple synth
	Copyright (c) 2001-2008 Un4seen Developments Ltd.
***  адаптед for FreeBasic and add new functions by electrik
'/

#include "windows.bi"
#include "crt.bi"
#include "bass.bi"

' display error messages
sub dError(byval text as zString ptr) 
	printf(!"Error(%d): %s\n",BASS_ErrorGetCode(),text)
	BASS_Free()
end
end sub


const as double PI = 3.14159265358979323846
#define TABLESIZE 2048
dim shared as integer	sinetable(TABLESIZE) ' sine table
#define nKEYS 37
dim shared as WORD keys(nKEYS) = _
{VK_Z,VK_S,VK_X,VK_D,VK_C,VK_V,VK_G,VK_B,VK_H,VK_N,VK_J,VK_M,VK_OEM_COMMA,VK_L,VK_OEM_PERIOD,VK_OEM_1,VK_OEM_2,VK_Q,VK_2, _
VK_W,VK_3,VK_E,VK_R,VK_5,VK_T,VK_6,VK_Y,VK_7,VK_U,VK_I,VK_9,VK_O,VK_0,VK_P,VK_OEM_4,VK_OEM_PLUS,VK_OEM_6}
#define MAXVOL	4000.0	' higher value = longer fadeout

' keys' volume & pos
dim shared as single vol(nKEYS-5)
dim shared as integer bpos(nKEYS-5)
dim shared as single BaseOctave = 220.0

' stream writer
function WriteStream(byval handle as HSTREAM , byval buffer as short  ptr, byval length as DWORD, byval user as any ptr) as DWORD 
	dim as integer n,s = any
	dim as DWORD c= any
dim as single f = any

	memset(buffer,0,length)
	for n =0 to nKEYS-1-5
		if vol(n) = 0.0 then continue for
f=2.0 ^ ((n+3)/12)*TABLESIZE*baseOctave/44100.0

		for c=0 to (length/4-1)
		if vol(n) = 0.0 then continue for
bpos(n) +=1
			s=int(sinetable(int(bpos(n)*f) and (TABLESIZE-1))*vol(n)/MAXVOL)

			s+=buffer[c*2]
			if s>32767 then
s=32767
			elseIf s<-32768 then s=-32768
end if

 ' left and right channels are the same
			buffer[c*2+1]=s
buffer[c*2]=s
			if vol(n) < MAXVOL then vol(n)-=0.5

next
next
return length
end function


dim as 	BASS_INFO info
dim as 	HSTREAM stream
	dim as const zstring ptr fxname(9)={@"CHORUS",@"COMPRESSOR",@"DISTORTION",@"ECHO",@"FLANGER",@"GARGLE",@"I3DL2REVERB",@"PARAMEQ",@"REVERB"}
	dim as HFX fx(9)={0} ' effect handles
	dim as INPUT_RECORD keyin
dim as 	DWORD r,buflen
dim as integer supKeys
dim as integer tWave = 1

	printf(!"BASS Simple Sinewave Synth\n" _
			!"--------------------------\n")

	' check the correct BASS was loaded
	if HIWORD(BASS_GetVersion()) <> BASSVERSION then
		printf("An incorrect version of BASS.DLL was loaded")
end
end if

	' 10ms update period
	BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD,10)

	' setup output - get latency
	if BASS_Init(-1,44100,BASS_DEVICE_LATENCY,0,NULL) = 0 then
		dError(@"Can't initialize device")
end if

	' build sine table
	for r=0 to TABLESIZE-1 
		sinetable(r) = int(sin(2.0 * PI * r / TABLESIZE) * 7000.0)
next
	BASS_GetInfo(@info)
	printf(!"device latency: %dms\n",info.latency)
	printf(!"device minbuf: %dms\n",info.minbuf)
	printf(!"ds version: %d (effects %s)\n",info.dsver,iif(info.dsver<8,@"disabled",@"enabled"))

	' default buffer size = update period + 'minbuf'
	BASS_SetConfig(BASS_CONFIG_BUFFER,10+info.minbuf)
	buflen=BASS_GetConfig(BASS_CONFIG_BUFFER)

	' create a stream, stereo so that effects sound nice
	stream=BASS_StreamCreate(44100,2,0,cast(STREAMPROC ptr,@WriteStream),0)
	printf(!"press these keys to play:\n\n" _
			!"  2 3  5 6 7  9 0  =\n" _
			!" Q W ER T Y UI O P[ ]\n" _
!"S D G H J L ;\n" _
!"Z X C V B N M , . /\n\n" _
			!"press -/+ to de/increase the buffer\n" _
!"press F12 to change waveform\n" _
!"press  numpad * or / to change octave\n" _
			!"press esc to quit\n\n")

	if info.dsver>=8 then ' DX8 effects available
		printf(!"press F1-F9 to toggle effects\n\n")
end if

	printf(!"using a %dms buffer\r",buflen)

	BASS_ChannelPlay(stream,FALSE)

	while ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE),@keyin,1,@r)
		dim as integer key
		if keyin.EventType <> KEY_EVENT then continue while
		if keyin.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE then exit while
		if keyin.Event.KeyEvent.bKeyDown then
			if keyin.Event.KeyEvent.wVirtualKeyCode = VK_SUBTRACT _
				or keyin.Event.KeyEvent.wVirtualKeyCode = VK_ADD then

				' recreate stream with smaller/larger buffer
				BASS_StreamFree(stream)
				if keyin.Event.KeyEvent.wVirtualKeyCode = VK_SUBTRACT then
					BASS_SetConfig(BASS_CONFIG_BUFFER,buflen-1) ' smaller buffer
				else 
					BASS_SetConfig(BASS_CONFIG_BUFFER,buflen+1) ' larger buffer
end if
				buflen=BASS_GetConfig(BASS_CONFIG_BUFFER)
				printf(!"using a %dms buffer\t\t\r",buflen)
				stream = BASS_StreamCreate(44100,2,0,cast(STREAMPROC ptr,@WriteStream),0)
				' set effects on the new stream
				for r=0 to 8
 if fx(r) then  fx(r)=BASS_ChannelSetFX(stream,BASS_FX_DX8_CHORUS+r,0)
next
				BASS_ChannelPlay(stream,FALSE)

end if
			if keyin.Event.KeyEvent.wVirtualKeyCode >= VK_F1 _
				and keyin.Event.KeyEvent.wVirtualKeyCode<=VK_F9 then
				r=keyin.Event.KeyEvent.wVirtualKeyCode-VK_F1
				if fx(r) then
					BASS_ChannelRemoveFX(stream,fx(r))
					fx(r)=0
					printf(!"effect %s = OFF\t\t\r",fxname(r))
 else
					' set the effect, not bothering with parameters (use defaults)
fx(r) = BASS_ChannelSetFX(stream,BASS_FX_DX8_CHORUS+r,0)
					if fx(r)then
						printf(!"effect %s = ON\t\t\r",fxname(r))
end if
end if
end if
			if keyin.Event.KeyEvent.wVirtualKeyCode = VK_MULTIPLY then 
baseOctave *=2
if baseOctave > 1760 then baseOctave = 1760
end if
			if keyin.Event.KeyEvent.wVirtualKeyCode = VK_DIVIDE then 
baseOctave /=2
if baseOctave < 3.4375 then baseOctave = 3.4375
end if
			if keyin.Event.KeyEvent.wVirtualKeyCode = VK_F12 then 
	for r=0 to TABLESIZE-1 
select case tWave
case 0
		sinetable(r) = int(sin(2.0 * PI * r / TABLESIZE) * 7000.0)
case 1
sinetable(r) = int((2/pi)*asin(sin(2.0 * PI * r / TABLESIZE)) * 7000.0)
case 2
sinetable(r) = int(-2 *((r/tablesize)-0.5) * 7000)
case 3
		sinetable(r) = iif(frac(r/tablesize) < 0.5,7000.0,-7000.0)
case 4
sinetable(r) =  int(sgn(sin(2.0 * PI * r / TABLESIZE/2)-0.5) * 7000)
case 5
sinetable(r) =  int(sgn(sin(2.0 * PI * r / TABLESIZE/2)-0.25) * 7000)
end select
next
tWave+=1
if tWave > 5 then tWave = 0
end if
end if
		for key = 0 to nKEYS-1
			if keyin.Event.KeyEvent.wVirtualKeyCode = keys(key) then
supKeys=iif(key>16,5,0)
				if keyin.Event.KeyEvent.bKeyDown and vol(key-supKeys) <> MAXVOL then
					bpos(key-supKeys) = 0
					vol(key-supKeys) = MAXVOL ' start key
 elseIf keyin.Event.KeyEvent.bKeyDown = 0 and vol(key-supKeys) then vol(key-supKeys) -=0.5 ' trigger key fadeout
end if
end if
next
wend

	BASS_Free()

