+ fcl-sound: added new package for supporting sound processing.

git-svn-id: trunk@27292 -

.gitattributes

@@ -2710,6 +2710,12 @@ packages/fcl-sdo/tests/test_suite/test_utils.pas svneol=native#text/plain
 packages/fcl-sdo/tests/test_suite/test_xpathhelper.pas svneol=native#text/plain
 packages/fcl-sdo/tests/test_suite/test_xsdhelper.pas svneol=native#text/plain
 packages/fcl-sdo/tests/test_suite/test_xsdparser.pas svneol=native#text/plain
+packages/fcl-sound/Makefile svneol=native#text/plain
+packages/fcl-sound/Makefile.fpc svneol=native#text/plain
+packages/fcl-sound/fpmake.pp svneol=native#text/plain
+packages/fcl-sound/src/fpwavformat.pas svneol=native#text/plain
+packages/fcl-sound/src/fpwavreader.pas svneol=native#text/plain
+packages/fcl-sound/src/fpwavwriter.pas svneol=native#text/plain
 packages/fcl-stl/Makefile svneol=native#text/plain
 packages/fcl-stl/Makefile.fpc svneol=native#text/plain
 packages/fcl-stl/Makefile.fpc.fpcmake svneol=native#text/plain

packages/fcl-sound/Makefile.fpc

@@ -0,0 +1,91 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=fcl-sound
+version=2.7.1
+
+[require]
+packages=rtl fpmkunit
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake: fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources
+distinstall:	fpmake
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR)  --unitinstalldir=$(INSTALL_UNITDIR) -ie
+endif
+zipinstall:	fpmake
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT)

packages/fcl-sound/fpmake.pp

@@ -0,0 +1,49 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  T : TTarget;
+  P : TPackage;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('fcl-sound');
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='2.7.1';
+    P.Dependencies.Add('fcl-base');
+
+    P.Author := 'Abou Al Montacir of the Free Pascal development team';
+    P.License := 'LGPL with modification, ';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Sound loading, storing and conversion parts for the Free Component Libraries (FCL), FPC''s OOP library.';
+    P.NeedLibC:= false;
+
+    P.SourcePath.Add('src');
+    P.IncludePath.Add('src');
+
+    T:=P.Targets.AddUnit('fpwavformat');
+    T:=P.Targets.AddUnit('fpwavreader');
+      with T.Dependencies do
+        begin
+          AddUnit('fpwavformat');
+        end;
+    T:=P.Targets.AddUnit('fpwavwriter');
+      with T.Dependencies do
+        begin
+          AddUnit('fpwavformat');
+        end;
+
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}
+

packages/fcl-sound/src/fpwavformat.pas

