1844 lines
55 KiB
ObjectPascal

(*
this file is a part of audio components suite v 2.3.
copyright (c) 2002-2005 andrei borovsky. all rights reserved.
see the license file for more details.
you can contact me at mail@z0m3ie.de
*)
{
$Log: acs_wave.pas,v $
Revision 1.11 2006/08/03 17:31:09 z0m3ie
*** empty log message ***
Revision 1.10 2006/07/04 17:12:45 z0m3ie
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)
Revision 1.5 2005/12/30 13:24:28 z0m3ie
waveformat corrections, localizing
Revision 1.4 2005/12/30 11:10:57 z0m3ie
some corrections to lazarus-linux depending things
Revision 1.3 2005/12/29 20:45:59 z0m3ie
fixed some problems with vorbis in lazarus
Revision 1.2 2005/12/26 17:31:39 z0m3ie
fixed some problems in acs_dsfiles
fixed some problems in acs_vorbis
reworked all buffers
Revision 1.1 2005/12/19 18:36:38 z0m3ie
*** empty log message ***
Revision 1.6 2005/12/18 17:01:54 z0m3ie
delphi compatibility
Revision 1.5 2005/12/04 16:54:34 z0m3ie
All classes are renamed, Style TACS... than T... to avoid conflicts with other components (eg TMixer is TACSMixer now)
Revision 1.4 2005/11/28 21:57:24 z0m3ie
mostly FileOut fixes
moved PBuffer to PBuffer8
set all to dynamically Buffering
Revision 1.3 2005/10/02 16:51:01 z0m3ie
*** empty log message ***
Revision 1.2 2005/09/13 04:04:50 z0m3ie
First release without Components for Fileformats
only TFileIn and TFileOut are Visible
Revision 1.1 2005/09/12 22:04:52 z0m3ie
modified structure again, fileformats are now in an sperat folder.
all File In/Out classes are capsulated from TFileIn and TFileOut
Revision 1.2 2005/08/22 20:17:01 z0m3ie
changed Headers to log
changed mail adress
}
unit acs_wave;
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
// This is required to enable TWaveIn read MS ACM (MP3-encoded) files.
{$IFDEF WINDOWS}
MMSYSTEM, MSAcm, waveconverter,
{$ENDIF}
{$IFDEF LINUX}
Math, MAD,
{$ENDIF}
ACS_File, Classes, SysUtils, ACS_Types, ACS_Classes,ACS_Strings;
type
TWavType = (wtUnsupported, wtPCM, wtDVIADPCM, wtMSADPCM, wtACM);
TWaveHeader = record
// RIFF file header
RIFF: array [0..3] of Char; // = 'RIFF'
FileSize: Integer; // = FileSize - 8
RIFFType: array [0..3] of Char; // = 'WAVE'
// Format chunk
FmtChunkId: array [0..3] of Char; // = 'fmt'
FmtChunkSize: Integer; // = 16
FormatTag: Word; // One of WAVE_FORMAT_XXX constants
Channels: Word; // = 1 - mono = 2 - stereo
SampleRate: Integer;
BytesPerSecond: Integer;
BlockAlign: Word;
BitsPerSample: Word; // = 8, 16 or 32 Bits/sample
// Data Chunk
DataChunkId: array [0..3] of Char; // = 'data'
DataSize: Integer; // Data size in bytes
end;
TDVIADPCMHeader = record
// RIFF file header
RIFF: array [0..3] of Char; // = 'RIFF'
FileSize: Integer; // = FileSize - 8
RIFFType: array [0..3] of Char; // = 'WAVE'
// Format chunk
FmtChunkId: array [0..3] of Char; // = 'fmt'
FmtChunkSize: Integer; // = 20
FormatTag: Word; // WAVE_FORMAT_DVI_ADPCM
Channels: Word; // = 1 - mono = 2 - stereo
SampleRate: Integer;
BytesPerSecond: Integer;
BlockAlign: Word;
BitsPerSample: Word; // = 3, 4 Bits/sample
cbSize : Word; // The size in bytes of the extra information
SamplesPerBlock : Word; // number of samples per channel per Block
// Fact Chunk
FactChunkId: array [0..3] of Char; // = 'fact'
FactChunkSize : Integer; // = 4
DataLength : Integer;
// Data Chunk
DataChunkId: array [0..3] of Char; // = 'data'
DataSize: Integer; // Data size in bytes
end;
TDVI_ADPCM_INFO = record
BlockLength : Word;
SamplesPerBlock : Word;
DataSize : Integer;
end;
TDVI_ADPCM_STATE_STEREO = packed record
valprev_l : SmallInt; // Previous output value
index_l : Byte; // Index into stepsize table
valprev_r : SmallInt; // Previous output value
index_r : Byte; // Index into stepsize table
end;
TDVI_ADPCM_ENCODE_STATE_STEREO = packed record
PredSamp_l : SmallInt;
Index_l : Byte;
PredSamp_r : SmallInt;
Index_r : Byte;
end;
TMS_ADPCM_COEF_SET = packed record
Coef1, Coef2 : SmallInt;
end;
TMS_ADPCM_INFO = record
BlockLength : Word;
SamplesPerBlock : Word;
DataSize : Integer;
NumCoeff : Word;
CoefSets : array[0..31] of TMS_ADPCM_COEF_SET; // Is that enough?
end;
TMSADPCMBlockHeaderMono = packed record
predictor : Byte;
Delta : SmallInt;
Samp1 : SmallInt;
Samp2 : SmallInt;
end;
TMSADPCMBlockHeaderStereo = packed record
predictor : array[0..1] of Byte;
Delta : array[0..1] of SmallInt;
Samp1 : array[0..1] of SmallInt;
Samp2 : array[0..1] of SmallInt;
end;
const
//Hack : Wave is the only format where i must use an const buffer
//all dynamic buffers crash on Move in GetData no matter why
BUFFER_SIZE = $8000;
type
{ TWaveIn }
TWaveIn = class(TACSCustomFileIn)
private
buf : array[0..BUFFER_SIZE] of byte;
_WavType : TWavType;
DVI_ADPCM_INFO : TDVI_ADPCM_INFO;
DVI_ADPCM_STATE : TDVI_ADPCM_STATE_STEREO;
MS_ADPCM_INFO : TMS_ADPCM_INFO;
MS_ADPCM_STATE : TMSADPCMBlockHeaderStereo;
HeaderSize : Word;
_MS : TMemoryStream;
OldStream : TStream;
OldStreamAssigned : Boolean;
{$IFDEF LINUX}
// MS ACM stuff
HasFirstFrame : Boolean;
InputDone : Boolean;
Data : Pointer;
DataLen : Integer;
{$ENDIF}
procedure SetBufferSize(S : Integer);override;
function ReadDVIADPCMBlock(aData : Pointer) : Boolean;
function ReadMSADPCMBlock(bData : Pointer) : Boolean;
function GetWavType : TWavType;
procedure ReadRIFFHeader;
procedure DecodeDVIADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
procedure DecodeDVIADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
procedure DecodeMSADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
procedure DecodeMSADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
protected
procedure OpenFile; override;
procedure CloseFile; override;
public
property WavType : TWavType read GetWavType;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetData(Buffer : Pointer; aBufferSize : Integer): Integer; override;
function Seek(SampleNum : Integer) : Boolean; override;
end;
TWaveOut = class(TACSCustomFileOut)
private
EndOfInput : Boolean;
FWavType : TWavType;
FEncodeState : TDVI_ADPCM_ENCODE_STATE_STEREO;
FPrevSR : Integer;
FPrevCh : Word;
FPrevBPS : Word;
FPrevLen : Integer;
FLenOffs : Integer;
FPrevDataSize : Integer;
FDataSizeOffs : Integer;
FPrevWavType : TWavType;
HeaderSize : Integer;
FBlockAlign : Word;
procedure SetWavType(WT : TWavType);
procedure ReadRIFFHeader;
procedure FillHeaderPCM(var Header : TWaveHeader);
procedure FillHeaderDVIADPCM(var Header : TDVIADPCMHeader);
procedure SetBlockSize(BS : Word);
procedure EncodeDVIADPCMMono(InData : PACSBuffer16; OutData : PACSBuffer8);
procedure EncodeDVIADPCMStereo(InData : PACSBuffer16; OutData : PACSBuffer8);
protected
procedure Done; override;
function DoOutput(Abort : Boolean):Boolean; override;
procedure Prepare; override;
procedure SetFileMode(aMode : TACSFileOutputMode); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property WavType : TWavType read FWavType write SetWavType;
property BlockSize : Word read FBlockAlign write SetBlockSize;
end;
implementation
const
WaveHeaderOffs = 44;
DataSizeOffs = 40;
WAVE_FORMAT_PCM = 1;
WAVE_FORMAT_ADPCM = 2;
WAVE_FORMAT_ALAW = 6;
WAVE_FORMAT_MULAW = 7;
WAVE_FORMAT_DVI_IMA_ADPCM = 17;
WAVE_FORMAT_IMA_ADPCM = 17;
WAVE_FORMAT_MP3 = 85;
type
TDVIADPCMBlockHeader = packed record
Samp0 : SmallInt;
StepTableIndex : Byte;
Reserved : Byte;
end;
const
// DVI IMA ADPCM stuff
StepTab : array[0..88] of Integer = (
7, 8, 9, 10, 11, 12, 13, 14,
16, 17, 19, 21, 23, 25, 28, 31,
34, 37, 41, 45, 50, 55, 60, 66,
73, 80, 88, 97, 107, 118, 130, 143,
157, 173, 190, 209, 230, 253, 279, 307,
337, 371, 408, 449, 494, 544, 598, 658,
724, 796, 876, 963, 1060, 1166, 1282, 1411,
1552, 1707, 1878, 2066, 2272, 2499, 2749, 3024,
3327, 3660, 4026, 4428, 4871, 5358, 5894, 6484,
7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794,
32767 );
IndexTab : array[0..15] of Integer = ( -1, -1, -1, -1, 2, 4, 6, 8,
-1, -1, -1, -1, 2, 4, 6, 8 );
// MS ADPCM Stuff
adaptive : array[0..15] of SmallInt =
(
230, 230, 230, 230, 307, 409, 512, 614,
768, 614, 512, 409, 307, 230, 230, 230
);
procedure TWaveIn.DecodeDVIADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
var
i, j, SP : Integer;
Diff, PSample : Integer;
Code : Byte;
Index : Integer;
begin
OutData^[0] := DVI_ADPCM_STATE.valprev_l;
SP := 0;
PSample := DVI_ADPCM_STATE.valprev_l;
Index := DVI_ADPCM_STATE.index_l;
for i := 0 to (Len shl 1) -1 do
begin
j := i shr 1;
Code := InData^[j];
if (i and 1) = 0 then
Code := Code and 15
else Code := Code shr 4;
Diff := (StepTab[Index] shr 3 );
if (Code and 4) <> 0 then
Diff := Diff + StepTab[Index];
if (Code and 2) <> 0 then
Diff := Diff + (StepTab[Index] shr 1);
if (Code and 1) <> 0 then
Diff := Diff + (StepTab[Index] shr 2);
if (Code and 8) <> 0 then Diff := -Diff;
PSample := PSample + Diff;
if PSample > 32767 then PSample := 32767;
if PSample < -32767 then PSample := -32767;
SP:=SP+1;
OutData^[SP] := PSample;
Index := Index + IndexTab[Code];
if Index > 88 then Index := 88;
if Index < 0 then Index := 0;
end;
Len := SP+1;
end;
procedure TWaveIn.DecodeDVIADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
var
i, j, SP : Integer;
Diff, PSample : Integer;
Code : Byte;
Index : Integer;
begin
OutData^[0] := DVI_ADPCM_STATE.valprev_l;
SP := 0;
PSample := DVI_ADPCM_STATE.valprev_l;
Index := DVI_ADPCM_STATE.index_l;
for i := 0 to (Len -1) do
begin
j := i shr 1;
Code := InData^[(j div 4)*8 + (j mod 4)];
if (i and 1) = 0 then
Code := Code and 15
else Code := Code shr 4;
Diff := (StepTab[Index] shr 3 );
if (Code and 4) <> 0 then
Diff := Diff + StepTab[Index];
if (Code and 2) <> 0 then
Diff := Diff + (StepTab[Index] shr 1);
if (Code and 1) <> 0 then
Diff := Diff + (StepTab[Index] shr 2);
if (Code and 8) <> 0 then Diff := -Diff;
PSample := PSample + Diff;
if PSample > 32767 then PSample := 32767;
if PSample < -32767 then PSample := -32767;
SP:=SP+2;
OutData^[SP] := PSample;
Index := Index + IndexTab[Code];
if Index > 88 then Index := 88;
if Index < 0 then Index := 0;
end;
i := 1;
OutData^[i] := DVI_ADPCM_STATE.valprev_r;
SP := 1;
PSample := DVI_ADPCM_STATE.valprev_r;
Index := DVI_ADPCM_STATE.index_r;
for i := 0 to (Len -1) do
begin
j := i shr 1;
Code := InData^[(j div 4)*8 + (j mod 4) + 4];
if (i and 1) = 0 then
Code := Code and 15
else Code := Code shr 4;
Diff := (StepTab[Index] shr 3 );
if (Code and 4) <> 0 then
Diff := Diff + StepTab[Index];
if (Code and 2) <> 0 then
Diff := Diff + (StepTab[Index] shr 1);
if (Code and 1) <> 0 then
Diff := Diff + (StepTab[Index] shr 2);
if (Code and 8) <> 0 then Diff := -Diff;
PSample := PSample + Diff;
if PSample > 32767 then PSample := 32767;
if PSample < -32767 then PSample := -32767;
SP:=SP+2;
OutData^[SP] := PSample;
Index := Index + IndexTab[Code];
if Index > 88 then Index := 88;
if Index < 0 then Index := 0;
end;
Len := (SP div 2)+1;
end;
procedure TWaveIn.DecodeMSADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
var
pos, i, PredSamp, ErrorDelta : Integer;
begin
pos := 0;
OutData^[pos] := MS_ADPCM_STATE.Samp2[0];
Inc(pos);
OutData^[pos] := MS_ADPCM_STATE.Samp1[0];
Inc(pos);
for i := 0 to (Len shr 1) - 1 do
begin
PredSamp := (MS_ADPCM_STATE.Samp1[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef1 +
MS_ADPCM_STATE.Samp2[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef2) div 256;
ErrorDelta := InData^[i] shr 4;
if (ErrorDelta and 8) <> 0 then
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta - 16)
else
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta);
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32768 then PredSamp := -32768;
OutData^[pos] := PredSamp;
Inc(pos);
MS_ADPCM_STATE.Delta[0] := (MS_ADPCM_STATE.Delta[0]*adaptive[ErrorDelta]) div 256;
if MS_ADPCM_STATE.Delta[0] < 16 then MS_ADPCM_STATE.Delta[0] := 16;
MS_ADPCM_STATE.Samp2[0] := MS_ADPCM_STATE.Samp1[0];
MS_ADPCM_STATE.Samp1[0] := PredSamp;
PredSamp := (MS_ADPCM_STATE.Samp1[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef1 +
MS_ADPCM_STATE.Samp2[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef2) div 256;
ErrorDelta := InData^[i] and 15;
if (ErrorDelta and 8) <> 0 then
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta - 16)
else
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta);
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32768 then PredSamp := -32768;
OutData^[pos] := PredSamp;
Inc(pos);
MS_ADPCM_STATE.Delta[0] := (MS_ADPCM_STATE.Delta[0]*adaptive[ErrorDelta]) div 256;
if MS_ADPCM_STATE.Delta[0] < 16 then MS_ADPCM_STATE.Delta[0] := 16;
MS_ADPCM_STATE.Samp2[0] := MS_ADPCM_STATE.Samp1[0];
MS_ADPCM_STATE.Samp1[0] := PredSamp;
end;
Len := pos*2;
end;
procedure TWaveIn.DecodeMSADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
var
pos, i, PredSamp, ErrorDelta : Integer;
begin
pos := 0;
OutData^[pos] := MS_ADPCM_STATE.Samp2[0];
Inc(pos);
OutData^[pos] := MS_ADPCM_STATE.Samp2[1];
Inc(pos);
OutData^[pos] := MS_ADPCM_STATE.Samp1[0];
Inc(pos);
OutData^[pos] := MS_ADPCM_STATE.Samp1[1];
Inc(pos);
for i := 0 to Len - 1 do
begin
PredSamp := (MS_ADPCM_STATE.Samp1[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef1 +
MS_ADPCM_STATE.Samp2[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef2) div 256;
ErrorDelta := InData^[i] shr 4;
if (ErrorDelta and 8) <> 0 then
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta - 16)
else
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta);
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32768 then PredSamp := -32768;
OutData^[pos] := PredSamp;
Inc(pos);
MS_ADPCM_STATE.Delta[0] := (MS_ADPCM_STATE.Delta[0]*adaptive[ErrorDelta]) div 256;
if MS_ADPCM_STATE.Delta[0] < 16 then MS_ADPCM_STATE.Delta[0] := 16;
MS_ADPCM_STATE.Samp2[0] := MS_ADPCM_STATE.Samp1[0];
MS_ADPCM_STATE.Samp1[0] := PredSamp;
PredSamp := (MS_ADPCM_STATE.Samp1[1]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[1]].Coef1 +
MS_ADPCM_STATE.Samp2[1]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[1]].Coef2) div 256;
ErrorDelta := InData^[i] and 15;
if (ErrorDelta and 8) <> 0 then
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[1]*(ErrorDelta - 16)
else
PredSamp := PredSamp + MS_ADPCM_STATE.Delta[1]*(ErrorDelta);
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32768 then PredSamp := -32768;
OutData^[pos] := PredSamp;
Inc(pos);
MS_ADPCM_STATE.Delta[1] := (MS_ADPCM_STATE.Delta[1]*adaptive[ErrorDelta]) div 256;
if MS_ADPCM_STATE.Delta[1] < 16 then MS_ADPCM_STATE.Delta[1] := 16;
MS_ADPCM_STATE.Samp2[1] := MS_ADPCM_STATE.Samp1[1];
MS_ADPCM_STATE.Samp1[1] := PredSamp;
end;
Len := pos*2;
end;
function Compare4(S1, S2 : PChar) : Boolean;
var
i, Diff : Byte;
begin
Result := False;
for i := 0 to 3 do
begin
Diff := Byte(S1[i]) - Byte(S2[i]);
if not (Diff in [0, 32, 224]) then Exit;
end;
Result := True;
end;
{$IFDEF LINUX}
function InputFunc(CData : Pointer; Stream : p_mad_stream) : Integer; cdecl;
var
WI : TWaveIn;
begin
WI := TWaveIn(CData);
if WI.InputDone then
begin
Result := MAD_FLOW_STOP;
Exit;
end;
WI.InputDone := True;
mad_stream_buffer(Stream, WI.Data, WI.DataLen);
Result := MAD_FLOW_CONTINUE;
end;
function OutputFunc(CData : Pointer; Header : p_mad_header; pcm : p_mad_pcm) : Integer; cdecl;
var
WI : TWaveIn;
WH : TWaveHeader;
i, framesize : Integer;
outsamples : array[0..2303] of SmallInt;
text : array[0..4] of Char;
begin
WI := TWaveIn(CData);
if not WI.HasFirstFrame then
begin
WI.FSR := pcm^.samplerate;
WI.FChan := pcm^.channels;
WI.FBPS := 16;
framesize := Ceil(144*Header^.bitrate/Header^.samplerate);
WI.FSize := Round(WI.DataLen/framesize*1152)*WI.FChan*2;
WI.FValid := True;
text := 'RIFF';
Move(text[0], WH.RIFF[0], 4);
WH.FileSize := WI.FSize + 44;
text := 'WAVE';
Move(text[0], WH.RIFFType[0], 4);
text := 'fmt ';
Move(text[0], WH.FmtChunkId[0], 4);
WH.FmtChunkSize := 16;
WH.FormatTag := 1;
WH.Channels := WI.FChan;
WH.SampleRate := WI.FSR;
WH.BitsPerSample := 16;
WH.BlockAlign := 2*WI.FChan;
WH.BytesPerSecond := WI.FSR * WH.BlockAlign;
text := 'data';
Move(text[0], WH.DataChunkId[0], 4);
WH.DataSize := WI.FSize;
WI.FStream.Size :=WI.FSize + 44;
WI.FStream.Seek(0, soFromBeginning);
WI.FStream.Write(WH, 44);
WI.HasFirstFrame := True;
end;
if pcm^.channels = 2 then
begin
for i := 0 to pcm^.length -1 do
begin
if pcm^.samples[0][i] >= MAD_F_ONE then
pcm^.samples[0][i] := MAD_F_ONE - 1;
if pcm^.samples[0][i] < -MAD_F_ONE then
pcm^.samples[0][i] := -MAD_F_ONE;
pcm^.samples[0][i] := pcm^.samples[0][i] shr (MAD_F_FRACBITS + 1 - 16);
outsamples[i shl 1] := pcm^.samples[0][i];
if pcm^.samples[1][i] >= MAD_F_ONE then
pcm^.samples[1][i] := MAD_F_ONE - 1;
if pcm^.samples[1][i] < -MAD_F_ONE then
pcm^.samples[1][i] := -MAD_F_ONE;
pcm^.samples[1][i] := pcm^.samples[1][i] shr (MAD_F_FRACBITS + 1 - 16);
outsamples[(i shl 1)+1] := pcm^.samples[1][i];
end;
WI.FStream.Write(outsamples[0], pcm^.length*4);
end else
begin
for i := 0 to pcm^.length -1 do
begin
if pcm^.samples[0][i] >= MAD_F_ONE then
pcm^.samples[0][i] := MAD_F_ONE - 1;
if pcm^.samples[0][i] < -MAD_F_ONE then
pcm^.samples[0][i] := -MAD_F_ONE;
pcm^.samples[0][i] := pcm^.samples[0][i] shr (MAD_F_FRACBITS + 1 - 16);
outsamples[i] := pcm^.samples[0][i];
end;
WI.FStream.Write(outsamples[0], pcm^.length*2);
end;
Result := MAD_FLOW_CONTINUE;
end;
function ErrorFunc(CData : Pointer; Stream : p_mad_stream; Frame : p_mad_frame) : Integer; cdecl;
begin
Result := MAD_FLOW_CONTINUE;
end;
{$ENDIF}
const
LookingForRIFF = 0;
LookingForWave = 1;
LookingForFMT = 2;
LookingForFACT = 3;
LookingForDATA = 4;
constructor TWaveIn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BufferSize := $8000;
_WavType := wtUnsupported;
end;
destructor TWaveIn.Destroy;
begin
inherited Destroy;
end;
procedure TWaveIn.OpenFile;
var
{$IFDEF WINDOWS}
WaveConverter: TWaveConverter;
ValidItems: LongWord;
Res: MMResult;
{$ENDIF}
{$IFDEF LINUX}
_decoder : mad_decoder;
{$ENDIF}
begin
FValid := True;
if FOpened = 0 then
begin
_WavType := wtUnsupported;
if not FStreamAssigned then
FStream := TFileStream.Create(FFileName, fmOpenRead) as TFileStream;
ReadRIFFHeader;
case Self._WavType of
wtUnsupported :
begin
FValid := False;
Inc(FOpened);
Exit;
end;
wtPCM:
begin
FSize := FStream.Size;
FTotalSamples := FSize div ((FBPS shr 3) * FChan);
end;
wtDVIADPCM :
begin
if FBPS <> 4 then
FValid := False;
FBPS := 16;
FTotalSamples := DVI_ADPCM_INFO.DataSize;
FSize := FTotalSamples*2*FChan;
end;
wtMSADPCM :
begin
FBPS := 16;
FSize := MS_ADPCM_INFO.DataSize*2*FChan;
FTotalSamples := MS_ADPCM_INFO.DataSize;
end;
wtACM :
begin
{$IFDEF WINDOWS}
(* Checking if the file is ACM encoded and if it is, decoding it.
Thanks to Jan Henrik Ejme, <jan.h.ejme@xhlp.com> for the
provided converter units. *)
try
WaveConverter := TWaveConverter.Create;
FStream.Position := 0;
WaveConverter.LoadStream(FStream);
with WaveConverter.NewFormat.Format do
begin
wFormatTag := WAVE_FORMAT_PCM;
ValidItems := ACM_FORMATSUGGESTF_WFORMATTAG;
Res := acmFormatSuggest(nil, WaveConverter.CurrentFormat.format,
WaveConverter.NewFormat.Format, SizeOf(TACMWaveFormat), ValidItems);
end;
if Res <> 0 then
begin
FValid := False;
WaveConverter.Free;
Exit;
end;
if WaveConverter.Convert <> 0 then
begin
FValid := False;
WaveConverter.Free;
Exit;
end else
begin
_MS := TMemoryStream.Create;
OldStream := FStream;
OldStreamAssigned := FStreamAssigned;
FStream := _MS;
_MS.Position := 0;
WaveConverter.SaveWavToStream(_MS);
FSize := _MS.Size;
_MS.Seek(0, soFromBeginning);
ReadRIFFHeader;
//WaveConverter.CurrentFormat.Format.wFormatTag;
WaveConverter.Free;
_wavType := wtACM;
end;
except
WaveConverter.Free;
end;
{$ENDIF}
{$IFDEF LINUX}
if not MADLibLoaded then
raise EACSException.Create(Format(strCoudntloadLib,['madlib']));
DataLen := FStream.Size;
GetMem(Data, DataLen);
FStream.Read(Data^, DataLen);
_MS := TMemoryStream.Create;
OldStream := FStream;
OldStreamAssigned := FStreamAssigned;
FStream := _MS;
HasFirstFrame := False;
InputDone := False;
mad_decoder_init(@_decoder, Self, InputFunc, nil, nil, OutputFunc, ErrorFunc, nil);
mad_decoder_run(@_decoder, MAD_DECODER_MODE_SYNC);
mad_decoder_finish(@_decoder);
FreeMem(Data);
FStream.Seek(0, soFromBeginning);
ReadRIFFHeader;
_wavType := wtACM;
{$ENDIF}
end;
end;
end;
Inc(FOpened);
end;
procedure TWaveIn.CloseFile;
begin
if FOpened = 1 then
begin
if not FStreamAssigned then FStream.Free
else if FSeekable then FStream.Seek(0, soFromBeginning);
if _WavType = wtACM then
begin
if Assigned(_MS) then
begin
if OldStreamAssigned then
FStream := OldStream
else
begin
FStream := nil;
OldStream.Free;
end;
// _MS.Free;
_MS := nil;
end;
end;
end;
if FOpened > 0 then Dec(FOpened);
end;
function TWaveIn.GetData(Buffer : Pointer; aBufferSize : Integer): Integer;
var
l, csize : Integer;
offs : Integer;
Data : Pointer;
begin
if not Busy then raise EACSException.Create(strStreamnotopen);
if BufStart > BufEnd then
begin
case _WavType of
wtDVIADPCM :
begin
if FOffset <> 0 then
begin
offs := (FStream.Position div DVI_ADPCM_INFO.BlockLength)
* DVI_ADPCM_INFO.SamplesPerBlock + Round((FOffset/100)*FTotalSamples);
if offs < 0 then offs := 0;
Seek(offs);
FPosition := (FStream.Position div DVI_ADPCM_INFO.BlockLength)
* DVI_ADPCM_INFO.SamplesPerBlock;
FPosition := FPosition*2*FChan;
FOffset := 0;
end;
if FSeekable then
begin
if FPosition >= FSize then
begin
if FLoop then
begin
Flush;
Init;
end else
begin
Result := 0;
Exit;
end;
end;
end;
BufStart := 1;
csize := DVI_ADPCM_INFO.BlockLength - FChan*4;
GetMem(Data, csize);
if ReadDVIADPCMBlock(Data) then
begin
if FChan = 2 then
begin
DecodeDVIADPCMStereo(Data, @buf[1], csize);
BufEnd := (csize)*4;
end else
begin
DecodeDVIADPCMMono(Data, @buf[1], csize);
BufEnd := (csize)*2;
FreeMem(Data);
end;
end else
begin
FreeMem(Data);
if not Seekable then
begin
Result := 0;
Exit;
end
else BufEnd := 0;
end;
end;
wtMSADPCM :
begin
if FOffset <> 0 then
begin
offs := (FStream.Position div MS_ADPCM_INFO.BlockLength)
* MS_ADPCM_INFO.SamplesPerBlock + Round((FOffset/100)*FTotalSamples);
if offs < 0 then offs := 0;
Seek(offs);
FPosition := (FStream.Position div MS_ADPCM_INFO.BlockLength)
* MS_ADPCM_INFO.SamplesPerBlock;
FPosition := FPosition*2*FChan;
FOffset := 0;
end;
if FPosition >= FSize then
begin
if FLoop then
begin
Flush;
Init;
end else
begin
Result := 0;
Exit;
end;
end;
BufStart := 1;
if FChan = 2 then
begin
csize := MS_ADPCM_INFO.BlockLength-SizeOf(TMSADPCMBlockHeaderStereo);
GetMem(Data, csize);
if ReadMSADPCMBlock(Data) then
begin
csize := MS_ADPCM_INFO.SamplesPerBlock-2;
DecodeMSADPCMStereo(Data, @buf, csize);
BufEnd := csize;
FreeMem(Data);
end else BufEnd := 0;
end else
begin
csize := MS_ADPCM_INFO.BlockLength-SizeOf(TMSADPCMBlockHeaderMono);
GetMem(Data, csize);
if ReadMSADPCMBlock(Data) then
begin
csize := MS_ADPCM_INFO.SamplesPerBlock-2;
DecodeMSADPCMMono(Data, @buf, csize);
BufEnd := csize;
FreeMem(Data);
end else BufEnd := 0;
end;
end;
wtPCM:
begin
if FOffset <> 0 then
begin
offs := Round((FOffset/100)*FSize);
FPosition := FPosition + offs;
if FPosition < 0 then FPosition := 0
else if FPosition > FSize then FPosition := FSize;
FStream.Seek((FPosition shr 2) shl 2, soFromBeginning); // align to 4-byte frame
FOffset := 0;
end;
BufStart := 1;
l := FStream.Read(buf, aBufferSize);
if FPosition+l >= FSize then
l := FSize - FPosition;
if l <=0 then
begin
if FLoop then
begin
Flush;
Init;
end else
begin
Result := 0;
Exit;
end;
end;
if l = 0 then
begin
if FLoop then
begin
Flush;
Init;
l := FStream.Read(buf, aBufferSize);
end else
begin
Result := 0;
Exit;
end;
end;
BufEnd := l;
end;
wtACM:
begin
if FOffset <> 0 then
begin
offs := Round((FOffset/100)*FSize);
FPosition := FPosition + offs;
if FPosition < 0 then FPosition := 0
else if FPosition > FSize then FPosition := FSize;
FStream.Seek((FPosition shr 2) shl 2, soFromBeginning); // align to 4-byte frame
FOffset := 0;
end;
BufStart := 1;
l := FStream.Read(buf, aBufferSize);
if FPosition+l >= FSize then
l := FSize - FPosition;
if l <=0 then
begin
if FLoop then
begin
Flush;
Init;
end else
begin
Result := 0;
Exit;
end;
end;
BufEnd := l;
end;
end;
end;
if aBufferSize < (BufEnd - BufStart + 1) then
Result := aBufferSize
else
Result := BufEnd - BufStart + 1;
Move(buf[BufStart-1], Buffer^, Result);
Inc(BufStart, Result);
Inc(FPosition, Result);
end;
function TWaveIn.Seek(SampleNum : Integer) : Boolean;
begin
Result := False;
if not FSeekable then Exit;
Result := True;
OpenFile;
case _WavType of
wtPCM :
begin
Stream.Seek(SampleNum*(Self.FBPS shr 3)*FChan+HeaderSize, soFromBeginning);
end;
wtDVIADPCM:
begin
Stream.Seek((SampleNum div DVI_ADPCM_INFO.SamplesPerBlock)*DVI_ADPCM_INFO.BlockLength + HeaderSize, soFromBeginning);
end;
wtMSADPCM:
begin
Stream.Seek((SampleNum div MS_ADPCM_INFO.SamplesPerBlock)*MS_ADPCM_INFO.BlockLength + HeaderSize, soFromBeginning);
end;
else
begin
Result := False;
end;
end;
CloseFile;
end;
procedure TWaveOut.FillHeaderPCM(var Header : TWaveHeader);
var
text : array[0..4] of Char;
begin
text := 'RIFF';
Move(text[0], Header.RIFF[0], 4);
Header.FileSize := FInput.Size + WaveHeaderOffs;
text := 'WAVE';
Move(text[0], Header.RIFFType[0], 4);
text := 'fmt ';
Move(text[0], Header.FmtChunkId[0], 4);
Header.FmtChunkSize := 16;
Header.FormatTag := WAVE_FORMAT_PCM;
Header.Channels := FInput.Channels;
Header.SampleRate := FInput.SampleRate;
Header.BitsPerSample := FInput.BitsPerSample;
Header.BlockAlign := (Header.BitsPerSample * Header.Channels) shr 3;
Header.BytesPerSecond := Header.SampleRate * Header.BlockAlign;
text := 'data';
Move(text[0], Header.DataChunkId[0], 4);
Header.DataSize := FInput.Size;
end;
procedure TWaveOut.FillHeaderDVIADPCM(var Header : TDVIADPCMHeader);
var
text : array[0..4] of Char;
samples : Integer;
begin
text := 'RIFF';
Move(text[0], Header.RIFF[0], 4);
text := 'WAVE';
Move(text[0], Header.RIFFType[0], 4);
text := 'fmt ';
Move(text[0], Header.FmtChunkId[0], 4);
Header.FmtChunkSize := 20;
Header.FormatTag := WAVE_FORMAT_DVI_IMA_ADPCM;
Header.Channels := FInput.Channels;
Header.SampleRate := FInput.SampleRate;
Header.BitsPerSample := 4;
Header.BlockAlign := FBlockAlign;
Header.SamplesPerBlock := (Header.BlockAlign- 4*FInput.Channels) * (2 div FInput.Channels) + 1;
Header.cbSize := 2;
Header.BytesPerSecond := (FInput.SampleRate div Header.SamplesPerBlock)*Header.BlockAlign;
samples := (FInput.Size div (FInput.BitsPerSample shr 3)) div FInput.Channels;
Header.DataSize := Round(samples/Header.SamplesPerBlock)*Header.BlockAlign;
Header.FileSize := Header.DataSize + SizeOf(TDVIADPCMHeader);
text := 'data';
Move(text[0], Header.DataChunkId[0], 4);
text := 'fact';
Move(text[0], Header.FactChunkId[0], 4);
Header.FactChunkSize := 4;
Header.DataLength := samples;
end;
procedure TWaveOut.EncodeDVIADPCMMono(InData : PACSBuffer16; OutData : PACSBuffer8);
var
i, j, Diff, PredSamp, Index : Integer;
Code : Byte;
Header : TDVIADPCMBlockHeader;
begin
FillChar(OutData[0], FBlockAlign, 0);
Header.Samp0 := FEncodeState.PredSamp_l;
Header.StepTableIndex := FEncodeState.Index_l;
Move(Header, OutData[0], SizeOf(Header));
PredSamp := FEncodeState.PredSamp_l;
Index := FEncodeState.Index_l;
for i := 0 to (FBlockAlign-4)*2 - 1 do
begin
Diff := InData[i] - PredSamp;
if Diff < 0 then
begin
Code := 8;
Diff := -Diff;
end else Code := 0;
if Diff >= StepTab[Index] then
begin
Code := Code or 4;
Diff := Diff-StepTab[Index];
end;
if Diff >= (StepTab[Index] shr 1) then
begin
Code := Code or 2;
Diff := Diff - (StepTab[Index] shr 1);
end;
if Diff >= (StepTab[Index] shr 2) then
Code := Code or 1;
j := (i shr 1)+4;
if (i and 1) = 0 then
OutData[j] := Code
else
OutData[j] := OutData[j] or (Code shl 4);
Diff := (StepTab[Index] shr 3);
if (Code and 4) <> 0 then Diff := Diff + StepTab[Index];
if (Code and 2) <> 0 then Diff := Diff + (StepTab[Index] shr 1);
if (Code and 1) <> 0 then Diff := Diff + (StepTab[Index] shr 2);
if (Code and 8) <> 0 then Diff := -Diff;
PredSamp := PredSamp + Diff;
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32767 then PredSamp := -32767;
Index := Index + IndexTab[Code];
if Index > 88 then Index := 88;
if Index < 0 then Index := 0;
end;
FEncodeState.Index_l := Index;
// State.PredSamp_l := PredSamp;
end;
procedure TWaveOut.EncodeDVIADPCMStereo(InData : PACSBuffer16; OutData : PACSBuffer8);
var
i, j, Diff, bPos, PredSamp, Index : Integer;
Code : Byte;
Header : TDVIADPCMBlockHeader;
begin
FillChar(OutData[0], FBlockAlign, 0);
Header.Samp0 := FEncodeState.PredSamp_l;
Header.StepTableIndex := FEncodeState.Index_l;
Move(Header, OutData[0], SizeOf(Header));
Header.Samp0 := FEncodeState.PredSamp_r;
Header.StepTableIndex := FEncodeState.Index_r;
i := 4;
Move(Header, OutData[i], SizeOf(Header));
PredSamp := FEncodeState.PredSamp_l;
Index := FEncodeState.Index_l;
for i := 0 to FBlockAlign - 9 do
begin
Diff := InData[i shl 1] - PredSamp;
if Diff < 0 then
begin
Code := 8;
Diff := -Diff;
end else Code := 0;
if Diff >= StepTab[Index] then
begin
Code := Code or 4;
Diff := Diff-StepTab[Index];
end;
if Diff >= (StepTab[Index] shr 1) then
begin
Code := Code or 2;
Diff := Diff - (StepTab[Index] shr 1);
end;
if Diff >= (StepTab[Index] shr 2) then
Code := Code or 1;
j := i shr 1;
bPos := (j div 4)*8 + (j mod 4) + 8;
if (i and 1) = 0 then
OutData[bPos] := Code
else
OutData[bPos] := OutData[bPos] or (Code shl 4);
Diff := (StepTab[Index] shr 3);
if (Code and 4) <> 0 then Diff := Diff + StepTab[Index];
if (Code and 2) <> 0 then Diff := Diff + (StepTab[Index] shr 1);
if (Code and 1) <> 0 then Diff := Diff + (StepTab[Index] shr 2);
if (Code and 8) <> 0 then Diff := -Diff;
PredSamp := PredSamp + Diff;
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32767 then PredSamp := -32767;
Index := Index + IndexTab[Code];
if Index > 88 then Index := 88;
if Index < 0 then Index := 0;
end;
FEncodeState.Index_l := Index;
FEncodeState.PredSamp_l := PredSamp;
PredSamp := FEncodeState.PredSamp_r;
Index := FEncodeState.Index_r;
for i := 0 to FBlockAlign - 9 do
begin
Diff := InData[(i shl 1)+1] - PredSamp;
if Diff < 0 then
begin
Code := 8;
Diff := -Diff;
end else Code := 0;
if Diff >= StepTab[Index] then
begin
Code := Code or 4;
Diff := Diff-StepTab[Index];
end;
if Diff >= (StepTab[Index] shr 1) then
begin
Code := Code or 2;
Diff := Diff - (StepTab[Index] shr 1);
end;
if Diff >= (StepTab[Index] shr 2) then
Code := Code or 1;
j := i shr 1;
bPos := (j div 4)*8 + (j mod 4) + 12;
if i and 1 = 0 then
OutData[bPos] := Code
else
OutData[bPos] := OutData[bPos] or (Code shl 4);
Diff := (StepTab[Index] shr 3);
if (Code and 4) <> 0 then Diff := Diff + StepTab[Index];
if (Code and 2) <> 0 then Diff := Diff + (StepTab[Index] shr 1);
if (Code and 1) <> 0 then Diff := Diff + (StepTab[Index] shr 2);
if (Code and 8) <> 0 then Diff := -Diff;
PredSamp := PredSamp + Diff;
if PredSamp > 32767 then PredSamp := 32767;
if PredSamp < -32767 then PredSamp := -32767;
Index := Index + IndexTab[Code];
if Index > 88 then Index := 88;
if Index < 0 then Index := 0;
end;
FEncodeState.Index_r := Index;
FEncodeState.PredSamp_r := PredSamp;
end;
constructor TWaveOut.Create;
begin
inherited Create(AOwner);
FBufferSize := $4000;
FWavType := wtPCM;
FBlockAlign := 512;
end;
destructor TWaveOut.Destroy;
begin
inherited Destroy;
end;
procedure TWaveOut.SetWavType;
begin
if Busy then Exit;
if (WT = wtPCM) or (WT = wtDVIADPCM) then
FWavType := WT;
end;
procedure TWaveOut.Prepare;
var
Header : TWaveHeader;
DVIADPCMHeader : TDVIADPCMHeader;
begin
GetMem(FBuffer,FBufferSize);
EndOfInput := False;
if not FStreamAssigned then
begin
if FFileName = '' then raise EACSException.Create(strFilenamenotassigned);
if (not FileExists(FFileName)) or (FFileMode = foRewrite) then
FStream := TFileStream.Create(FFileName, fmCreate or fmShareExclusive, FAccessMask)
else FStream := TFileStream.Create(FFileName, fmOpenReadWrite or fmShareExclusive, FAccessMask);
end;
FInput.Init;
if (FFileMode = foAppend) and (FStream.Size <> 0) then
begin
ReadRIFFHeader;
if not (FPrevWavType in [wtPCM, wtDVIADPCM]) then
begin
FInput.Flush;
if not FStreamAssigned then
begin
FStream.Free;
FStream := nil;
end;
raise EACSException.Create('Cannot append data to this .wav file.');
end;
FWavType := FPrevWavType;
end;
case FWavType of
wtPCM :
begin
if (FFileMode = foAppend) and (FStream.Size <> 0) then
begin
if (FPrevSR <> FInput.SampleRate) or
(FPrevBPS <> FInput.BitsPerSample) or
(FPrevCh <> FInput.Channels) then
begin
FInput.Flush;
if not FStreamAssigned then
begin
FStream.Free;
FStream := nil;
end;
raise EACSException.Create('Cannot append data in different audio format.');
end;
FStream.Seek(0, soFromEnd);
end else
begin
FillHeaderPCM(Header);
FStream.Write(Header, WaveHeaderOffs);
end;
end;
wtDVIADPCM :
begin
if FInput.BitsPerSample <> 16 then
begin
FInput.Flush;
if not FStreamAssigned then
begin
FStream.Free;
FStream := nil;
end;
raise EACSException.Create('Cannot encode 8 bit sound into ADPCM.');
end;
// FBlockAlign := 512;
if (FFileMode = foAppend) and (FStream.Size <> 0) then
begin
if (FPrevSR <> FInput.SampleRate) or
(FPrevCh <> FInput.Channels) then
begin
FInput.Flush;
if not FStreamAssigned then
begin
FStream.Free;
FStream := nil;
end;
raise EACSException.Create('Cannot append data in different audio format.');
end;
FStream.Seek(0, soFromEnd);
end else
begin
FillHeaderDVIADPCM(DVIADPCMHeader);
FStream.Write(DVIADPCMHeader, SizeOf(DVIADPCMHeader));
FEncodeState.Index_l := 0;
FEncodeState.Index_r := 0;
end;
end;
end;
end;
procedure TWaveOut.Done;
var
Size : Integer;
Hdr : TDVIADPCMHeader;
begin
if ((FInput.Size < 0) or (FFileMode = foAppend)) and (FStream <> nil) then
begin
case FWavType of
wtPCM:
begin
if FFileMode = foAppend then
begin
FStream.Seek(FDataSizeOffs, soFromBeginning);
Size := FStream.Size - HeaderSize;
FStream.Write(Size, 4);
end else
begin
Size := FStream.Size - 44;
FStream.Seek(DataSizeOffs, soFromBeginning);
FStream.Write(Size, 4);
end;
end;
wtDVIADPCM:
begin
if FFileMode = foAppend then
begin
FStream.Seek(FDataSizeOffs, soFromBeginning);
Size := FStream.Size - HeaderSize;
FStream.Write(Size, 4);
FStream.Seek(FLenOffs, soFromBeginning);
Size := (Size div FBlockAlign)*((FBlockAlign-FPrevCh*4)*(2 div FPrevCh) + 1);
FStream.Write(Size, 4);
end else
begin
Size := FStream.Size - SizeOf(TDVIADPCMHeader);
FStream.Seek(0, soFromBeginning);
Fstream.Read(Hdr, SizeOf(Hdr));
Hdr.DataSize := Size;
Hdr.DataLength := (Hdr.DataSize div Hdr.BlockAlign) * Hdr.SamplesPerBlock;
FStream.Seek(0, soFromBeginning);
FStream.Write(Hdr, SizeOf(Hdr));
end;
end;
end;
Size := FStream.Size;
FStream.Seek(4, soFromBeginning);
FStream.Write(Size, 4);
end;
if (not FStreamAssigned) and (FStream <> nil) then FStream.Free;
FInput.Flush;
FreeMem(FBuffer);
end;
function TWaveOut.DoOutput(Abort : Boolean):Boolean;
var
Len, l, m : Integer;
DVIInBuf : PACSBuffer16;
DVIOutBuf : PACSBuffer8;
P : PACSBuffer8;
BlockDataSize : Integer;
begin
// No exceptions Here
Result := True;
if not CanOutput then Exit;
Len := 0;
if Abort then
begin
(* We don't close file here to avoide exceptions
if output componenet's Stop method is called *)
Result := False;
Exit;
end;
if EndOfInput then
begin
Result := False;
Exit;
end;
case FWavType of
wtPCM :
begin
try
while InputLock do;
InputLock := True;
Len := Finput.GetData(@FBuffer[0], FBufferSize);
InputLock := False;
FStream.Write(FBuffer[0], Len);
except
end;
if Len > 0 then Result := True
else Result := False;
end;
wtDVIADPCM :
begin
BlockDataSize := (FBlockAlign - 4*FInput.Channels)*4 +2*FInput.Channels;
GetMem(DVIInBuf, BlockDataSize);
GetMem(DVIOutBuf, FBlockAlign);
P := PACSBuffer8(DVIInBuf);
try
if FInput.Channels = 2 then
begin
l := 0;
FillChar (DVIInBuf[0], BlockDataSize, 0);
while InputLock do;
InputLock := True;
while l <> BlockDataSize do
begin
m := Finput.GetData(@P[l], BlockDataSize-l);
if m = 0 then
begin
EndOfInput := True;
Break;
end;
Inc(l, m);
end;
Len := FBlockAlign;
InputLock := False;
FEncodeState.PredSamp_l := DVIInBuf[0];
m := 1;
FEncodeState.PredSamp_r := DVIInBuf[m];
m := 2;
EncodeDVIADPCMStereo(@DVIInBuf[m], @DVIOutBuf[0]);
FStream.Write(DVIOutBuf[0], FBlockAlign);
end else
begin
l := 0;
FillChar (DVIInBuf[0], BlockDataSize, 0);
while InputLock do;
InputLock := True;
while l <> BlockDataSize do
begin
m := Finput.GetData(@P[l], BlockDataSize-l);
if m = 0 then
begin
EndOfInput := True;
Break;
end;
Inc(l, m);
end;
Len := FBlockAlign;
InputLock := False;
FEncodeState.PredSamp_l := DVIInBuf[0];
m := 1;
EncodeDVIADPCMMono(@DVIInBuf[m], @DVIOutBuf[0]);
FStream.Write(DVIOutBuf[0], FBlockAlign);
end;
except
end;
FreeMem(DVIInBuf);
FreeMem(DVIOutBuf);
if Len > 0 then Result := True
else Result := False;
end;
end;
end;
function TWaveIn.GetWavType : TWavType;
begin
OpenFile;
Result := _WavType;
CloseFile;
end;
procedure TWaveOut.SetFileMode;
begin
FFileMode := aMode;
end;
procedure TWaveIn.SetBufferSize(S: Integer);
begin
end;
function TWaveIn.ReadDVIADPCMBlock(aData : Pointer) : Boolean;
var
block : array of Byte;
BH : TDVIADPCMBlockHeader;
begin
Result := False;
if Seekable then
if FStream.Position >= FStream.Size then Exit;
SetLength(Block, DVI_ADPCM_INFO.BlockLength);
if FStream.Read(Block[0], Length(Block))= 0 then Exit;
Result := True;
Move(Block[0], BH, SizeOf(BH));
DVI_ADPCM_STATE.valprev_l := BH.Samp0;
DVI_ADPCM_STATE.index_l := BH.StepTableIndex;
if FChan = 2 then
begin
Move(Block[4], BH, SizeOf(BH));
DVI_ADPCM_STATE.valprev_r := BH.Samp0;
DVI_ADPCM_STATE.index_r := BH.StepTableIndex;
Move(Block[8], aData^, DVI_ADPCM_INFO.BlockLength-8);
end else
Move(Block[4], aData^, DVI_ADPCM_INFO.BlockLength-4);
end;
function TWaveIn.ReadMSADPCMBlock(bData : Pointer) : Boolean;
var
block : array of Byte;
BHM : TMSADPCMBlockHeaderMono;
BHS : TMSADPCMBlockHeaderStereo;
begin
Result := False;
if FStream.Position >= FStream.Size then Exit;
Result := True;
SetLength(Block, MS_ADPCM_INFO.BlockLength);
FStream.Read(Block[0], Length(Block));
if FChan = 1 then
begin
Move(Block[0], BHM, SizeOf(BHM));
MS_ADPCM_STATE.predictor[0] := BHM.predictor;
MS_ADPCM_STATE.Delta[0] := BHM.Delta;
MS_ADPCM_STATE.Samp1[0] := BHM.Samp1;
MS_ADPCM_STATE.Samp2[0] := BHM.Samp2;
Move(Block[SizeOf(BHM)], bData^, MS_ADPCM_INFO.BlockLength-SizeOf(BHM));
end else
begin
Move(Block[0], BHS, SizeOf(BHS));
MS_ADPCM_STATE := BHS;
Move(Block[SizeOf(BHS)], bData^, MS_ADPCM_INFO.BlockLength-SizeOf(BHS));
end;
end;
procedure TWaveIn.ReadRIFFHeader;
var
i : Integer;
WordVal : Word;
IntVal : Integer;
Buff : array[0..$fff] of Char;
State : Integer;
ChunkSize : Integer;
begin
_WavType := wtUnsupported;
State := LookingForRIFF;
i := 4;
FStream.Read(Buff[0], 4);
while i < $2000 do
begin
case State of
LookingForRIFF :
begin
if not Compare4(@Buff[i-4], 'RIFF') then
begin
FStream.Read(Buff[i], 1);
Inc(i);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
State := LookingForWAVE;
end;
end;
LookingForWAVE :
begin
if not Compare4(@Buff[i-4], 'WAVE') then
begin
FStream.Read(Buff[i], 1);
Inc(i);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
State := LookingForFMT;
end;
end;
LookingForFMT :
begin
if not Compare4(@Buff[i-4], 'fmt ') then
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
FStream.Read(Buff[i], 4);
Inc(i, 4);
end else
begin
Stream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
Move(Buff[i-ChunkSize], WordVal, 2);
case WordVal of
WAVE_FORMAT_PCM : _WavType := wtPCM;
WAVE_FORMAT_IMA_ADPCM : _WavType := wtDVIADPCM;
WAVE_FORMAT_ADPCM : _WavType := wtMSADPCM;
WAVE_FORMAT_MP3 : _WavType := wtACM;
else Exit;
end;
Move(Buff[i+2-ChunkSize], WordVal, 2);
FChan := WordVal;
Move(Buff[i+4-ChunkSize], IntVal, 4);
FSR := IntVal;
Move(Buff[i+12-ChunkSize], WordVal, 2);
if _WavType = wtDVIADPCM then
DVI_ADPCM_INFO.BlockLength := WordVal else
MS_ADPCM_INFO.BlockLength := WordVal;
Move(Buff[i+14-ChunkSize], WordVal, 2);
FBPS := WordVal;
if _WavType in [wtDVIADPCM, wtMSADPCM, wtACM] then
begin
Move(Buff[i+18-ChunkSize], WordVal, 2);
if _WavType = wtDVIADPCM then
DVI_ADPCM_INFO.SamplesPerBlock := WordVal
else MS_ADPCM_INFO.SamplesPerBlock := WordVal;
if _WavType = wtMSADPCM then
begin
Move(Buff[i+20-ChunkSize], WordVal, 2);
MS_ADPCM_INFO.NumCoeff := WordVal;
Move(Buff[i+22-ChunkSize], MS_ADPCM_INFO.CoefSets[0], MS_ADPCM_INFO.NumCoeff*SizeOf(TMS_ADPCM_COEF_SET));
end;
State := LookingForFACT;
end else State := LookingForDATA;
FStream.Read(Buff[i], 4);
Inc(i, 4);
end;
end;
LookingForFACT :
begin
if not Compare4(@Buff[i-4], 'fact') then
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
FStream.Read(Buff[i], 4);
Inc(i, 4);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
Move(Buff[i-ChunkSize], IntVal, 4);
if _WavType = wtDVIADPCM then
DVI_ADPCM_INFO.DataSize := IntVal
else
MS_ADPCM_INFO.DataSize := IntVal;
FStream.Read(Buff[i], 4);
Inc(i, 4);
State := LookingForDATA;
end;
end;
LookingForDATA :
begin
if not Compare4(@Buff[i-4], 'data') then
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
FStream.Read(Buff[i], 4);
Inc(i, 4);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
if _WavType = wtPCM then
Move(Buff[i-4], FSize, 4);
HeaderSize := i;
Exit;
end;
end;
end;
if Seekable then
if FStream.Position >= FStream.Size then Break;
end;
_WavType := wtUnsupported
end;
procedure TWaveOut.ReadRIFFHeader;
var
i : Integer;
WordVal : Word;
Buff : array[0..$fff] of Char;
State : Integer;
ChunkSize : Integer;
begin
FPrevWavType := wtUnsupported;
State := LookingForRIFF;
i := 4;
FStream.Read(Buff[0], 4);
while i < $2000 do
begin
case State of
LookingForRIFF :
begin
if not Compare4(@Buff[i-4], 'RIFF') then
begin
FStream.Read(Buff[i], 1);
Inc(i);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
State := LookingForWAVE;
end;
end;
LookingForWAVE :
begin
if not Compare4(@Buff[i-4], 'WAVE') then
begin
FStream.Read(Buff[i], 1);
Inc(i);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
State := LookingForFMT;
end;
end;
LookingForFMT :
begin
if not Compare4(@Buff[i-4], 'fmt ') then
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
FStream.Read(Buff[i], 4);
Inc(i, 4);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
Move(Buff[i-ChunkSize], WordVal, 2);
case WordVal of
WAVE_FORMAT_PCM : FPrevWavType := wtPCM;
WAVE_FORMAT_IMA_ADPCM : FPrevWavType := wtDVIADPCM;
else Exit;
end;
Move(Buff[i+2-ChunkSize], FPrevCh, 2);
Move(Buff[i+4-ChunkSize], FPrevSR, 4);
Move(Buff[i+12-ChunkSize], FBlockAlign, 2);
Move(Buff[i+14-ChunkSize], FPrevBPS, 2);
if FPrevWavType = wtDVIADPCM then
State := LookingForFACT
else State := LookingForDATA;
FStream.Read(Buff[i], 4);
Inc(i, 4);
end;
end;
LookingForFACT :
begin
if not Compare4(@Buff[i-4], 'fact') then
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
FStream.Read(Buff[i], 4);
Inc(i, 4);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FLenOffs := i;
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
Move(Buff[i-ChunkSize], FPrevLen, 4);
FStream.Read(Buff[i], 4);
Inc(i, 4);
State := LookingForDATA;
end;
end;
LookingForDATA :
begin
if not Compare4(@Buff[i-4], 'data') then
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
Move(Buff[i-4], ChunkSize, 4);
FStream.Read(Buff[i], ChunkSize);
Inc(i, ChunkSize);
FStream.Read(Buff[i], 4);
Inc(i, 4);
end else
begin
FStream.Read(Buff[i], 4);
Inc(i, 4);
FDataSizeOffs := i-4;
Move(Buff[i-4], FPrevDataSize, 4);
HeaderSize := i;
Exit;
end;
end;
end;
if FStream.Position >= FStream.Size then Break;
end;
FPrevWavType := wtUnsupported
end;
procedure TWaveOut.SetBlockSize;
begin
if not Busy then
if BS <> 0 then
if (BS mod 4) = 0 then FBlockAlign := BS;
end;
initialization
FileFormats.Add('wav','Waveform Audio',TWaveOut);
FileFormats.Add('wav','Waveform Audio',TWaveIn);
end.