pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Initial commit of fpsound, still doesn't compile

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2132 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-11-14 20:26:08 +00:00
parent b10cdc87f2
commit 2b0994f3cd
5 changed files with 713 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
components/fpsound/fpsound.pas Normal file
View File

@ -0,0 +1,79 @@
{
A generic library for playing sound with modular backends
In the future it might be extended to be able to modify and save sound files in
multiple formats too.
Copyright: Felipe Monteiro de Carvalho 2010-2011
}
unit fpsound;
{$mode objfpc}
interface
uses
Classes, SysUtils;
type
TSoundPlayerKind = (spOpenAL, spMPlayer, spFMod, spExtra1);
TSoundPlayer = class
public
procedure Play;
end;
{ TSoundDocument }
TSoundDocument = class
private
AStream: TStream;
public
constructor Create; virtual;
destructor Destroy; override;
procedure LoadFromFile(AFileName: string);
procedure Play;
procedure SetSoundPlayer(AKind: TSoundPlayerKind);
end;
procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TFPSoundPlayerKind);
implementation
var
GSoundPlayers: array[TSoundPlayerKind] of TSoundPlayer = (nil, nil, nil, nil);
procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TFPSoundPlayerKind);
begin
GSoundPlayers[AKind] := APlayer;
end;
{ TSoundDocument }
constructor TSoundDocument.Create;
begin
end;
destructor TSoundDocument.Destroy;
begin
inherited Destroy;
end;
procedure TSoundDocument.LoadFromFile(AFileName: string);
begin
end;
procedure TSoundDocument.Play;
begin
end;
procedure TSoundDocument.SetSoundPlayer(AKind: TFPSoundPlayerKind);
begin
end;
end.

432
components/fpsound/fpsound_openal.pas Normal file
View File

@ -0,0 +1,432 @@
{
}
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(TObject)
private
public
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;
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;
var
buffer : Cardinal;
source : 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;
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 TOPCAudioPlayer.alStop;
begin
alSourceStop(al_source);
alSourceRewind(al_source);
alSourcei(al_source, AL_BUFFER, 0);
end;
function TOPCAudioPlayer.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 TOPCAudioPlayer.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 TOPCAudioPlayer.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 TOPCAudioPlayer.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 TOPCAudioPlayer.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.

41
components/fpsound/fpsound_pkg.lpk Normal file
View File

@ -0,0 +1,41 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="4">
<Name Value="fpsound_pkg"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="3">
<Item1>
<Filename Value="fpsound_openal.pas"/>
<UnitName Value="fpsound_openal"/>
</Item1>
<Item2>
<Filename Value="fpsound.pas"/>
<UnitName Value="fpsound"/>
</Item2>
<Item3>
<Filename Value="fpsound_wav.pas"/>
<UnitName Value="opcwav"/>
</Item3>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

20
components/fpsound/fpsound_pkg.pas Normal file
View File

@ -0,0 +1,20 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit fpsound_pkg;
interface
uses
fpsound_openal, fpsound, fpsound_wav, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('fpsound_pkg', @Register);
end.

141
components/fpsound/fpsound_wav.pas Normal file
View File

@ -0,0 +1,141 @@
{
}
unit fpsound_wav;
{$mode objfpc}
interface
uses
Classes, SysUtils;
// WAVE UTILS
type
TRiffHeader = packed record
ID : array [0..3] of char;
Size : LongWord;
Format : array [0..3] of char;
end;
TWaveFormat = packed record
ID : array [0..3] of char;
Size : LongWord;
Format : Word;
Channels : Word;
SampleRate : LongWord;
ByteRate : LongWord;
BlockAlign : Word;
BitsPerSample : Word;
end;
TDataChunk = packed record
Id : array [0..3] of char;
Size : LongWord;
end;
{ TWaveReader }
TWaveReader = class(TObject)
private
loaded : Boolean;
chunkdata : TDataChunk;
chunkpos : Int64;
pos : Int64;
eof : Boolean;
public
fmt : TWaveFormat;
fStream : TStream;
function LoadFromStream(AStream: TStream): Boolean;
function ReadBuf(var Buffer; BufferSize: Integer): Integer;
end;
implementation
const
ID_RIFF = 'RIFF';
ID_WAVE = 'WAVE';
ID_fmt = 'fmt ';
ID_data = 'data';
{ TWaveReader }
function TWaveReader.LoadFromStream(AStream:TStream):Boolean;
var
riff : TRiffHeader;
begin
fStream:=AStream;
loaded:=True;
try
Result:=fStream.Read(riff, sizeof(riff))=sizeof(riff);
riff.Size:=LEtoN(riff.Size);
Result:=Result and (riff.ID=ID_RIFF) and (riff.Format=ID_WAVE);
if not Result then Exit;
Result:=fStream.Read(fmt, sizeof(fmt))=sizeof(fmt);
fmt.Size:=LEtoN(fmt.Size);
fmt.Format:=LEtoN(fmt.Format);
fmt.Channels:=LEtoN(fmt.Channels);
fmt.SampleRate:=LEtoN(fmt.SampleRate);
fmt.ByteRate:=LEtoN(fmt.ByteRate);
fmt.BlockAlign:=LEtoN(fmt.BlockAlign);
fmt.BitsPerSample:=LEtoN(fmt.BitsPerSample);
Result:=fmt.ID=ID_fmt;
pos:=-1;
except
Result:=False;
Exit;
end;
end;
function Min(a,b: Integer): Integer;
begin
if a<b then Result:=a
else Result:=b;
end;
function TWaveReader.ReadBuf(var Buffer;BufferSize:Integer):Integer;
var
sz : Integer;
p : PByteArray;
i : Integer;
begin
FillChar(Buffer, BufferSize, 0);
Result:=0;
// all data read
if eof then Exit;
p:=@Buffer;
i:=0;
while (not eof) and (i<bufferSize) do begin
if chunkpos>=chunkdata.Size then begin
if pos<0 then
fstream.Position:=sizeof(TRiffHeader)+Int64(fmt.Size)+sizeof(TDataChunk)
else
fstream.Position:=pos+chunkdata.size+SizeOf(chunkdata);
eof:=pos>=fStream.Size;
if not eof then begin
pos:=fStream.Position;
sz:=fstream.Read(chunkdata, sizeof(chunkdata));
chunkdata.Size:=LEtoN(chunkdata.Size);
if (sz<>sizeof(chunkdata)) or (chunkdata.Id<>ID_data) then
chunkpos:=chunkdata.Size
else
chunkpos:=0;
end;
end else begin
sz:=Min(BufferSize, chunkdata.Size-chunkpos);
fStream.Position:=pos+sizeof(chunkdata)+chunkpos;
sz:=fStream.Read(p[i], sz);
if sz<0 then Exit;
inc(chunkpos, sz);
inc(i, sz);
end;
end;
Result:=i;
end;
end.