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

fpsound: Large work to advance the wave reader

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2259 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2012-01-20 16:15:10 +00:00
parent 00e2a4261c
commit 880197feae
12 changed files with 421 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
components/fpsound/example/mainform.lfm Normal file
View File

@ -0,0 +1,33 @@
object Form1: TForm1
Left = 323
Height = 240
Top = 171
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '0.9.31'
object btnOpenPlayAndClose: TButton
Left = 12
Height = 25
Top = 48
Width = 292
Caption = 'Open, Play and Close'
OnClick = btnOpenPlayAndCloseClick
TabOrder = 0
end
object pathEdit: TFileNameEdit
Left = 12
Height = 25
Top = 13
Width = 268
FileName = '/home/felipe/Programas/lazarus-ccr/components/fpsound/testsounds/test.wav'
DialogOptions = []
FilterIndex = 0
HideDirectories = False
ButtonWidth = 23
NumGlyphs = 0
MaxLength = 0
TabOrder = 1
end
end

46
components/fpsound/example/mainform.pas Normal file
View File

@ -0,0 +1,46 @@
unit mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
EditBtn;
type
{ TForm1 }
TForm1 = class(TForm)
btnOpenPlayAndClose: TButton;
pathEdit: TFileNameEdit;
procedure btnOpenPlayAndCloseClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
uses fpsound, fpsound_wav;
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnOpenPlayAndCloseClick(Sender: TObject);
var
lSoundDoc: TSoundDocument;
begin
lSoundDoc := TSoundDocument.Create;
lSoundDoc.LoadFromFile(pathEdit.FileName);
lSoundDoc.Free;
end;
end.

BIN
components/fpsound/example/soundtest.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

90
components/fpsound/example/soundtest.lpi Normal file
View File

@ -0,0 +1,90 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="fpsound_pkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="soundtest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="soundtest"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="soundtest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/fpsound/example/soundtest.lpr Normal file
View File

@ -0,0 +1,21 @@
program soundtest;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, mainform
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/fpsound/example/soundtest.res Normal file
View File

Binary file not shown.

113
components/fpsound/fpsound.pas
View File

