freepascal.compiler/packages/fcl-sound/src/fpwavreader.pas

{*****************************************************************************}
{
    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.
}
{$IFNDEF FPC_DOTTEDUNITS}
unit fpwavreader;
{$ENDIF FPC_DOTTEDUNITS}

{$mode objfpc}{$H+}

interface

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.Sound.Wav.Format,
  System.Classes;
{$ELSE FPC_DOTTEDUNITS}
uses
  fpWavFormat,
  Classes;
{$ENDIF FPC_DOTTEDUNITS}

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

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.SysUtils;
{$ELSE FPC_DOTTEDUNITS}
uses
  SysUtils;
{$ENDIF FPC_DOTTEDUNITS}

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 + fmShareDenyWrite);
  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) and ((fmt.ChunkHeader.Size + 8) >= sizeof(fmt));
  if Result and ((fmt.ChunkHeader.Size + 8) > sizeof(fmt)) then
    fStream.Seek(Align((fmt.ChunkHeader.Size + 8) - sizeof(fmt), 2), soCurrent);
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
  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 begin
          ChunkPos := DataChunk.Size;
          fstream.Seek(DataChunk.Size, soCurrent);
        end
        else
          ChunkPos := 0;
      end;
    end else begin
      sz := Min(BufferSize, DataChunk.Size - ChunkPos);
      sz := fStream.Read(p[i], sz);
      EoF := sz <= 0;
      Inc(ChunkPos, sz);
      Inc(i, sz);
    end;
  end;
  Result := i;
end;

end.