openal.pas

Newton Game Dynamic 1.52 Delphi下基于GLScene的OpenGL游戏开发控件。功能非常强大和易于使用。 Advanced physics engine for re

  procedure alutExit;

  procedure alutLoadWAVFile(fname: string; var format: TALenum; var data: TALvoid; var size: TALsizei; var freq: TALsizei; var loop: TALint);
  procedure alutLoadWAVMemory(memory: PALbyte; var format: TALenum; var data: TALvoid; var size: TALsizei; var freq: TALsizei; var loop: TALint);
  procedure alutUnloadWAV(format: TALenum; data: TALvoid; size: TALsizei; freq: TALsizei);
{$ENDIF}

var
  LibHandle          : THandle = 0;
{$IFDEF ALUT}
  AlutLibHandle      : THandle = 0;
{$ENDIF}
type
  HMODULE = THandle;

{$IFDEF ALUT}
function InitOpenAL(LibName: String = callibname;AlutLibName: String = calutlibname): Boolean;
{$ELSE}
function InitOpenAL(LibName: String = callibname): Boolean;
{$ENDIF}
procedure ReadOpenALExtensions;

implementation

uses classes;

type
  //WAV file header
  TWAVHeader = record
    RIFFHeader: array [1..4] of Char;
    FileSize: Integer;
    WAVEHeader: array [1..4] of Char;
    FormatHeader: array [1..4] of Char;
    FormatHeaderSize: Integer;
    FormatCode: Word;
    ChannelNumber: Word;
    SampleRate: Integer;
    BytesPerSecond: Integer;
    BytesPerSample: Word;
    BitsPerSample: Word;
  end;

const
  WAV_STANDARD  = $0001;
  WAV_IMA_ADPCM = $0011;
  WAV_MP3       = $0055;

{$IFDEF FPC}
{$IFNDEF Win32}
// Added by bero
const
  RTLD_LAZY         = $001;
  RTLD_NOW          = $002;
  RTLD_BINDING_MASK = $003;
  LibraryLib        = {$IFDEF Linux}'dl'{$ELSE}'c'{$ENDIF};

function LoadLibraryEx(Name : PChar; Flags : LongInt) : Pointer; cdecl; external LibraryLib name 'dlopen';
function GetProcAddressEx(Lib : Pointer; Name : PChar) : Pointer; cdecl; external LibraryLib name 'dlsym';
function FreeLibraryEx(Lib : Pointer) : LongInt; cdecl; external LibraryLib name 'dlclose';

function LoadLibrary(Name : PChar) : THandle;
begin
 Result := THandle(LoadLibraryEx(Name, RTLD_LAZY));
end;

function GetProcAddress(LibHandle : THandle; ProcName : PChar) : Pointer;
begin
 Result := GetProcAddressEx(Pointer(LibHandle), ProcName);
end;

function FreeLibrary(LibHandle : THandle) : Boolean;
begin
 if LibHandle = 0 then
   Result := False
  else
   Result := FreeLibraryEx(Pointer(LibHandle)) = 0;
end;
{$ENDIF}
{$ENDIF}

//ProcName can be case sensitive !!!
function alProcedure(ProcName : PChar) : Pointer;
begin
Result := NIL;
if Addr(alGetProcAddress) <> NIL then
 Result := alGetProcAddress(ProcName);
if result <> NIL then
 exit;
Result := GetProcAddress(LibHandle, ProcName);
end;

