(*
/*

CLASS {AL4_OpenAL|_Delphi_FPC}, UNTESTED, NATIVE:

NATIVE: "uses AL4_OpenAL;" .
NATIVE: "///copy AL4_OpenAL.pas" .


*/
*)

unit AL4_OpenAL;

interface

uses OpenAL;

procedure Do_Init_OpenAL;
function Do_alcOpenDevice(const DevName: String): Integer;
procedure Do_alcCloseDevice(DevIndex: Integer);
function get_Device(DevIndex: Integer): PALCdevice;

function Do_alcCreateContext(DevIndex: Integer): Integer;
procedure Do_alcMakeContextCurrent(CtxIndex: Integer);
procedure Do_alcDestroyContext(CtxIndex: Integer);


implementation

var OpenAL_initialized: Boolean;
	listenerpos: array [0..2] of TALfloat= ( 0.0, 0.0, 0.0);
	listenervel: array [0..2] of TALfloat= ( 0.0, 0.0, 0.0);
	listenerori: array [0..5] of TALfloat= ( 0.0, 0.0, -1.0, 0.0, 1.0, 0.0);


procedure Do_Init_OpenAL;
begin
	if OpenAL_initialized then Exit;
	InitOpenAL;
end;

var All_devices: array of PALCdevice;
var All_device_contexts: array of TALCcontext;

function Do_alcOpenDevice(const DevName: String): Integer;
var d: PALCdevice;
	i: Integer;
begin
	if DevName = '' then
		d := alcOpenDevice(nil)
	else d := alcOpenDevice(PALCchar(DevName));
	if d = nil then Result := 0
	else
	begin
		for i := 1 to High(All_devices) do
			if All_devices[i] = nil then
			begin 
				// reuse free position
				Result := i;
				All_devices[i] := d;
				Exit;
			end; 
		if Length(All_devices) = 0 then
			SetLength(All_devices, 1);
		SetLength(All_devices, Length(All_devices)+1);
		All_devices[High(All_devices)] := d;
		Result := High(All_devices);
	end;
end;

procedure Do_alcCloseDevice(DevIndex: Integer);
begin
	alcCloseDevice(All_devices[DevIndex]);
	All_devices[DevIndex] := nil;
	if DevIndex = High(All_devices) then
	begin
		if DevIndex = 1 then
		begin
			SetLength(All_devices, 0); Exit;
		end;
		SetLength(All_devices, Length(All_devices)-1);
	end;
end;

function get_Device(DevIndex: Integer): PALCdevice;
begin
	RESULT := All_devices[DevIndex];
end;


function Do_alcCreateContext(DevIndex: Integer): Integer;
var Ctx: TALCcontext;
	i: Integer;
begin
	Ctx := alcCreateContext(get_Device(DevIndex), nil);
	for i := 1 to High(All_device_contexts) do
		if All_device_contexts[i] = nil then
		begin 
			// reuse free position
			Result := i;
			All_device_contexts[i] := Ctx;
			Exit;
		end; 
	if Length(All_device_contexts) = 0 then
		SetLength(All_device_contexts, 1);
	SetLength(All_device_contexts, Length(All_device_contexts)+1);
	All_device_contexts[High(All_device_contexts)] := Ctx;
	Result := High(All_device_contexts);
end;

procedure Do_alcMakeContextCurrent(CtxIndex: Integer);
begin
	if CtxIndex = 0 then Exit;
	alcMakeContextCurrent(All_device_contexts[CtxIndex]);
end;


procedure Do_alcDestroyContext(CtxIndex: Integer);
begin
	alcDestroyContext(All_device_contexts[CtxIndex]);
	All_device_contexts[CtxIndex] := nil;
	if CtxIndex = High(All_device_contexts) then
	begin
		if CtxIndex = 1 then
		begin
			SetLength(All_device_contexts, 0); Exit;
		end;
		SetLength(All_device_contexts, Length(All_device_contexts)-1);
	end;
end;



end.