@ -18,31 +18,60 @@ uses
type type
TSoundDocument = class; TSoundDocument = class;
TSoundFormat = (sfWav, sfMP3); TSoundFormat = (sfWav, sfMP3, sfOGG, sfMID, sfAMR, sf3GP, sfMP4);
{ TSoundReader }
TSoundReader = class TSoundReader = class
public public
constructor Create; virtual;
procedure ReadFromStream(AStream: TStream; ADest: TSoundDocument); virtual; abstract; procedure ReadFromStream(AStream: TStream; ADest: TSoundDocument); virtual; abstract;
end; end;
TSoundPlayerKind = (spOpenAL, spMPlayer, spFMod, spExtra1); TSoundPlayerKind = (spOpenAL, spMPlayer, spFMod, spExtra1, spExtra2);
{ TSoundPlayer }
TSoundPlayer = class TSoundPlayer = class
public public
constructor Create; virtual;
procedure Play(ASound: TSoundDocument); virtual; abstract; procedure Play(ASound: TSoundDocument); virtual; abstract;
end; end;
// Sound data representation
TSoundElement = class
end;
// A Key element sets the basic information of the music for the following samples,
// such as sample rate. It has no sample data in itself
TSoundKeyElement = class(TSoundElement)
SampleRate: Cardinal; // example values: 8000, 44100, etc.
Channels: Byte; // Number of channels
end;
TSoundSample = class(TSoundElement)
ChannelValues: array of Integer;
end;
{ TSoundDocument } { TSoundDocument }
TSoundDocument = class TSoundDocument = class
private private
AStream: TStream; AStream: TStream;
FPlayer: TSoundPlayer; FPlayer: TSoundPlayer;
FSoundData: TFPList; // of TSoundElement
public public
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
// Document read/save methods
procedure LoadFromFile(AFileName: string); procedure LoadFromFile(AFileName: string);
procedure LoadFromFile(AFileName: string; AFormat: TSoundFormat); procedure LoadFromFile(AFileName: string; AFormat: TSoundFormat);
class function GuessFormatFromSoundFile(AFileName: string): TSoundFormat;
// Document edition methods
procedure Clear;
procedure AddSoundElement(const AElement: TSoundElement);
// Document playing methods
procedure Play; procedure Play;
procedure Pause; procedure Pause;
procedure Seek(ANewPos: Double); procedure Seek(ANewPos: Double);
@ -57,9 +86,9 @@ function GetSoundReader(AFormat: TSoundFormat): TSoundReader;
implementation implementation
var var
GSoundPlayers: array[TSoundPlayerKind] of TSoundPlayer = (nil, nil, nil, nil); GSoundPlayers: array[TSoundPlayerKind] of TSoundPlayer = (nil, nil, nil, nil, nil);
GSoundReader: array[TSoundFormat] of TSoundReader = (nil, nil); GSoundReaders: array[TSoundFormat] of TSoundReader = (nil, nil, nil, nil, nil, nil, nil);
// GSoundWriter: array[TSoundFormat] of TSoundWriter = (nil, nil); // GSoundWriter: array[TSoundFormat] of TSoundWriter = (nil, nil, nil, nil, nil, nil, nil);
procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TSoundPlayerKind); procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TSoundPlayerKind);
begin begin
@ -68,44 +97,94 @@ end;
procedure RegisterSoundReader(AReader: TSoundReader; AFormat: TSoundFormat); procedure RegisterSoundReader(AReader: TSoundReader; AFormat: TSoundFormat);
begin begin
GSoundReader[AFormat] := AReader; GSoundReaders[AFormat] := AReader;
end; end;
function GetSoundPlayer(AKind: TSoundPlayerKind): TSoundPlayer; function GetSoundPlayer(AKind: TSoundPlayerKind): TSoundPlayer;
begin begin
Result := GSoundPlayers[AKind];
end; end;
function GetSoundReader(AFormat: TSoundFormat): TSoundReader; function GetSoundReader(AFormat: TSoundFormat): TSoundReader;
begin begin
Result := GSoundReaders[AFormat];
end;
{ TSoundPlayer }
constructor TSoundPlayer.Create;
begin
inherited Create;
end;
{ TSoundReader }
constructor TSoundReader.Create;
begin
inherited Create;
end; end;
{ TSoundDocument } { TSoundDocument }
constructor TSoundDocument.Create; constructor TSoundDocument.Create;
begin begin
inherited Create;
FSoundData := TFPList.Create;
end; end;
destructor TSoundDocument.Destroy; destructor TSoundDocument.Destroy;
begin begin
FSoundData.Free;
inherited Destroy; inherited Destroy;
end; end;
procedure TSoundDocument.LoadFromFile(AFileName: string); procedure TSoundDocument.LoadFromFile(AFileName: string);
var var
lExt: String; lFormat: TSoundFormat;
begin begin
lExt := ExtractFileExt(AFileName); lFormat := GuessFormatFromSoundFile(AFileName);
if CompareText(lExt, 'wav') = 0 then LoadFromFile(AFileName, sfWav) LoadFromFile(AFileName, lFormat);
else
raise Exception.Create(Format('[TSoundDocument.LoadFromFile] Unknown extension: %s', [lExt]));
end; end;
procedure TSoundDocument.LoadFromFile(AFileName: string; AFormat: TSoundFormat); procedure TSoundDocument.LoadFromFile(AFileName: string; AFormat: TSoundFormat);
var
lReader: TSoundReader;
lStream: TFileStream;
begin begin
lReader := GetSoundReader(AFormat);
lStream := TFileStream.Create(AFileName, fmOpenRead);
try
Clear();
lReader.ReadFromStream(lStream, Self);
finally
lStream.Free;
end;
end;
class function TSoundDocument.GuessFormatFromSoundFile(AFileName: string): TSoundFormat;
var
lExt: String;
begin
Result := sfWav;
lExt := ExtractFileExt(AFileName);
if CompareText(lExt, 'wav') = 0 then Result := sfWav;
//raise Exception.Create(Format('[TSoundDocument.LoadFromFile] Unknown extension: %s', [lExt]));
end;
procedure TSoundDocument.Clear;
var
i: Integer;
begin
for i := 0 to FSoundData.Count - 1 do
TSoundElement(FSoundData.Items[i]).Free;
FSoundData.Clear;
end;
procedure TSoundDocument.AddSoundElement(const AElement: TSoundElement);
begin
FSoundData.Add(AElement);
end; end;
procedure TSoundDocument.Play; procedure TSoundDocument.Play;
@ -128,5 +207,15 @@ begin
end; end;
var
lReaderIndex: TSoundFormat;
lPlayerIndex: TSoundPlayerKind;
finalization
for lReaderIndex := Low(TSoundFormat) to High(TSoundFormat) do
if GSoundReaders[lReaderIndex] <> nil then GSoundReaders[lReaderIndex].Free;
for lPlayerIndex := Low(TSoundPlayerKind) to High(TSoundPlayerKind) do
if GSoundPlayers[lPlayerIndex] <> nil then GSoundPlayers[lPlayerIndex].Free;
end. end.

