/'
	BASS 3D test
	Copyright (c) 1999-2008 Un4seen Developments Ltd.
*** adapted for FreeBasic by electrik
'/

#include "windows.bi"
#include "win/commctrl.bi"
#include "win/commdlg.bi"
#include "crt.bi"
#include "bass.bi"

dim shared as HWND win=NULL

' channel (sample/music) info structure
type Channel
as 	DWORD channel			' the channel
as 	BASS_3DVECTOR pos,vel	' position,velocity
end type

dim shared as Channel ptr chans=NULL		' the channels
dim shared as integer chanc=0,chan=-1		' number of channels, current channel

#define TIMERPERIOD	50		' timer period (ms)
#define MAXDIST		50		' maximum distance of the channels (m)
#define SPEED		12		' speed of the channels' movement (m/s)

' Display error dialogs
sub mError(byval es as const zstring ptr)
	dim as zstring * 200 mes
	wsprintf(mes,"%s\n(error code: %d)",es,BASS_ErrorGetCode())
	MessageBox(win,mes,0,0)
end sub

' Messaging macros
#define ITEM(id) GetDlgItem(win,id)
#define MESS(id,m,w,l) SendDlgItemMessage(win,id,m,cast(WPARAM,w),cast(LPARAM,l))
#define LM(m,w,l) MESS(10,m,w,l)
#define EM(m,w,l) MESS(22,m,w,l)

sub Update(byval win as HWND, byval m as UINT, byval i as UINT, byval t as DWORD)
dim as 	HDC dc = any
dim as     RECT r = any
dim as integer c,x,y,cx,cy = any
dim as 	HBRUSH red=CreateSolidBrush(&hff)
	win=ITEM(30)
	dc=GetDC(win)
	GetClientRect(win,@r)
	cx=r.right/2
	cy=r.bottom/2

	' clear the display
	FillRect(dc,@r,GetStockObject(WHITE_BRUSH))

	' Draw the listener
	SelectObject(dc,GetStockObject(GRAY_BRUSH))
	Ellipse(dc,cx-4,cy-4,cx+4,cy+4)

	for c as integer =0 to chanc-1
		' If the channel's playing then update it's position
		if BASS_ChannelIsActive(chans[c].channel) = BASS_ACTIVE_PLAYING then
			' Check if channel has reached the max distance
			if chans[c].pos.z >= MAXDIST or chans[c].pos.z <= -MAXDIST then
				chans[c].vel.z=-chans[c].vel.z
end if
			if chans[c].pos.x>=MAXDIST or chans[c].pos.x<=-MAXDIST then
				chans[c].vel.x=-chans[c].vel.x
end if
			' Update channel position
			chans[c].pos.z+=chans[c].vel.z*TIMERPERIOD/1000
			chans[c].pos.x+=chans[c].vel.x*TIMERPERIOD/1000
			BASS_ChannelSet3DPosition(chans[c].channel,@chans[c].pos,NULL,@chans[c].vel)
end if
		' Draw the channel position indicator
		x=cx+int((cx-10)*chans[c].pos.x/MAXDIST)
		y=cy-int((cy-10)*chans[c].pos.z/MAXDIST)
		SelectObject(dc,iif(chan =c, red,GetStockObject(WHITE_BRUSH)))
		Ellipse(dc,x-4,y-4,x+4,y+4)
next
	' Apply the 3D changes
	BASS_Apply3D()

	ReleaseDC(win,dc)
	DeleteObject(red)	
end sub

' Update the button states
sub UpdateButtons()
	for a as integer = 12 to 17
		EnableWindow(ITEM(a),iif(chan=-1,FALSE,TRUE))
next
	if chan <> -1 then
		SetDlgItemInt(win,15,abs(int(chans[chan].vel.x)),FALSE)
		SetDlgItemInt(win,16,abs(int(chans[chan].vel.z)),FALSE)
end if
end sub

function  dialogproc(byval h as HWND  ,byval m as UINT ,byval w as WPARAM,byval l as LPARAM ) as BOOL

	static ofn as OPENFILENAME

