GLScene/Sourcex/GXS.SoundFileObjects.pas

//
// The graphics engine GLXEngine. The unit of GXScene for Delphi
//
unit GXS.SoundFileObjects;

(*
  Support classes for loading various fileformats.
  These classes work together like vector file formats or TGraphic classes.
*)

interface

{$I Stage.Defines.inc}

uses
  System.Classes,
  System.SysUtils,
{$IFDEF MSWINDOWS}Winapi.MMSystem, {$ENDIF}
  GXS.ApplicationFileIO,
  GXS.ImageUtils;

type

  // Defines a sound sampling quality.
  TgxSoundSampling = class(TPersistent)
  private
    FOwner: TPersistent;
    FFrequency: Integer;
    FNbChannels: Integer;
    FBitsPerSample: Integer;
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function BytesPerSec: Integer;
    function BytesPerSample: Integer;
{$IFDEF MSWINDOWS}
    function WaveFormat: TWaveFormatEx;
{$ENDIF}
  published
    // Sampling frequency in Hz (= samples per sec)
    property Frequency: Integer read FFrequency write FFrequency default 22050;
    (* Nb of sampling channels.
      1 = mono, 2 = stereo, etc. *)
    property NbChannels: Integer read FNbChannels write FNbChannels default 1;
    (* Nb of bits per sample.
      Common values are 8 and 16 bits. *)
    property BitsPerSample: Integer read FBitsPerSample write FBitsPerSample
      default 8;
  end;

  (* Abstract base class for different Sound file Formatx.
    The actual implementation for these files (WAV, RAW...) must be done
    seperately. The concept for TgxSoundFile is very similar to TGraphic
    (see Delphi Help).
    Default implementation for LoadFromFile/SaveToFile are to directly call the
    relevent stream-based methods, ie. you will just have to override the stream
    methods in most cases. *)
  TgxSoundFile = class(TgxDataFile)
  private
    FSampling: TgxSoundSampling;
  protected
    procedure SetSampling(const val: TgxSoundSampling);
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure PlayOnWaveOut; virtual;
    // Returns a pointer to the sample data viewed as an in-memory WAV File.
    function WAVData: Pointer; virtual; abstract;
    // Returns the size (in bytes) of the WAVData.
    function WAVDataSize: Integer; virtual; abstract;
    // Returns a pointer to the sample data viewed as an in-memory PCM buffer.
    function PCMData: Pointer; virtual; abstract;
    // Length of PCM data, in bytes.
    function LengthInBytes: Integer; virtual; abstract;
    // Nb of intensity samples in the sample.
    function LengthInSamples: Integer;
    // Length of play of the sample at nominal speed in seconds.
    function LengthInSec: Single;
    property Sampling: TgxSoundSampling read FSampling write SetSampling;
  end;

  TgxSoundFileClass = class of TgxSoundFile;
  TgxSoundFileFormat = record
    SoundFileClass: TgxSoundFileClass;
    Extension: String;
    Description: String;
    DescResID: Integer;
  end;

  PSoundFileFormat = ^TgxSoundFileFormat;
  TgxSoundFileFormatsList = class(TList)
  public
    destructor Destroy; override;
    procedure Add(const Ext, Desc: String; DescID: Integer;
      AClass: TgxSoundFileClass);
    function FindExt(Ext: string): TgxSoundFileClass;
    procedure Remove(AClass: TgxSoundFileClass);
    procedure BuildFilterStrings(SoundFileClass: TgxSoundFileClass;
      out Descriptions, Filters: string);
  end;

function GetGLSoundFileFormats: TgxSoundFileFormatsList;
procedure RegisterSoundFileFormat(const AExtension, ADescription: String;
  AClass: TgxSoundFileClass);
procedure UnregisterSoundFileClass(AClass: TgxSoundFileClass);

// ------------------------------------------------------------------
implementation

// ------------------------------------------------------------------

var
  vSoundFileFormats: TgxSoundFileFormatsList;

function GetGLSoundFileFormats: TgxSoundFileFormatsList;
begin
  if not Assigned(vSoundFileFormats) then
    vSoundFileFormats := TgxSoundFileFormatsList.Create;
  Result := vSoundFileFormats;
end;

procedure RegisterSoundFileFormat(const AExtension, ADescription: String;
  AClass: TgxSoundFileClass);
begin
  RegisterClass(AClass);
  GetGLSoundFileFormats.Add(AExtension, ADescription, 0, AClass);
end;

procedure UnregisterSoundFileClass(AClass: TgxSoundFileClass);
begin
  if Assigned(vSoundFileFormats) then
    vSoundFileFormats.Remove(AClass);
end;

// ------------------
// ------------------ TgxSoundSampling ------------------
// ------------------

constructor TgxSoundSampling.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FFrequency := 22050;
  FNbChannels := 1;
  FBitsPerSample := 8;
end;

destructor TgxSoundSampling.Destroy;
begin
  inherited Destroy;
end;