@@ -0,0 +1,52 @@
+{*****************************************************************************}
+{
+    This file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2014 by Mazen NEIFER of the Free Pascal development team
+	and was adapted from wavopenal.pas copyright (c) 2010 Dmitry Boyarintsev. 
+
+    RIFF/WAVE sound file basic types and constants.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+unit fpWavFormat;
+
+{$mode objfpc}{$H+}
+
+interface
+
+const
+  AUDIO_CHUNK_ID_RIFF = 'RIFF';
+  AUDIO_CHUNK_ID_WAVE = 'WAVE';
+  AUDIO_CHUNK_ID_fmt  = 'fmt ';
+  AUDIO_CHUNK_ID_data = 'data';
+  AUDIO_FORMAT_PCM = 1;
+
+type
+  TChunkID = array [0..3] of char;
+  TChunkHeader = packed record
+    ID: TChunkID;
+    Size: UInt32;
+  end;
+  TRiffHeader = packed record
+    ChunkHeader: TChunkHeader;
+    Format: TChunkID;
+  end;
+  TWaveFormat = packed record
+    ChunkHeader: TChunkHeader;
+    Format: UInt16;
+    Channels: UInt16;
+    SampleRate: UInt32;
+    ByteRate: UInt32;
+    BlockAlign: UInt16;
+    BitsPerSample: UInt16;
+  end;
+
+implementation
+
+end.
+

packages/fcl-sound/src/fpwavreader.pas

@@ -0,0 +1,144 @@
+{*****************************************************************************}
+{
+    This file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2014 by Mazen NEIFER of the Free Pascal development team
+	and was adapted from wavopenal.pas copyright (c) 2010 Dmitry Boyarintsev. 
+
+    RIFF/WAVE sound file reader implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+unit fpWavReader;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  fpWavFormat,
+  Classes;
+
+type
+  { TWaveReader }
+
+  TWavReader = class(TObject)
+  private
+    DataChunk: TChunkHeader;
+    ChunkPos: Int64;
+    EoF: Boolean;
+    fStream: TStream;
+    FFileName: string;
+  public
+    fmt   : TWaveFormat;
+    destructor Destroy; override;
+    function LoadFromFile(const FileName: string): Boolean;
+    function LoadFromStream(AStream: TStream): Boolean;
+    function ReadBuf(var Buffer; BufferSize: Integer): Integer;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+procedure LEtoN(var fmt: TWaveFormat); overload;
+begin
+  with fmt, ChunkHeader do begin
+    Size := LEtoN(Size);
+    Format := LEtoN(Format);
+    Channels := LEtoN(Channels);
+    SampleRate := LEtoN(SampleRate);
+    ByteRate := LEtoN(ByteRate);
+    BlockAlign := LEtoN(BlockAlign);
+    BitsPerSample := LEtoN(BitsPerSample);
+  end;
+end;
+
+{ TWaveReader }
+
+destructor TWavReader.Destroy;
+begin
+  if (FFileName <> '') and  Assigned(fStream) then begin
+    fStream.Free;
+  end;
+  inherited Destroy;
+end;
+
+function TWavReader.LoadFromFile(const FileName: string):Boolean;
+begin
+  if (FFileName <> '') and Assigned(fStream) then begin
+    fStream.Free;
+  end;
+  fStream := TFileStream.Create(FileName, fmOpenRead);
+  if Assigned(fStream) then begin
+    Result := LoadFromStream(fStream);
+    FFileName := FileName;
+  end else begin
+    Result := False;
+  end;
+end;
+
+function TWavReader.LoadFromStream(AStream:TStream):Boolean;
+var
+  riff: TRiffHeader;
+begin
+  fStream := AStream;
+  FFileName := '';
+  Result := fStream.Read(riff, sizeof(riff)) = sizeof(riff);
+  riff.ChunkHeader.Size := LEtoN(riff.ChunkHeader.Size);
+  Result := Result and (riff.ChunkHeader.ID = AUDIO_CHUNK_ID_RIFF) and (riff.Format = AUDIO_CHUNK_ID_WAVE);
+  Result := Result and (fStream.Read(fmt, sizeof(fmt)) = sizeof(fmt));
+  LEtoN(fmt);
+  Result := Result and (fmt.ChunkHeader.ID = AUDIO_CHUNK_ID_fmt);
+  if Result and (fmt.Format <> 1) then begin
+    writeln('WAVE file is using compression. Sorry, cannot load. Please provide uncompressed .wav');
+    Exit(False);
+  end;
+end;
+
+function Min(a, b: Integer): Integer;
+begin
+  if a < b then begin
+    Result := a;
+  end else begin
+    Result := b;
+  end;
+end;
+
+function TWavReader.ReadBuf(var Buffer; BufferSize: Integer): Integer;
+var
+  sz: Integer;
+  p: TByteArray absolute Buffer;
+  i: Integer;
+begin
+  WriteLn('[TWavReader.ReadBuf] BufferSize = ', BufferSize);
+  i := 0;
+  while (not EoF) and (i < bufferSize) do begin
+    if ChunkPos >= DataChunk.Size then begin
+      sz := fstream.Read(DataChunk, sizeof(DataChunk));
+      EoF := sz < sizeof(DataChunk);
+      if not EoF then begin
+        DataChunk.Size := LEtoN(DataChunk.Size);
+        if DataChunk.Id <> AUDIO_CHUNK_ID_data then
+          ChunkPos := DataChunk.Size
+        else
+          ChunkPos := 0;
+      end;
+    end else begin
+      sz := Min(BufferSize, DataChunk.Size - ChunkPos);
+      sz := fStream.Read(p[i], sz);
+      EoF := sz <= 0;
+      ChunkPos += sz;
+      i += sz;
+    end;
+  end;
+  Result := i;
+end;
+
+end.
+

packages/fcl-sound/src/fpwavwriter.pas

@@ -0,0 +1,150 @@
+{*****************************************************************************}
+{
+    This file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2014 by Mazen NEIFER of the Free Pascal development team
+	and was adapted from wavopenal.pas copyright (c) 2010 Dmitry Boyarintsev. 
+
+    RIFF/WAVE sound file writer implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+unit fpWavWriter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  fpWavFormat,
+  Classes;
+
+type
+  { TWaveReader }
+
+  { TWavWriter }
+
+  TWavWriter = class(TObject)
+  private
+    fStream: TStream;
+    FFreeStreamOnClose: Boolean;
+  public
+    fmt: TWaveFormat;
+    destructor Destroy; override;
+    function CloseAudioFile: Boolean;
+    function FlushHeader: Boolean;
+    function StoreToFile(const FileName: string): Boolean;
+    function StoreToStream(AStream: TStream): Boolean;
+    function WriteBuf(var Buffer; BufferSize: Integer): Integer;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+procedure NtoLE(var fmt: TWaveFormat); overload;
+begin
+  with fmt, ChunkHeader do begin
+    Size := NtoLE(Size);
+    Format := NtoLE(Format);
+    Channels := NtoLE(Channels);
+    SampleRate := NtoLE(SampleRate);
+    ByteRate := NtoLE(ByteRate);
+    BlockAlign := NtoLE(BlockAlign);
+    BitsPerSample := NtoLE(BitsPerSample);
+  end;
+end;
+
+{ TWaveWriter }
+
+destructor TWavWriter.Destroy;
+begin
+  CloseAudioFile;
+  inherited Destroy;
+end;
+
+function TWavWriter.CloseAudioFile: Boolean;
+begin
+  Result := True;
+  if not Assigned(fStream) then begin
+    Exit(True);
+  end;
+  FlushHeader;
+  if FFreeStreamOnClose then begin
+    fStream.Free;
+  end;
+end;
+
+function TWavWriter.FlushHeader: Boolean;
+var
+  riff: TRiffHeader;
+  fmtLE: TWaveFormat;
+  DataChunk: TChunkHeader;
+  Pos: Int64;
+begin
+  Pos := fStream.Position;
+  with riff, ChunkHeader do begin
+    ID := AUDIO_CHUNK_ID_RIFF;
+    Size := NtoLE(Pos - SizeOf(ChunkHeader));
+    Format := AUDIO_CHUNK_ID_WAVE;
+  end;
+  fmtLE := fmt;
+  NtoLE(fmtLE);
+  with fStream do begin
+    Position := 0;
+    Result := Write(riff, SizeOf(riff)) = SizeOf(riff);
+    Result := Write(fmtLE, sizeof(fmtLE)) = SizeOf(fmtLE);
+  end;
+  with DataChunk do begin
+    Id := AUDIO_CHUNK_ID_data;
+    Size := Pos - SizeOf(DataChunk) - fStream.Position;
+  end;
+  with fStream do begin
+    Result := Write(DataChunk, SizeOf(DataChunk)) = SizeOf(DataChunk);
+  end;
+end;
+
+function TWavWriter.StoreToFile(const FileName: string):Boolean;
+begin
+  CloseAudioFile;
+  fStream := TFileStream.Create(FileName, fmCreate + fmOpenWrite);
+  if Assigned(fStream) then begin
+    Result := StoreToStream(fStream);
+    FFreeStreamOnClose := True;
+  end else begin
+    Result := False;
+  end;
+end;
+
+function TWavWriter.StoreToStream(AStream:TStream):Boolean;
+begin
+  fStream := AStream;
+  FFreeStreamOnClose := False;
+  with fmt, ChunkHeader do begin
+    ID := AUDIO_CHUNK_ID_fmt;
+    Size := SizeOf(fmt) - SizeOf(ChunkHeader);
+    Format := AUDIO_FORMAT_PCM;
+  end;
+  Result := FlushHeader;
+end;
+
+function TWavWriter.WriteBuf(var Buffer; BufferSize: Integer): Integer;
+var
+  sz: Integer;
+begin
+  WriteLn('[TWavWriter.WriteBuf] BufferSize = ', BufferSize);
+  Result := 0;
+  with fStream do begin
+    sz := Write(Buffer, BufferSize);
+    if sz < 0 then Exit;
+    Result += sz;
+  end;
+end;
+
+end.
+

packages/fpmake_add.inc

@@ -25,6 +25,7 @@
   add_fcl_registry(ADirectory+IncludeTrailingPathDelimiter('fcl-registry'));
   add_fcl_res(ADirectory+IncludeTrailingPathDelimiter('fcl-res'));
   add_fcl_sdo(ADirectory+IncludeTrailingPathDelimiter('fcl-sdo'));
+  add_fcl_sound(ADirectory+IncludeTrailingPathDelimiter('fcl-sound'));
   add_fcl_stl(ADirectory+IncludeTrailingPathDelimiter('fcl-stl'));
   add_fcl_web(ADirectory+IncludeTrailingPathDelimiter('fcl-web'));
   add_fcl_xml(ADirectory+IncludeTrailingPathDelimiter('fcl-xml'));

packages/fpmake_proc.inc

@@ -152,6 +152,12 @@ begin
 {$include fcl-sdo/fpmake.pp}
 end;
 
+procedure add_fcl_sound(const ADirectory: string);
+begin
+  with Installer do
+{$include fcl-sound/fpmake.pp}
+end;
+
 procedure add_fcl_stl(const ADirectory: string);
 begin
   with Installer do