6
components/fpsound/fpsound_openal.pas
View File

@ -302,7 +302,7 @@ begin
while (processed > 0) and (processed <= al_bufcount) do while (processed > 0) and (processed <= al_bufcount) do
begin begin
alSourceUnqueueBuffers(al_source, 1, @buffer); alSourceUnqueueBuffers(al_source, 1, @buffer);
sz:=wave.ReadBuf(al_readbuf^, al_bufsize); //f/ sz:=wave.ReadBuf(al_readbuf^, al_bufsize);
if sz <= 0 then if sz <= 0 then
begin begin
Exit(False); Exit(False);
@ -328,7 +328,7 @@ begin
for i := 0 to al_bufcount - 1 do for i := 0 to al_bufcount - 1 do
begin begin
if wave.ReadBuf(al_readbuf^, al_bufsize) = 0 then //f/ if wave.ReadBuf(al_readbuf^, al_bufsize) = 0 then
Break; Break;
alBufferData(al_buffers[i], al_format, al_readbuf, al_bufsize, al_rate); alBufferData(al_buffers[i], al_format, al_readbuf, al_bufsize, al_rate);
@ -370,7 +370,7 @@ begin
// inittialize codec // inittialize codec
wave:=TWaveReader.Create; wave:=TWaveReader.Create;
if not wave.LoadFromStream(source) then //f/ if not wave.LoadFromStream(source) then
raise Exception.Create('[OPCSoundLoadWavFromStream] unable to read WAVE format'); raise Exception.Create('[OPCSoundLoadWavFromStream] unable to read WAVE format');
if wave.fmt.Format<>1 then if wave.fmt.Format<>1 then

180
components/fpsound/fpsound_wav.pas
View File