{$IFDEF ALUT}
function InitOpenAL(LibName, AlutLibName: String): Boolean;
{$ELSE}
function InitOpenAL(LibName: String): Boolean;
{$ENDIF}
begin
  Result       := False;
  if LibHandle<>0 then FreeLibrary(LibHandle);
  LibHandle    := LoadLibrary(PChar(LibName));
{$IFDEF ALUT}
  if AlutLibHandle<>0 then FreeLibrary(AlutLibHandle);
  AlutLibHandle    := LoadLibrary(PChar(AlutLibName));

  if (AlutLibHandle <> 0) then
  begin
    alutInit:= GetProcAddress(AlutLibHandle, 'alutInit');
    alutExit:= GetProcAddress(AlutLibHandle, 'alutExit');
    alutLoadWAVFile:= GetProcAddress(AlutLibHandle, 'alutLoadWAVFile');
    alutLoadWAVMemory:= GetProcAddress(AlutLibHandle, 'alutLoadWAVMemory');
    alutUnloadWAV:= GetProcAddress(AlutLibHandle, 'alutUnloadWAV');
  end;
{$ENDIF}

  alGetProcAddress := GetProcAddress(LibHandle, 'alGetProcAddress');

  if (LibHandle <> 0) then
  begin

    alEnable:= alProcedure('alEnable');
    alDisable:= alProcedure('alDisable');
    alIsEnabled:= alProcedure('alIsEnabled');
    alHint:= alProcedure('alHint');
    alGetBooleanv:= alProcedure('alGetBooleanv');
    alGetIntegerv:= alProcedure('alGetIntegerv');
    alGetFloatv:= alProcedure('alGetFloatv');
    alGetDoublev:= alProcedure('alGetDoublev');
    alGetString:= alProcedure('alGetString');
    alGetBoolean:= alProcedure('alGetBoolean');
    alGetInteger:= alProcedure('alGetInteger');
    alGetFloat:= alProcedure('alGetFloat');
    alGetDouble:= alProcedure('alGetDouble');
    alGetError:= alProcedure('alGetError');
    alIsExtensionPresent:= alProcedure('alIsExtensionPresent');
    alGetEnumValue:= alProcedure('alGetEnumValue');
    alListeneri:= alProcedure('alListeneri');
    alListenerf:= alProcedure('alListenerf');
    alListener3f:= alProcedure('alListener3f');
    alListenerfv:= alProcedure('alListenerfv');
    alGetListeneriv:= alProcedure('alGetListeneriv');
    alGetListenerfv:= alProcedure('alGetListenerfv');
    alGenSources:= alProcedure('alGenSources');
    alDeleteSources:= alProcedure('alDeleteSources');
    alIsSource:= alProcedure('alIsSource');
    alSourcei:= alProcedure('alSourcei');
    alSourcef:= alProcedure('alSourcef');
    alSource3f:= alProcedure('alSource3f');
    alSourcefv:= alProcedure('alSourcefv');
    alGetSourcei:= alProcedure('alGetSourcei');
    alGetSourcef:= alProcedure('alGetSourcef');
    alGetSource3f:= alProcedure('alGetSource3f');
    alGetSourcefv:= alProcedure('alGetSourcefv');
    alSourcePlay:= alProcedure('alSourcePlay');
    alSourcePause:=alProcedure('alSourcePause');
    alSourceStop:= alProcedure('alSourceStop');
    alSourceRewind:= alProcedure('alSourceRewind');
    alSourcePlayv:= alProcedure('alSourcePlayv');
    alSourceStopv:= alProcedure('alSourceStopv');
    alSourceRewindv:= alProcedure('alSourceRewindv');
    alSourcePausev:= alProcedure('alSourcePausev');
    alGenBuffers:= alProcedure('alGenBuffers');
    alDeleteBuffers:= alProcedure('alDeleteBuffers');
    alIsBuffer:= alProcedure('alIsBuffer');
    alBufferData:= alProcedure('alBufferData');
    alGetBufferi:= alProcedure('alGetBufferi');
    alGetBufferf:= alProcedure('alGetBufferf');
    alSourceQueueBuffers:= alProcedure('alSourceQueueBuffers');
    alSourceUnqueueBuffers:= alProcedure('alSourceUnQueueBuffers');
    alDistanceModel:= alProcedure('alDopplerModel');
    alDopplerFactor:= alProcedure('alDopplerFactor');
    alDopplerVelocity:= alProcedure('alDopplerVelocity');

    alcCreateContext:= alProcedure('alcCreateContext');
    alcMakeContextCurrent:= alProcedure('alcMakeContextCurrent');
    alcProcessContext:= alProcedure('alcProcessContext');
    alcSuspendContext:= alProcedure('alcSuspendContext');
    alcDestroyContext:= alProcedure('alcDestroyContext');
    alcGetError:= alProcedure('alcGetError');
    alcGetCurrentContext:= alProcedure('alcGetCurrentContext');
    alcOpenDevice:= alProcedure('alcOpenDevice');
    alcCloseDevice:= alProcedure('alcCloseDevice');
    alcIsExtensionPresent:= alProcedure('alcIsExtensionPresent');
    alcGetProcAddress:= alProcedure('alcGetProcAddress');
    alcGetEnumValue:= alProcedure('alcGetEnumValue');
    alcGetContextsDevice:= alProcedure('alcGetContextsDevice');
    alcGetString:= alProcedure('alcGetString');
    alcGetIntegerv:= alProcedure('alcGetIntegerv');

    Result:=True;
  end;