procedure TgxSoundSampling.Assign(Source: TPersistent);
begin
  if Source is TgxSoundSampling then
  begin
    FFrequency := TgxSoundSampling(Source).Frequency;
    FNbChannels := TgxSoundSampling(Source).NbChannels;
    FBitsPerSample := TgxSoundSampling(Source).BitsPerSample;
  end
  else
    inherited;
end;

function TgxSoundSampling.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TgxSoundSampling.BytesPerSec: Integer;
begin
  Result := (FFrequency * FBitsPerSample * FNbChannels) shr 3;
end;

function TgxSoundSampling.BytesPerSample: Integer;
begin
  Result := FBitsPerSample shr 3;
end;

{$IFDEF MSWINDOWS}

function TgxSoundSampling.WaveFormat: TWaveFormatEx;
begin
  Result.nSamplesPerSec := Frequency;
  Result.nChannels := NbChannels;
  Result.wFormatTag := Wave_Format_PCM;
  Result.nAvgBytesPerSec := BytesPerSec;
  Result.wBitsPerSample := BitsPerSample;
  Result.nBlockAlign := NbChannels * BytesPerSample;
  Result.cbSize := 0;
end;
{$ENDIF}
// ------------------
// ------------------ TgxSoundFile ------------------
// ------------------

constructor TgxSoundFile.Create(AOwner: TPersistent);
begin
  inherited;
  FSampling := TgxSoundSampling.Create(Self);
end;

destructor TgxSoundFile.Destroy;
begin
  FSampling.Free;
  inherited;
end;

procedure TgxSoundFile.SetSampling(const val: TgxSoundSampling);
begin
  FSampling.Assign(val);
end;

procedure TgxSoundFile.PlayOnWaveOut;
begin
  // VXSoundFileObjects.PlayOnWaveOut(PCMData, LengthInSamples, Sampling);
end;

function TgxSoundFile.LengthInSamples: Integer;
var
  d: Integer;
begin
  d := Sampling.BytesPerSample * Sampling.NbChannels;
  if d > 0 then
    Result := LengthInBytes div d
  else
    Result := 0;
end;

function TgxSoundFile.LengthInSec: Single;
begin
  Result := LengthInBytes / Sampling.BytesPerSec;
end;

// ------------------
// ------------------ TgxSoundFileFormatsList ------------------
// ------------------

destructor TgxSoundFileFormatsList.Destroy;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    Dispose(PSoundFileFormat(Items[i]));
  inherited;
end;

procedure TgxSoundFileFormatsList.Add(const Ext, Desc: String; DescID: Integer;
  AClass: TgxSoundFileClass);
var
  newRec: PSoundFileFormat;
begin
  New(newRec);
  with newRec^ do
  begin
    Extension := AnsiLowerCase(Ext);
    SoundFileClass := AClass;
    Description := Desc;
    DescResID := DescID;
  end;
  inherited Add(newRec);
end;

function TgxSoundFileFormatsList.FindExt(Ext: string): TgxSoundFileClass;
var
  i: Integer;
begin
  Ext := AnsiLowerCase(Ext);
  for i := Count - 1 downto 0 do
    with PSoundFileFormat(Items[i])^ do
      if (Extension = Ext) or ('.' + Extension = Ext) then
      begin
        Result := SoundFileClass;
        Exit;
      end;
  Result := nil;
end;

procedure TgxSoundFileFormatsList.Remove(AClass: TgxSoundFileClass);
var
  i: Integer;
  p: PSoundFileFormat;
begin
  for i := Count - 1 downto 0 do
  begin
    p := PSoundFileFormat(Items[i]);
    if p^.SoundFileClass.InheritsFrom(AClass) then
    begin
      Dispose(p);
      Delete(i);
    end;
  end;
end;

procedure TgxSoundFileFormatsList.BuildFilterStrings(SoundFileClass
  : TgxSoundFileClass; out Descriptions, Filters: string);
var
  c, i: Integer;
  p: PSoundFileFormat;
begin
  Descriptions := '';
  Filters := '';
  c := 0;
  for i := Count - 1 downto 0 do
  begin
    p := PSoundFileFormat(Items[i]);
    if p^.SoundFileClass.InheritsFrom(SoundFileClass) and (p^.Extension <> '')
    then
      with p^ do
      begin
        if c <> 0 then
        begin
          Descriptions := Descriptions + '|';
          Filters := Filters + ';';
        end;
        if (Description = '') and (DescResID <> 0) then
          Description := LoadStr(DescResID);
        FmtStr(Descriptions, '%s%s (*.%s)|*.%2:s', [Descriptions, Description,
          Extension]);
        FmtStr(Filters, '%s*.%s', [Filters, Extension]);
        Inc(c);
      end;
  end;
  if c > 1 then
    FmtStr(Descriptions, '%s (%s)|%1:s|%s',
      [sAllFilter, Filters, Descriptions]);
end;

// ------------------------------------------------------------------
initialization

// ------------------------------------------------------------------

finalization

FreeAndNil(vSoundFileFormats);

end.