diff --git a/components/fpsound/example/mainform.lfm b/components/fpsound/example/mainform.lfm new file mode 100644 index 000000000..01333fb4f --- /dev/null +++ b/components/fpsound/example/mainform.lfm @@ -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 diff --git a/components/fpsound/example/mainform.pas b/components/fpsound/example/mainform.pas new file mode 100644 index 000000000..00c64f62f --- /dev/null +++ b/components/fpsound/example/mainform.pas @@ -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. + diff --git a/components/fpsound/example/soundtest.ico b/components/fpsound/example/soundtest.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/components/fpsound/example/soundtest.ico differ diff --git a/components/fpsound/example/soundtest.lpi b/components/fpsound/example/soundtest.lpi new file mode 100644 index 000000000..714ac7fa2 --- /dev/null +++ b/components/fpsound/example/soundtest.lpi @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/fpsound/example/soundtest.lpr b/components/fpsound/example/soundtest.lpr new file mode 100644 index 000000000..bf85c82ca --- /dev/null +++ b/components/fpsound/example/soundtest.lpr @@ -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. + diff --git a/components/fpsound/example/soundtest.res b/components/fpsound/example/soundtest.res new file mode 100644 index 000000000..7c6cf3e4b Binary files /dev/null and b/components/fpsound/example/soundtest.res differ diff --git a/components/fpsound/fpsound.pas b/components/fpsound/fpsound.pas index 73d60d4bd..0e93b6584 100644 --- a/components/fpsound/fpsound.pas +++ b/components/fpsound/fpsound.pas @@ -18,31 +18,60 @@ uses type TSoundDocument = class; - TSoundFormat = (sfWav, sfMP3); + TSoundFormat = (sfWav, sfMP3, sfOGG, sfMID, sfAMR, sf3GP, sfMP4); + + { TSoundReader } TSoundReader = class public + constructor Create; virtual; procedure ReadFromStream(AStream: TStream; ADest: TSoundDocument); virtual; abstract; end; - TSoundPlayerKind = (spOpenAL, spMPlayer, spFMod, spExtra1); + TSoundPlayerKind = (spOpenAL, spMPlayer, spFMod, spExtra1, spExtra2); + + { TSoundPlayer } TSoundPlayer = class public + constructor Create; virtual; procedure Play(ASound: TSoundDocument); virtual; abstract; 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 = class private AStream: TStream; FPlayer: TSoundPlayer; + FSoundData: TFPList; // of TSoundElement public constructor Create; virtual; destructor Destroy; override; + // Document read/save methods procedure LoadFromFile(AFileName: string); 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 Pause; procedure Seek(ANewPos: Double); @@ -57,9 +86,9 @@ function GetSoundReader(AFormat: TSoundFormat): TSoundReader; implementation var - GSoundPlayers: array[TSoundPlayerKind] of TSoundPlayer = (nil, nil, nil, nil); - GSoundReader: array[TSoundFormat] of TSoundReader = (nil, nil); -// GSoundWriter: array[TSoundFormat] of TSoundWriter = (nil, nil); + GSoundPlayers: array[TSoundPlayerKind] of TSoundPlayer = (nil, nil, nil, nil, nil); + GSoundReaders: array[TSoundFormat] of TSoundReader = (nil, nil, nil, nil, nil, nil, nil); +// GSoundWriter: array[TSoundFormat] of TSoundWriter = (nil, nil, nil, nil, nil, nil, nil); procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TSoundPlayerKind); begin @@ -68,44 +97,94 @@ end; procedure RegisterSoundReader(AReader: TSoundReader; AFormat: TSoundFormat); begin - GSoundReader[AFormat] := AReader; + GSoundReaders[AFormat] := AReader; end; function GetSoundPlayer(AKind: TSoundPlayerKind): TSoundPlayer; begin - + Result := GSoundPlayers[AKind]; end; function GetSoundReader(AFormat: TSoundFormat): TSoundReader; begin + Result := GSoundReaders[AFormat]; +end; +{ TSoundPlayer } + +constructor TSoundPlayer.Create; +begin + inherited Create; +end; + +{ TSoundReader } + +constructor TSoundReader.Create; +begin + inherited Create; end; { TSoundDocument } constructor TSoundDocument.Create; begin + inherited Create; + FSoundData := TFPList.Create; end; destructor TSoundDocument.Destroy; begin + FSoundData.Free; inherited Destroy; end; procedure TSoundDocument.LoadFromFile(AFileName: string); var - lExt: String; + lFormat: TSoundFormat; begin - lExt := ExtractFileExt(AFileName); - if CompareText(lExt, 'wav') = 0 then LoadFromFile(AFileName, sfWav) - else - raise Exception.Create(Format('[TSoundDocument.LoadFromFile] Unknown extension: %s', [lExt])); + lFormat := GuessFormatFromSoundFile(AFileName); + LoadFromFile(AFileName, lFormat); end; procedure TSoundDocument.LoadFromFile(AFileName: string; AFormat: TSoundFormat); +var + lReader: TSoundReader; + lStream: TFileStream; 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; procedure TSoundDocument.Play; @@ -128,5 +207,15 @@ begin 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. diff --git a/components/fpsound/fpsound_openal.pas b/components/fpsound/fpsound_openal.pas index a69ab2d4d..caf1760c0 100644 --- a/components/fpsound/fpsound_openal.pas +++ b/components/fpsound/fpsound_openal.pas @@ -302,7 +302,7 @@ begin while (processed > 0) and (processed <= al_bufcount) do begin alSourceUnqueueBuffers(al_source, 1, @buffer); - sz:=wave.ReadBuf(al_readbuf^, al_bufsize); +//f/ sz:=wave.ReadBuf(al_readbuf^, al_bufsize); if sz <= 0 then begin Exit(False); @@ -328,7 +328,7 @@ begin for i := 0 to al_bufcount - 1 do begin - if wave.ReadBuf(al_readbuf^, al_bufsize) = 0 then +//f/ if wave.ReadBuf(al_readbuf^, al_bufsize) = 0 then Break; alBufferData(al_buffers[i], al_format, al_readbuf, al_bufsize, al_rate); @@ -370,7 +370,7 @@ begin // inittialize codec 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'); if wave.fmt.Format<>1 then diff --git a/components/fpsound/fpsound_wav.pas b/components/fpsound/fpsound_wav.pas index f49598b1d..0c8bd33c7 100644 --- a/components/fpsound/fpsound_wav.pas +++ b/components/fpsound/fpsound_wav.pas @@ -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; @@ -7,95 +19,155 @@ unit fpsound_wav; interface uses - Classes, SysUtils; + Classes, SysUtils, Math, + fpsound; // WAVE UTILS 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 - ID : array [0..3] of char; - Size : LongWord; - Format : array [0..3] of char; + ID : array [0..3] of char; // should be RIFF + Size : LongWord; // 4 + (8 + SubChunk1Size) + (8 + SubChunk2Size). The entire file size excluding TRiffHeader.ID and .Size + Format : array [0..3] of char; // should be WAVE end; TWaveFormat = packed record - ID : array [0..3] of char; - Size : LongWord; - Format : Word; - Channels : Word; - SampleRate : LongWord; - ByteRate : LongWord; - BlockAlign : Word; - BitsPerSample : Word; + ID : array [0..3] of char; // Should be "fmt " + Size : LongWord; // SubChunk1Size + Format : Word; // PCM = 1 (Linear quantization), values > 1 indicate a compressed format + Channels : Word; // Mono = 1, Stereo = 2, etc + SampleRate : LongWord; // 8000, 44100, etc + ByteRate : LongWord; // = SampleRate * NumChannels * BitsPerSample/8 + BlockAlign : Word; // = NumChannels * BitsPerSample/8 + BitsPerSample : Word; // examples: 8 bits, 16 bits, etc end; + // If the format is not PCM then there will also be: +// TWaveFormatExtension = packed record +// ExtraParamSize: Word; +// ExtraParams... +// end; TDataChunk = packed record - Id : array [0..3] of char; - Size : LongWord; + Id : array [0..3] of char; // should be "data" + Size : LongWord; // == NumSamples * NumChannels * BitsPerSample/8 end; + // And after this header the actual data comes, which is an array of samples { TWaveReader } - TWaveReader = class(TObject) - private - loaded : Boolean; - chunkdata : TDataChunk; - chunkpos : Int64; - pos : Int64; - eof : Boolean; + TWaveReader = class(TSoundReader) public - fmt : TWaveFormat; - fStream : TStream; - function LoadFromStream(AStream: TStream): Boolean; - function ReadBuf(var Buffer; BufferSize: Integer): Integer; + fmt: TWaveFormat; + datachunk: TDataChunk; + NumSamples: 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; implementation const ID_RIFF = 'RIFF'; - ID_WAVE = 'WAVE'; - ID_fmt = 'fmt '; + ID_WAVE ='WAVE'; + fD_fmt = 'fmt '; ID_data = 'data'; { 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 riff : TRiffHeader; + lKeyElement: TSoundKeyElement; 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; + AStream.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); + AStream.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; + AStream.Read(datachunk, sizeof(datachunk)); + datachunk.Size := LEtoN(datachunk.Size); + + NumSamples := fmt.BlockAlign div datachunk.size; + + //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; + + ADest.AddSoundElement(lSoundSample); end; -function Min(a,b: Integer): Integer; +procedure TWaveReader.ReadChannelData(AStream: TStream; out AValue: Integer); +var + lByteData: Byte; + lWordData: SmallInt; begin - if a