@ -1,4 +1,16 @@
{ {
WAV format reader for the fpSound library
License: The same modified LGPL as the LCL
Authors:
JiXian Yang
Felipe Monteiro de Carvalho
Canonical WAV file description here:
https://ccrma.stanford.edu/courses/422/projects/WaveFormat/
} }
unit fpsound_wav; unit fpsound_wav;
@ -7,95 +19,155 @@ unit fpsound_wav;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, Math,
fpsound;
// WAVE UTILS // WAVE UTILS
type type
// WAV is formed by the following structures in this order
// All items are in little endian order, except the char arrays
// Items might be in big endian order if the RIFF identifier is RIFX
TRiffHeader = packed record TRiffHeader = packed record
ID : array [0..3] of char; ID : array [0..3] of char; // should be RIFF
Size : LongWord; Size : LongWord; // 4 + (8 + SubChunk1Size) + (8 + SubChunk2Size). The entire file size excluding TRiffHeader.ID and .Size
Format : array [0..3] of char; Format : array [0..3] of char; // should be WAVE
end; end;
TWaveFormat = packed record TWaveFormat = packed record
ID : array [0..3] of char; ID : array [0..3] of char; // Should be "fmt "
Size : LongWord; Size : LongWord; // SubChunk1Size
Format : Word; Format : Word; // PCM = 1 (Linear quantization), values > 1 indicate a compressed format
Channels : Word; Channels : Word; // Mono = 1, Stereo = 2, etc
SampleRate : LongWord; SampleRate : LongWord; // 8000, 44100, etc
ByteRate : LongWord; ByteRate : LongWord; // = SampleRate * NumChannels * BitsPerSample/8
BlockAlign : Word; BlockAlign : Word; // = NumChannels * BitsPerSample/8
BitsPerSample : Word; BitsPerSample : Word; // examples: 8 bits, 16 bits, etc
end; end;
// If the format is not PCM then there will also be:
// TWaveFormatExtension = packed record
// ExtraParamSize: Word;
// ExtraParams...
// end;
TDataChunk = packed record TDataChunk = packed record
Id : array [0..3] of char; Id : array [0..3] of char; // should be "data"
Size : LongWord; Size : LongWord; // == NumSamples * NumChannels * BitsPerSample/8
end; end;
// And after this header the actual data comes, which is an array of samples
{ TWaveReader } { TWaveReader }
TWaveReader = class(TObject) TWaveReader = class(TSoundReader)
private
loaded : Boolean;
chunkdata : TDataChunk;
chunkpos : Int64;
pos : Int64;
eof : Boolean;
public public
fmt : TWaveFormat; fmt: TWaveFormat;
fStream : TStream; datachunk: TDataChunk;
function LoadFromStream(AStream: TStream): Boolean; NumSamples: Integer;
function ReadBuf(var Buffer; BufferSize: Integer): Integer; procedure ReadFromStream(AStream: TStream; ADest: TSoundDocument); override;
procedure ReadHeaders(AStream: TStream; ADest: TSoundDocument);
procedure ReadAllSamples(AStream: TStream; ADest: TSoundDocument);
procedure ReadSample(AStream: TStream; ADest: TSoundDocument);
procedure ReadChannelData(AStream: TStream; out AValue: Integer);
//function ReadBuf(var Buffer; BufferSize: Integer): Integer;
end; end;
implementation implementation
const const
ID_RIFF = 'RIFF'; ID_RIFF = 'RIFF';
ID_WAVE = 'WAVE'; ID_WAVE ='WAVE';
ID_fmt = 'fmt '; fD_fmt = 'fmt ';
ID_data = 'data'; ID_data = 'data';
{ TWaveReader } { TWaveReader }
function TWaveReader.LoadFromStream(AStream:TStream):Boolean; procedure TWaveReader.ReadFromStream(AStream:TStream; ADest: TSoundDocument);
begin
ReadHeaders(AStream, ADest);
ReadAllSamples(AStream, ADest);
end;
procedure TWaveReader.ReadHeaders(AStream: TStream; ADest: TSoundDocument);
var var
riff : TRiffHeader; riff : TRiffHeader;
lKeyElement: TSoundKeyElement;
begin begin
fStream:=AStream; AStream.Read(riff, sizeof(riff));//=sizeof(riff);
loaded:=True; riff.Size:=LEtoN(riff.Size);
try //Result:=Result and (riff.ID=ID_RIFF) and (riff.Format=ID_WAVE);
Result:=fStream.Read(riff, sizeof(riff))=sizeof(riff); //if not Result then Exit;
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); AStream.Read(fmt, sizeof(fmt));//=sizeof(fmt);
fmt.Size:=LEtoN(fmt.Size); fmt.Size:=LEtoN(fmt.Size);
fmt.Format:=LEtoN(fmt.Format); fmt.Format:=LEtoN(fmt.Format);
fmt.Channels:=LEtoN(fmt.Channels); fmt.Channels:=LEtoN(fmt.Channels);
fmt.SampleRate:=LEtoN(fmt.SampleRate); fmt.SampleRate:=LEtoN(fmt.SampleRate);
fmt.ByteRate:=LEtoN(fmt.ByteRate); fmt.ByteRate:=LEtoN(fmt.ByteRate);
fmt.BlockAlign:=LEtoN(fmt.BlockAlign); fmt.BlockAlign:=LEtoN(fmt.BlockAlign);
fmt.BitsPerSample:=LEtoN(fmt.BitsPerSample); fmt.BitsPerSample:=LEtoN(fmt.BitsPerSample);
Result:=fmt.ID=ID_fmt; AStream.Read(datachunk, sizeof(datachunk));
pos:=-1; datachunk.Size := LEtoN(datachunk.Size);
except
Result:=False; NumSamples := fmt.BlockAlign div datachunk.size;
Exit;
//Result:=fmt.ID=ID_fmt;
// pos:=-1;
// Store the data in the document
lKeyElement := TSoundKeyElement.Create;
lKeyElement.SampleRate := fmt.SampleRate;
lKeyElement.Channels := fmt.Channels;
ADest.AddSoundElement(lKeyElement);
end;
procedure TWaveReader.ReadAllSamples(AStream: TStream; ADest: TSoundDocument);
var
i: Integer;
begin
for i := 0 to NumSamples - 1 do
ReadSample(AStream, ADest);
end;
procedure TWaveReader.ReadSample(AStream: TStream; ADest: TSoundDocument);
var
lSoundSample: TSoundSample;
i: Integer;
lValue: Integer;
begin
lSoundSample := TSoundSample.Create;
SetLength(lSoundSample.ChannelValues, fmt.Channels);
for i := 0 to fmt.Channels - 1 do
begin
ReadChannelData(AStream, lValue);
lSoundSample.ChannelValues[i] := lValue;
end; end;
ADest.AddSoundElement(lSoundSample);
end; end;
function Min(a,b: Integer): Integer; procedure TWaveReader.ReadChannelData(AStream: TStream; out AValue: Integer);
var
lByteData: Byte;
lWordData: SmallInt;
begin begin
if a<b then Result:=a if fmt.BitsPerSample = 8 then
else Result:=b; begin
lByteData := AStream.ReadByte();
AValue := lByteData;
end
else if fmt.BitsPerSample = 16 then
begin
AStream.Read(lWordData, 2);
AValue := lWordData;
end
else
raise Exception.Create(Format('[TWaveReader.ReadChannelData] Invalid number of bits per sample: %d', [fmt.BitsPerSample]));
end; end;
function TWaveReader.ReadBuf(var Buffer;BufferSize:Integer):Integer; {function TWaveReader.ReadBuf(var Buffer;BufferSize:Integer):Integer;
var var
sz : Integer; sz : Integer;
p : PByteArray; p : PByteArray;
@ -135,7 +207,9 @@ begin
end; end;
end; end;
Result:=i; Result:=i;
end; end;}
initialization
RegisterSoundReader(TWaveReader.Create, sfWav);
end. end.

BIN
components/fpsound/testsounds/defiance_ohio_11.mp3 Normal file
View File

Binary file not shown.

BIN
components/fpsound/testsounds/defiance_ohio_11.ogg Normal file
View File

Binary file not shown.

BIN
components/fpsound/testsounds/test.wav Normal file
View File

Binary file not shown.