select case m 
		case WM_COMMAND:
			select case LOWORD(w)
				case 10: ' change the selected channel
					if HIWORD(w) = LBN_SELCHANGE then 
					chan=LM(LB_GETCURSEL,0,0)
					if chan=LB_ERR then chan=-1
					UpdateButtons()
end if
				case 11: ' add a channel
						dim as zstring * MAX_PATH file
						dim as DWORD newchan = any
						ofn.lpstrFile=@file
						if (GetOpenFileName(@ofn)) then
							' Load a music or sample from "file"
newchan=BASS_MusicLoad(FALSE,@file,0,0,BASS_MUSIC_RAMP or BASS_SAMPLE_LOOP or BASS_SAMPLE_3D,0)
if newchan = 0 then newchan = BASS_SampleLoad(FALSE,@file,0,0,1,BASS_SAMPLE_LOOP or BASS_SAMPLE_3D or BASS_SAMPLE_MONO)
if newchan then
								dim as Channel ptr c = any
								chanc+=1
								chans=cast(channel ptr,reallocate(chans,chanc*sizeof(Channel)))
								c=chans+chanc-1
								clear(*c,0,sizeof(Channel))
								c->channel=newchan
								BASS_SampleGetChannel(newchan,FALSE) ' initialize sample channel
								LM(LB_ADDSTRING,0,strrchr(file,92)+1)' 92 - backslash
							else
								mError("Can't load file (note samples must be mono)")
end if
end if
				case 12: ' remove a channel
						dim as Channel ptr c=chans+chan
						BASS_SampleFree(c->channel)
						BASS_MusicFree(c->channel)
						memmove(c,c+1,(chanc-chan-1)*sizeof(Channel))
						chanc-=1
						LM(LB_DELETESTRING,chan,0)
						chan=-1
						UpdateButtons()
				case 13:
					BASS_ChannelPlay(chans[chan].channel,FALSE)
				case 14:
					BASS_ChannelPause(chans[chan].channel)
				case 15: ' X velocity
					if HIWORD(w) = EN_CHANGE then 
dim as integer v=GetDlgItemInt(win,15,0,FALSE)
						if abs(int(chans[chan].vel.x)) <>v then chans[chan].vel.x=v
end if
				case 16: ' Z velocity
					if HIWORD(w) = EN_CHANGE then  
dim as integer v=GetDlgItemInt(win,16,0,FALSE)
						if abs(int(chans[chan].vel.z)) <> v then chans[chan].vel.z=v
end if
				case 17: ' reset the position and velocity to 0
					clear(chans[chan].pos,0,sizeof(chans[chan].pos))
					clear(chans[chan].vel,0,sizeof(chans[chan].vel))
					UpdateButtons()
				case 22: ' change the EAX environment
					if HIWORD(w) = CBN_SELCHANGE then 
dim as integer s=EM(CB_GETCURSEL,0,0)
						if  s = 0 then
							BASS_SetEAXParameters(-1,0,-1,-1) ' off (volume=0)
						else
							BASS_SetEAXParameters(s-1,-1,-1,-1)
end if
end if
				case IDCANCEL:
					DestroyWindow(h)
end select

		case WM_HSCROLL:
			if l then 
dim as integer cpos=SendMessage(cast(HWND,l),TBM_GETPOS,0,0)
select case GetDlgCtrlID(cast(HWND,l)) 
					case 20: ' change the rolloff factor
						BASS_Set3DFactors(-1,pow(2,(cpos-10)/5.0),-1)
					case 21: ' change the doppler factor
						BASS_Set3DFactors(-1,-1,pow(2,(cpos-10)/5.0))