end;

procedure ReadOpenALExtensions;
begin
  if (LibHandle <> 0) then
    begin
      EAXSet := alProcedure('EAXSet');
      EAXGet := alProcedure('EAXGet');
    end;
end;

//Internal Alut replacement procedures

procedure alutInit(argc: PALint; argv: array of PALbyte);
var
  Context: PALCcontext;
  Device: PALCdevice;
begin
  //Open device
  Device := alcOpenDevice(nil); // this is supposed to select the "preferred device"
  //Create context(s)
  Context := alcCreateContext(Device, nil);
  //Set active context
  alcMakeContextCurrent(Context);
end;

procedure alutExit;
var
  Context: PALCcontext;
  Device: PALCdevice;
begin
  //Get active context
  Context := alcGetCurrentContext;
  //Get device for active context
  Device := alcGetContextsDevice(Context);
  //Release context(s)
  alcDestroyContext(Context);
  //Close device
  alcCloseDevice(Device);
end;

function LoadWavStream(Stream: Tstream; var format: TALenum; var data: TALvoid; var size: TALsizei; var freq: TALsizei; var loop: TALint): Boolean;
var
  WavHeader: TWavHeader;
  readname: pchar;
  name: string;
  readint: integer;
begin
    Result:=False;

    //Read wav header
    stream.Read(WavHeader, sizeof(TWavHeader));

    //Determine SampleRate
    freq:=WavHeader.SampleRate;

    //Detemine waveformat
    if WavHeader.ChannelNumber = 1 then
    case WavHeader.BitsPerSample of
    8: format := AL_FORMAT_MONO8;
    16: format := AL_FORMAT_MONO16;
    end;

    if WavHeader.ChannelNumber = 2 then
    case WavHeader.BitsPerSample of
    8: format := AL_FORMAT_STEREO8;
    16: format := AL_FORMAT_STEREO16;
    end;

    //go to end of wavheader
    stream.seek((8-44)+12+4+WavHeader.FormatHeaderSize+4,soFromCurrent); //hmm crappy...
    //loop to rest of wave file data chunks
    repeat
      //read chunk name
      getmem(readname,4);
      stream.Read(readname^, 4);
      name:=readname[0]+readname[1]+readname[2]+readname[3];
      if name='data' then
      begin
        //Get the size of the wave data
        stream.Read(readint,4);
        size:=readint;
        if WavHeader.BitsPerSample = 8 then size:=size+1; //fix for 8bit???
        //Read the actual wave data
        getmem(data,size);
        stream.Read(Data^, size);

        //Decode wave data if needed
        if WavHeader.FormatCode=WAV_IMA_ADPCM then
        begin
          //TODO: add code to decompress IMA ADPCM data
        end;
        if WavHeader.FormatCode=WAV_MP3 then
        begin
          //TODO: add code to decompress MP3 data
        end;
        Result:=True;
      end
      else
      begin
        //Skip unknown chunk(s)
        stream.Read(readint,4);
        stream.Position:=stream.Position+readint;
      end;
    until stream.Position>=stream.size;

end;

procedure alutLoadWAVFile(fname: string; var format: TALenum; var data: TALvoid; var size: TALsizei; var freq: TALsizei; var loop: TALint);
var
  Stream : TFileStream;
begin
  Stream:=TFileStream.Create(fname,$0000);
  LoadWavStream(Stream, format, data, size, freq, loop);
  Stream.Free;
end;

procedure alutLoadWAVMemory(memory: PALbyte; var format: TALenum; var data: TALvoid; var size: TALsizei; var freq: TALsizei; var loop: TALint);
var Stream: TMemoryStream;
begin
  Stream:=TMemoryStream.Create;
  Stream.Write(memory,sizeof(memory^));
  LoadWavStream(Stream, format, data, size, freq, loop);
  Stream.Free;
end;

procedure alutUnloadWAV(format: TALenum; data: TALvoid; size: TALsizei; freq: TALsizei);
begin
  //Clean up
  if data<>nil then freemem(data);
end;

end.