{ } unit fpsound_openal; {$mode objfpc} interface uses Classes, SysUtils, openal, fpsound_wav, fpsound; // openal const // Note: if you lower the al_bufcount, then you have to modify the al_polltime also! al_bufcount = 4; al_polltime = 100; var al_device : PALCdevice; al_context : PALCcontext; type TOpenALPlayer = class(TSoundPlayer) private { buffer : Cardinal; sourcepos: array [0..2] of Single=(0.0, 0.0, 0.0); sourcevel: array [0..2] of Single=(0.0, 0.0, 0.0); listenerpos: array [0..2] of Single=(0.0, 0.0, 0.0); listenervel: array [0..2] of Single=(0.0, 0.0, 0.0); listenerori: array [0..5] of Single=(0.0, 0.0, -1.0, 0.0, 1.0, 0.0); Context: PALCcontext; Device: PALCdevice;} // source : TStream; codec_bs : Longword; OPCSoundWasInitialized: Boolean; OPCSoundStreamIsLoaded: Boolean; al_source : ALuint; al_format : Integer; al_buffers : array[0..al_bufcount-1] of ALuint; al_bufsize : Longword; al_readbuf : Pointer; al_rate : Longword; wave : TWaveReader; public //procedure OPCSoundPlayStreamEx(AStream: TStream); procedure OPCSoundOpenALPlay(); procedure OPCSoundOpenALLoadWavFromStream(AStream: TStream); procedure OPCSoundOpenALInitialize(); procedure OPCSoundOpenALFinalize(); procedure alStop; function alProcess: Boolean; end; implementation (*type TWAVHeader = record RIFFHeader: array [1..4] of AnsiChar; FileSize: longint; WAVEHeader: array [1..4] of AnsiChar; FormatHeader: array [1..4] of AnsiChar; FormatHeaderSize: longint; FormatCode: Word; ChannelNumber: Word; SampleRate: longint; BytesPerSecond: longint; BytesPerSample: Word; BitsPerSample: Word; end; function LoadWavStream(Stream: TStream; var format: integer; var data: Pointer; var size: LongInt; var freq: LongInt; var loop: LongInt): Boolean; var WavHeader: TWavHeader; readname: pansichar; name: ansistring; readint: longint; begin Result:=False; size:=0; data:=nil; //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... getmem(readname,4); //only alloc memory once, thanks to zy. //loop to rest of wave file data chunks repeat //read chunk name 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+8; //fix for 8bit??? //Read the actual wave data getmem(data,size); stream.Read(Data^, size); //Decode wave data if needed if WavHeader.FormatCode=$0011 then begin //TODO: add code to decompress IMA ADPCM data end; if WavHeader.FormatCode=$0055 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; freemem(readname); loop:= 0; end; procedure alutLoadWAVFile(fname: string; var format: Integer; var data: Pointer; var size: LongInt; var freq: LongInt; var loop: LongInt); var Stream : TFileStream; begin Stream:=TFileStream.Create(fname,$0000); LoadWavStream(Stream, format, data, size, freq, loop); Stream.Free; end; procedure OPCSoundPlayStreamEx(AStream: TStream); var format: Integer; size: LongInt; freq: LongInt; loop: LongInt; data: Pointer; begin AlSourceStop(source); AlGenBuffers(1, @buffer); loop:=0; LoadWavStream(AStream, format, data, size, freq, loop); AlBufferData(buffer, format, data, size, freq); if data<>nil then freemem(data); AlGenSources(1, @source); AlSourcei(source, AL_BUFFER, buffer); AlSourcef(source, AL_PITCH, 1.0); AlSourcef(source, AL_GAIN, 1.0); AlSourcefv(source, AL_POSITION, @sourcepos); AlSourcefv(source, AL_VELOCITY, @sourcevel); // Under windows, AL_LOOPING = AL_TRUE breaks queueing, no idea why // AlSourcei(source, AL_LOOPING, AL_TRUE); AlListenerfv(AL_POSITION, @listenerpos); AlListenerfv(AL_VELOCITY, @listenervel); AlListenerfv(AL_ORIENTATION, @listenerori); AlSourcePlay(source); end; {$DEFINE OPC_SOUND_OPENAL_THREAD} {$ifdef WINDOWS}uses Windows; {$endif} type TOpenALThread = class(TThread) private public FAOwner: TStream; constructor Create(aOwner: TStream); destructor Destroy; override; procedure Execute; override; procedure DoOpenALPlay; end; var TheLastThread: TOpenALThread; procedure OPCSoundInitialize(); begin end; procedure ResetOpenALThread; begin if (TheLastThread <> nil) and (not TheLastThread.Terminated) then begin try {$IFDEF MSWINDOWS} TerminateThread(TheLastThread.Handle, 0); {$ELSE} TheLastThread.Terminate; {$ENDIF} except end; end; end; procedure OPCSoundLoadWavFromStream(AStream: TStream); begin {$IFDEF OPC_SOUND_OPENAL_THREAD} ResetOpenALThread; TheLastThread := TOpenALThread.Create(AStream); {$ELSE} OPCSoundPlayStreamEx(AStream); {$ENDIF} end; procedure OPCSoundPlay(); begin {$IFDEF OPC_SOUND_OPENAL_THREAD} {$ELSE} OPCAudioPlayer.OPCSoundOpenALInitialize(); OPCAudioPlayer.OPCSoundOpenALPlay(); OPCAudioPlayer.OPCSoundOpenALFinalize(); {$ENDIF} end; procedure OPCSoundFinalize(); begin {$IFDEF OPC_SOUND_OPENAL_THREAD} ResetOpenALThread; {$ELSE} OPCAudioPlayer.OPCSoundOpenALFinalize(); {$ENDIF} end; procedure OPCSoundPlayStream(AStream: TStream); begin OPCSoundLoadWavFromStream(AStream); end; constructor TOpenALThread.Create(aOwner: TStream); begin inherited Create(False); FAOwner := aOwner; FreeOnTerminate := True; end; destructor TOpenALThread.Destroy; begin inherited Destroy; end; procedure TOpenALThread.Execute; begin Synchronize(@DoOpenALPlay); end; procedure TOpenALThread.DoOpenALPlay; begin OPCSoundPlayStreamEx(FAOwner); end;*) /// procedure TOpenALPlayer.alStop; begin alSourceStop(al_source); alSourceRewind(al_source); alSourcei(al_source, AL_BUFFER, 0); end; function TOpenALPlayer.alProcess: Boolean; var processed : ALint; buffer : ALuint; sz : Integer; begin alGetSourcei(al_source, AL_BUFFERS_PROCESSED, processed); while (processed > 0) and (processed <= al_bufcount) do begin alSourceUnqueueBuffers(al_source, 1, @buffer); sz:=wave.ReadBuf(al_readbuf^, al_bufsize); if sz <= 0 then begin Exit(False); end; alBufferData(buffer, al_format, al_readbuf, sz, al_rate); alSourceQueueBuffers(al_source, 1, @buffer); Dec(processed); end; Result := True; end; procedure TOpenALPlayer.OPCSoundOpenALPlay(); var i: Integer; queued : Integer; done : Boolean; begin if not OPCSoundStreamIsLoaded then Exit; alSourceStop(al_source); alSourceRewind(al_source); alSourcei(al_source, AL_BUFFER, 0); for i := 0 to al_bufcount - 1 do begin if wave.ReadBuf(al_readbuf^, al_bufsize) = 0 then Break; alBufferData(al_buffers[i], al_format, al_readbuf, al_bufsize, al_rate); alSourceQueueBuffers(al_source, 1, @al_buffers[i]); end; // Under windows, AL_LOOPING = AL_TRUE breaks queueing, no idea why alSourcei(al_source, AL_LOOPING, AL_FALSE); alSourcePlay(al_source); done:=False; queued:=0; repeat if alProcess then begin alGetSourcei(al_source, AL_BUFFERS_QUEUED, queued); done:=queued=0; end; Sleep(al_polltime); until done; end; procedure TOpenALPlayer.OPCSoundOpenALLoadWavFromStream(AStream: TStream); var Filename: String; queued : Integer; done : Boolean; begin if AStream = nil then begin OPCSoundStreamIsLoaded := False; Exit; end else OPCSoundStreamIsLoaded := True; FreeAndNil(source); // define codec source := AStream; // inittialize codec wave:=TWaveReader.Create; if not wave.LoadFromStream(source) then raise Exception.Create('[OPCSoundLoadWavFromStream] unable to read WAVE format'); if wave.fmt.Format<>1 then raise Exception.Create('[OPCSoundLoadWavFromStream] WAVE files with compression aren''t supported'); if wave.fmt.Channels=2 then begin if wave.fmt.BitsPerSample=8 then al_format:=AL_FORMAT_STEREO8 else al_format:=AL_FORMAT_STEREO16 end else begin if wave.fmt.BitsPerSample=8 then al_format:=AL_FORMAT_MONO8 else al_format:=AL_FORMAT_MONO16 end; codec_bs:=2*wave.fmt.Channels; //al_bufsize := 20000 - (20000 mod codec_bs); al_bufsize := 20000 - (20000 mod codec_bs); al_rate:=wave.fmt.SampleRate; // WriteLn('Blocksize : ', codec_bs); // WriteLn('Rate : ', wave.fmt.SampleRate); // WriteLn('Channels : ', wave.fmt.Channels); // WriteLn('OpenAL Buffers : ', al_bufcount); // WriteLn('OpenAL Buffer Size : ', al_bufsize); alProcess(); end; procedure TOpenALPlayer.OPCSoundOpenALInitialize(); begin OPCSoundWasInitialized := True; alDistanceModel(AL_INVERSE_DISTANCE_CLAMPED); alGenSources(1, @al_source); alGenBuffers(al_bufcount, @al_buffers); GetMem(al_readbuf, al_bufsize); end; procedure TOpenALPlayer.OPCSoundOpenALFinalize(); begin // finalize openal alDeleteSources(1, @al_source); alDeleteBuffers(al_bufcount, @al_buffers); FreeMem(al_readbuf); // wave.fStream := nil; // source := nil; // finalize codec wave.Free; // close file // source.Free; end; finalization //if OPCSoundWasInitialized then OPCSoundOpenALFinalize(); end.