end select
end if
		case WM_INITDIALOG:
			win=h

			EM(CB_ADDSTRING,0,@"Off")
			EM(CB_ADDSTRING,0,@"Generic")
			EM(CB_ADDSTRING,0,@"Padded Cell")
			EM(CB_ADDSTRING,0,@"Room")
			EM(CB_ADDSTRING,0,@"Bathroom")
			EM(CB_ADDSTRING,0,@"Living Room")
			EM(CB_ADDSTRING,0,@"Stone Room")
			EM(CB_ADDSTRING,0,@"Auditorium")
			EM(CB_ADDSTRING,0,@"Concert Hall")
			EM(CB_ADDSTRING,0,@"Cave")
			EM(CB_ADDSTRING,0,@"Arena")
			EM(CB_ADDSTRING,0,@"Hangar")
			EM(CB_ADDSTRING,0,@"Carpeted Hallway")
			EM(CB_ADDSTRING,0,@"Hallway")
			EM(CB_ADDSTRING,0,@"Stone Corridor")
			EM(CB_ADDSTRING,0,@"Alley")
			EM(CB_ADDSTRING,0,@"Forest")
			EM(CB_ADDSTRING,0,@"City")
			EM(CB_ADDSTRING,0,@"Mountains")
			EM(CB_ADDSTRING,0,@"Quarry")
			EM(CB_ADDSTRING,0,@"Plain")
			EM(CB_ADDSTRING,0,@"Parking Lot")
			EM(CB_ADDSTRING,0,@"Sewer Pipe")
			EM(CB_ADDSTRING,0,@"Under Water")
			EM(CB_ADDSTRING,0,@"Drugged")
			EM(CB_ADDSTRING,0,@"Dizzy")
			EM(CB_ADDSTRING,0,@"Psychotic")
			EM(CB_SETCURSEL,0,0)

			MESS(20,TBM_SETRANGE,FALSE,MAKELONG(0,20))
			MESS(20,TBM_SETPOS,TRUE,10)
			MESS(21,TBM_SETRANGE,FALSE,MAKELONG(0,20))
			MESS(21,TBM_SETPOS,TRUE,10)

			SetTimer(h,1,TIMERPERIOD,@Update)
clear(ofn,0,sizeof(OPENFILENAME))
			ofn.lStructSize=sizeof(ofn)
			ofn.hwndOwner=h
			ofn.nMaxFile=MAX_PATH
			ofn.Flags=OFN_HIDEREADONLY or OFN_EXPLORER
			ofn.lpstrFilter=@!"wav/aif/mo3/xm/mod/s3m/it/mtm/umx\0*.wav;*.aif;*.mo3;*.xm;*.mod;*.s3m;*.it;*.mtm;*.umx\0All files\0*.*\0\0"
			return 1
		case WM_DESTROY:
			KillTimer(h,1)
			if chans then free(chans)
			PostQuitMessage(0)
end select

	return 0
end function

function WinMain(byval hInstance as HINSTANCE, byval hPrevInstance as HINSTANCE,byval lpCmdLine as LPSTR , byval nCmdShow as integer) as integer
dim as 	MSG msg = any

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

	 ' enable trackbar support
dim 		as INITCOMMONCONTROLSEX cc=type(sizeof(cc),ICC_BAR_CLASSES)
		InitCommonControlsEx(@cc)

	' Create the main window
	if CreateDialog(hInstance,MAKEINTRESOURCE(1000),NULL,@dialogproc) = 0 then
		mError("Can't create window")
		return 0
end if

	' Initialize the default output device with 3D support
	if BASS_Init(-1,44100,BASS_DEVICE_3D,win,NULL) = 0 then
		mError("Can't initialize output device")
		EndDialog(win,0)
		return 0
end if

	' Use meters as distance unit, real world rolloff, real doppler effect
	BASS_Set3DFactors(1,1,1)
	' Turn EAX off (volume=0), if error then EAX is not supported
	if BASS_SetEAXParameters(-1,0,-1,-1)then EnableWindow(GetDlgItem(win,22),TRUE)
	while GetMessage(@msg,NULL,0,0) <> FALSE 
		if IsDialogMessage(win,@msg) =  FALSE then
			TranslateMessage(@msg)
			DispatchMessage(@msg)
end if
wend
	BASS_Free()
	return 0
end function

end WinMain(GetModuleHandle(NULL),0,GetCommandLine(),SW_NORMAL )