(*
/*

FUNCTION NATIVE_alcOpenDevice(
	STR Device_name) ==> INT, NATIVE :
	"RESULT := Do_alcOpenDevice(X_Device_name);"
	.
	
FUNCTION NATIVE_alcCloseDevice(
	INT Dev|ice_index_1_or_higher), NATIVE
	:
	CASE Dev <= 0 ? ==> ;
	NATIVE "Do_alcCloseDevice(X_Dev);" .
	
FUNCTION NATIVE_alcCreateContext(
	INT Device|_handle) ==> INT, NATIVE :
	"RESULT := Do_alcCreateContext(X_Device);"
	.
	
FUNCTION NATIVE_alcDestroyContext(
	INT Context|_handle), NATIVE :
	"Do_alcDestroyContext(X_Context);" .
	
FUNCTION NATIVE_alcMakeContextCurrent(
	INT Context|_handle), NATIVE :
	"Do_alcMakeContextCurrent(X_Context);" .
	


CONST STR:
	NATIVE_import_OpenAL = @
	"uses AL4_OpenAL, OpenAL, Windows;"
	
	NATIVE_OpenAL_present = @
	"var libAL: THandle;"
	"libAL := LoadLibrary('openal32.dll');"
	"RESULT := libAL <> 0;"
	"if RESULT then FreeLibrary(libAL);"
	
	NATIVE_Init_OpenAL = @
	"Do_Init_OpenAL;"
	
	NATIVE_alcGetError = @
	"var err: Integer;"
	"err := alcGetError(get_Device(X_Dev));"
	"case err of"
	"ALC_INVALID_VALUE: RESULT := 1;"
	"ALC_INVALID_ENUM: RESULT := 2;"
	"ALC_INVALID_DEVICE: RESULT := 3;"
	"ALC_INVALID_CONTEXT: RESULT := 4;"
	"ALC_OUT_OF_MEMORY: RESULT := 5;"
	"end;"
	
	NATIVE_alcGetString = @
	"RESULT := alcGetString(get_Device(X_Dev), X_Param);"
	
	NATIVE_alcGetIntegerv = @
	"var dbuffer: array of Integer;"
	"var i: Integer;"
	"SetLength(dbuffer, X_Size);"
	"alcGetIntegerv(get_Device(X_Dev), X_Param, X_Size, @dbuffer[0]);"
	"for i := 0 to X_Size-1 do"
	"	 X_Data.SetIntegers(i, dbuffer[i]);"
	
	NATIVE_alGetString = @
	"RESULT := alGetString(X_Param);"
	
	NATIVE_alGetBoolean = @
	"var bdata: TALboolean;"
	"alGetBooleanv(X_Param, @bdata);"
	"RESULT := bdata;"
	
	NATIVE_alGetInteger = @
	"var idata: TALint;"
	"alGetIntegerv(X_Param, @idata);"
	"RESULT := idata;"
	
	NATIVE_alGetDouble = @
	"var ddata: Double;"
	"alGetDoublev(X_Param, @ddata);"
	"RESULT := ddata;"
	
	NATIVE_alGetError = @
	"RESULT := alGetError();"
	"CASE Integer(RESULT) OF"
	"AL_INVALID_NAME: RESULT := 1;"
	"AL_INVALID_ENUM: RESULT := 2;"
	"AL_INVALID_VALUE: RESULT := 3;"
	"AL_INVALID_OPERATION: RESULT := 4;"
	"AL_OUT_OF_MEMORY: RESULT := 5;"
	"end;"
	
	NATIVE_alListenerf = @
	"alListenerf(X_Param, X_Value);"
	
	NATIVE_alGetListenerf = @
	"var fvalue: TALfloat;"
	"alGetListenerfv(X_Param, @fvalue);"
	"RESULT := fvalue;"
	
	NATIVE_alListener3f = @
	"alListener3f(X_Param, "
	"	X_Values.GetReals(0),"
	"	X_Values.GetReals(1),"
	"	X_Values.GetReals(2));"
	
	NATIVE_alGetListenerfv = @
	"var fbuffer: array[0..2] of TALfloat;"
	"alGetListenerfv(X_Param, @fbuffer[0]);"
	"X_Values.SetReals(0, fbuffer[0]);"
	"X_Values.SetReals(1, fbuffer[1]);"
	"X_Values.SetReals(2, fbuffer[2]);"
	
	NATIVE_alGenSources = @
	"var arr: array of Integer;"
	"var i: Integer;"
	"SetLength(arr, X_N);"
	"alGenSources(X_N, @arr[0]);"
	"for i := 0 to X_N-1 do"
	"	X_Sources.SetIntegers(i, arr[i]);"
	
	NATIVE_alDeleteSources = @
	"var arr: array of Integer;"
	"var i: Integer;"
	"SetLength(arr, X_Sources.Count());"
	"for i := 0 to X_Sources.Count()-1 do"
	"	arr[i] := X_Sources.GetIntegers(i);"
	"alDeleteSources(X_Sources.Count(), @arr[0]);"
	
	NATIVE_alIsSource = @
	"RESULT := alIsSource(X_Index_s);"
	
	NATIVE_alSourcef = @
	"alSourcef(X_Source, X_Param, X_Value);"
	
	NATIVE_alGetSourcef = @
	"var fvalue: TALfloat;"
	"alGetSourcef(X_Source, X_Param, @fvalue);"
	"RESULT := fvalue;"
	
	NATIVE_alSource3f = @
	"alSource3f(X_Source, X_Param, "
	"	X_Value.GetReals(0), X_Value.GetReals(1), X_Value.GetReals(2));"
	
	NATIVE_alGetSource3f = @
	"var f1, f2, f3: TALfloat;"
	"alGetSource3f(X_Source, X_Param, @f1, @f2, @f3);"
	"X_Value.SetReals(0, f1);"
	"X_Value.SetReals(1, f2);"
	"X_Value.SetReals(2, f3);"
	
	NATIVE_alSourcei = @
	"alSourcei(X_Source, X_Param, X_Value);"
	
	NATIVE_alGetSourcei = @
	"var ivalue: TALint;"
	"alGetSourcei(X_Source, X_Param, @ivalue);"
	"RESULT := ivalue;"
	
	NATIVE_alSourcePlayv = @
	"var sbuf: array of TALuint;"
	"var i: Integer;"
	"SetLength(sbuf, X_Sources.Count());"
	"for i := 0 to X_Sources.Count()-1 do"
	"	sbuf[i] := X_Sources.GetIntegers(i);"
	"alSourcePlayv(Length(sbuf), @sbuf[0]);"
	
	NATIVE_alSourcePausev = @
	"var sbuf: array of TALuint;"
	"var i: Integer;"
	"SetLength(sbuf, X_Sources.Count());"
	"for i := 0 to X_Sources.Count()-1 do"
	"	sbuf[i] := X_Sources.GetIntegers(i);"
	"alSourcePausev(Length(sbuf), @sbuf[0]);"
	
	NATIVE_alSourceStopv = @
	"var sbuf: array of TALuint;"
	"var i: Integer;"
	"SetLength(sbuf, X_Sources.Count());"
	"for i := 0 to X_Sources.Count()-1 do"
	"	sbuf[i] := X_Sources.GetIntegers(i);"
	"alSourceStopv(Length(sbuf), @sbuf[0]);"
	
	NATIVE_alSourceRewindv = @
	"var sbuf: array of TALuint;"
	"var i: Integer;"
	"SetLength(sbuf, X_Sources.Count());"
	"for i := 0 to X_Sources.Count()-1 do"
	"	sbuf[i] := X_Sources.GetIntegers(i);"
	"alSourceRewindv(Length(sbuf), @sbuf[0]);"

	NATIVE_alSourceQueueBuffers = @
	"var sbuf: array of TALuint;"
	"var i: Integer;"
	"SetLength(sbuf, X_Buffers.Count());"
	"for i := 0 to X_Buffers.Count()-1 do"
	"	sbuf[i] := X_Buffers.GetIntegers(i);"
	"alSourceQueueBuffers(X_Source, Length(sbuf), @sbuf[0]);"
	
	NATIVE_alSourceUnqueueBuffers = @
	"var sbuf: array of TALuint;"
	"var i: Integer;"
	"SetLength(sbuf, X_Buffers.Count());"
	"alSourceUnqueueBuffers(X_Source, Length(sbuf), @sbuf[0]);"
	"for i := 0 to X_Buffers.Count()-1 do"
	"	X_Buffers.SetIntegers(i, sbuf[i]);"
	
	NATIVE_alGenBuffers = @
	"var arr: array of Integer;"
	"var i: Integer;"
	"SetLength(arr, X_N);"
	"alGenBuffers(X_N, @arr[0]);"
	"for i := 0 to X_N-1 do"
	"	X_Buffers.SetIntegers(i, arr[i]);"
	
	NATIVE_alDeleteBuffers = @
	"var arr: array of Integer;"
	"var i: Integer;"
	"SetLength(arr, X_Buffers.Count());"
	"for i := 0 to X_Buffers.Count()-1 do"
	"	arr[i] := X_Buffers.GetIntegers(i);"
	"alDeleteBuffers(X_Buffers.Count(), @arr[0]);"
	
	NATIVE_alIsBuffer = @
	"RESULT := alIsBuffer(X_Buffer);"
	
	NATIVE_alBufferData8 = @
	"var p: {$IFDEF FPC} PByte {$ELSE} PByte_array {$ENDIF};"
	"var cnt: Integer;"
	"{$IFDEF USE_FIRSTBYTE}"
	"    p := X_Data.FirstByte();"
	"    cnt := X_Data.Count();"
	"    alBufferData(X_Buffer, X_Format, p, cnt, X_Freq);"
	"{$ELSE}"
	"	GetMem(p, X_Data.Count());"
	"	for cnt := 0 to X_Data.Count()-1 do"
	"		p[cnt] := X_Data.GetBytes(cnt);"
	"    cnt := X_Data.Count();"
	"    alBufferData(X_Buffer, X_Format, p, cnt, X_Freq);"
	"{$ENDIF}"
	
	NATIVE_alGetBufferiv = @
	"var vbuf: array of TALint;"
	"var i: Integer;"
	"SetLength(vbuf, X_Data.Count());"
	"alGetBufferiv(X_Buffer, X_Pname, @vbuf[0]);"
	"for i := 0 to High(vbuf) do"
	"	X_Data.SetIntegers(i, vbuf[i]);"
	.

END

*/
*)
