pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
901b92fa7253da596d484795c088fd52c0c54b41
lazarus-ccr/components/acs/Src/fileformats/acs_flac.pas
christian_u 5d957a8c60 removed libc dependency 
fixed compiling



git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2819 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2013-11-01 16:14:55 +00:00

596 lines
19 KiB
ObjectPascal
Raw Blame History

(*
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_flac.pas,v $
Revision 1.7 2006/07/09 16:40:35 z0m3ie
*** empty log message ***
Revision 1.6 2006/07/04 17:12:45 z0m3ie
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)
Revision 1.2 2005/12/30 11:10:57 z0m3ie
some corrections to lazarus-linux depending things
Revision 1.1 2005/12/19 18:36:38 z0m3ie
*** empty log message ***
Revision 1.4 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.3 2005/11/28 21:57:24 z0m3ie
mostly FileOut fixes
moved PBuffer to PBuffer8
set all to dynamically Buffering
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_flac;
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
ACS_File,Classes, SysUtils, ACS_Types, ACS_Classes, FLAC,
{$IFDEF LINUX}
baseunix;
{$ENDIF}
{$IFDEF WIN32}
Windows;
{$ENDIF}
type
TFLACOut = class(TACSCustomFileOut)
private
_encoder : PFLAC__SeekableStreamEncoder;
FBufSize : Integer;
FVerify : Boolean;
FBlockSize : Word;
FBestModelSearch : Boolean;
FEnableMidSideStereo : Boolean;
FMaxLPCOrder : Word;
EndOfInput : Boolean;
FEnableLooseMidSideStereo : Boolean;
FQLPCoeffPrecision : Word;
FQLPCoeffPrecisionSearch : Boolean;
FMaxResidualPartitionOrder : Word;
FMinResidualPartitionOrder : Word;
procedure SetEnableLooseMidSideStereo(val : Boolean);
procedure SetBestModelSearch(val : Boolean);
protected
procedure Done; override;
function DoOutput(Abort : Boolean):Boolean; override;
procedure Prepare; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BestModelSearch : Boolean read FBestModelSearch write SetBestModelSearch;
property BlockSize : Word read FBlockSize write FBlockSize;
property EnableMidSideStereo : Boolean read FEnableMidSideStereo write FEnableMidSideStereo;
property EnableLooseMidSideStereo : Boolean read FEnableLooseMidSideStereo write SetEnableLooseMidSideStereo;
property MaxLPCOrder : Word read FMaxLPCOrder write FMaxLPCOrder;
property MaxResidualPartitionOrder : Word read FMaxResidualPartitionOrder write FMaxResidualPartitionOrder;
property MinResidualPartitionOrder : Word read FMinResidualPartitionOrder write FMinResidualPartitionOrder;
property QLPCoeffPrecision : Word read FQLPCoeffPrecision write FQLPCoeffPrecision;
property QLPCoeffPrecisionSearch : Boolean read FQLPCoeffPrecisionSearch write FQLPCoeffPrecisionSearch;
property Verify : Boolean read FVerify write FVerify;
end;
TFLACIn = class(TACSCustomFileIn)
private
Buff : PACSBuffer8;
_decoder : PFLAC__SeekableStreamDecoder;
FBlockSize: Integer;
BytesPerBlock : Integer;
EndOfStream : Boolean;
MinFrameSize : Integer;
protected
procedure OpenFile; override;
procedure CloseFile; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetData(Buffer : Pointer; BufferSize : Integer): Integer; override;
function Seek(SampleNum : Integer) : Boolean; override;
end;
implementation
type
FLACBuf = array[0..0] of FLAC__int32;
PFLACBuf = ^FLACBuf;
function EncWriteCBFunc(encoder : PFLAC__SeekableStreamEncoder;
buffer : PFLAC__byte;
bytes, samples, current_frame : LongWord;
client_data : Pointer) : Integer; cdecl;
var
FLACOut : TFLACOut;
begin
FLACOut := TFLACOut(client_data);
Result := FLAC__SEEKABLE_STREAM_ENCODER_OK;
try
FLACOut.FStream.Write(buffer^, bytes);
except
Result := FLAC__SEEKABLE_STREAM_ENCODER_WRITE_ERROR;
end;
end;
function EncSeekCBFunc(encoder : PFLAC__SeekableStreamEncoder;
absolute_byte_offset : FLAC__uint64;
client_data : Pointer) : Integer; cdecl;
var
FLACOut : TFLACOut;
begin
FLACOut := TFLACOut(client_data);
Result := FLAC__SEEKABLE_STREAM_ENCODER_SEEK_STATUS_OK;
try
FLACOut.FStream.Seek(absolute_byte_offset, soFromBeginning);
except
Result := FLAC__SEEKABLE_STREAM_ENCODER_SEEK_ERROR;
end;
end;
function DecReadCBFunc(decoder : PFLAC__SeekableStreamDecoder;
buffer : PFLAC__byte;
var bytes : LongWord;
client_data : Pointer) : Integer; cdecl;
var
FLACIn : TFLACIn;
begin
FLACIn := TFLACIn(client_data);
Result := FLAC__SEEKABLE_STREAM_DECODER_READ_STATUS_OK;
if FLACIn.FStream.Position >= FLACIn.FStream.Size then
begin
Result := FLAC__SEEKABLE_STREAM_DECODER_END_OF_STREAM;
Exit;
end;
try
bytes := FLACIn.FStream.Read(buffer^, bytes);
except
Result := FLAC__SEEKABLE_STREAM_DECODER_READ_ERROR;
end;
end;
function DecSeekCBFunc(decoder : PFLAC__SeekableStreamDecoder;
absolute_byte_offset : FLAC__uint64;
client_data : Pointer) : Integer; cdecl;
var
FLACIn : TFLACIn;
begin
FLACIn := TFLACIn(client_data);
Result := FLAC__SEEKABLE_STREAM_DECODER_SEEK_STATUS_OK;
try
FLACIn.FStream.Seek(absolute_byte_offset, soFromBeginning);
except
Result := FLAC__SEEKABLE_STREAM_DECODER_SEEK_STATUS_ERROR;
end;
end;
function DecTellCBFunc(decoder : PFLAC__SeekableStreamDecoder;
var absolute_byte_offset : FLAC__uint64;
client_data : Pointer) : Integer; cdecl;
var
FLACIn : TFLACIn;
begin
FLACIn := TFLACIn(client_data);
Result := FLAC__SEEKABLE_STREAM_DECODER_TELL_STATUS_OK;
try
absolute_byte_offset := FLACIn.FStream.Position;
except
Result := FLAC__SEEKABLE_STREAM_DECODER_TELL_STATUS_ERROR;
end;
end;
function DecLengthCBFunc(decoder : PFLAC__SeekableStreamDecoder;
var stream_length : FLAC__uint64;
client_data : Pointer) : Integer; cdecl;
var
FLACIn : TFLACIn;
begin
FLACIn := TFLACIn(client_data);
Result := FLAC__SEEKABLE_STREAM_DECODER_LENGTH_STATUS_OK;
try
stream_length := FLACIn.FStream.Size;
except
Result := FLAC__SEEKABLE_STREAM_DECODER_LENGTH_STATUS_ERROR;
end;
end;
function DecEOFCBFunc(decoder : PFLAC__SeekableStreamDecoder;
client_data : Pointer) : Boolean; cdecl;
var
FLACIn : TFLACIn;
begin
FLACIn := TFLACIn(client_data);
if FLACIn.FStream.Position >= FLACIn.FStream.Size then Result := True
else Result := False;
end;
function DecWriteCBFunc(decoder : PFLAC__SeekableStreamDecoder;
frame : PFLAC__Frame;
buffer : PFLACChannels;
client_data : Pointer) : Integer; cdecl;
var
FLACIn : TFLACIn;
Header : PFLAC__FrameHeader;
buffer1 : PFLACIntBuf;
buffer2 : PFLACIntBuf;
B16 : PACSBuffer16;
i : Integer;
begin
FLACIn := TFLACIn(client_data);
Header := PFLAC__FrameHeader(frame);
FLACIn.FBlockSize := Header.blocksize;
FLACIn.BytesPerBlock := FLACIn.FBlockSize*(FLACIn.FBPS shr 3)*FLACIn.FChan;
GetMem(FLACIn.Buff, FLACIn.BytesPerBlock);
// FillChar(FLACIn.Buff[0], FLACIn.BytesPerBlock, 255);
if FLACIn.FBPS = 16 then
begin
B16 := PACSBuffer16(FLACIn.Buff);
if FLACIn.FChan = 1 then
begin
buffer1 := buffer[0];
for i := 0 to FLACIn.FBlockSize-1 do B16[i] := buffer1[i]
end else
begin
buffer1 := buffer[0];
buffer2 := buffer[1];
for i := 0 to FLACIn.FBlockSize-1 do
begin
B16[i shl 1] := buffer1[i];
B16[(i shl 1)+1] := buffer2[i];
end;
end;
end else
begin
if FLACIn.FChan = 1 then
begin
buffer1 := buffer[0];
for i := 0 to FLACIn.FBlockSize-1 do FLACIn.Buff[i] := buffer1[i];
end else
begin
buffer1 := buffer[0];
buffer2 := buffer[1];
for i := 0 to FLACIn.FBlockSize-1 do
begin
FLACIn.Buff[i shl 1] := buffer1[i];
FLACIn.Buff[(i shl 1)+1] := buffer2[i];
end;
end;
end;
Result := FLAC__SEEKABLE_STREAM_ENCODER_OK;
end;
procedure DecMetadataCBProc(decoder : PFLAC__SeekableStreamDecoder;
metadata : PFLAC__StreamMetadata;
client_data : Pointer); cdecl;
var
FLACIn : TFLACIn;
P : Pointer;
FI : PFLACInfo;
begin
if LongWord(metadata^) <> 0 then Exit;
P := metadata;
(*
STREAMINFO block format differs in different
FLAC codec versions, so we are trying to be flexible here.
*)
while LongWord(P^) = 0 do Inc(P, 4);
Inc(P, 4);
if LongWord(P^) = 0 then Inc(P, 4);
FI := PFLACInfo(P);
FLACIn := TFLACIn(client_data);
FLACIn.FSR := FI.sample_rate;
FLACIn.FChan := FI.channels;
if FLACIn.FChan > 2 then FLACIn.FValid := False;
FLACIn.FBPS := FI.bits_per_sample;
if FLACIn.FChan > 16 then FLACIn.FValid := False;
FLACIn.FTotalSamples := FI.total_samples1;
if FLACIn.FTotalSamples = 0 then
FLACIn.FTotalSamples := FI.total_samples2;
FLACIn.FSize := FLACIn.FTotalSamples*(FLACIn.FBPS shr 3)*FLACIn.FChan;
FLACIn.MinFrameSize := FI.min_framesize;
end;
procedure DecErrorCBProc(decoder : PFLAC__SeekableStreamDecoder;
status : Integer;
client_data : Pointer); cdecl;
var
FLACIn : TFLACIn;
begin
FLACIn := TFLACIn(client_data);
FLACIn.FValid := False;
end;
constructor TFLACOut.Create;
begin
inherited Create(AOwner);
FVerify := False;
FBufferSize := $6000;
FBlockSize := 4608;
FBestModelSearch := False;
FEnableMidSideStereo := True;
if not (csDesigning in ComponentState) then
if not LibFLACLoaded then
raise EACSException.Create(LibFLACPath + ' library could not be loaded.');
end;
destructor TFLACOut.Destroy;
begin
inherited Destroy;
end;
procedure TFLACOut.Prepare;
begin
if not FStreamAssigned then
begin
if FFileName = '' then raise EACSException.Create('File name is not assigned.');
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;
EndOfInput := False;
_encoder := FLAC__seekable_stream_encoder_new;
if _encoder = nil then
raise EACSException.Create('Failed to initialize FLAC encoder.');
FInput.Init;
FLAC__seekable_stream_encoder_set_verify(_encoder, FVerify);
FLAC__seekable_stream_encoder_set_channels(_encoder, FInput.Channels);
FLAC__seekable_stream_encoder_set_bits_per_sample(_encoder, FInput.BitsPerSample);
FLAC__seekable_stream_encoder_set_sample_rate(_encoder, FInput.SampleRate);
if FInput.Channels = 2 then
begin
FLAC__seekable_stream_encoder_set_do_mid_side_stereo(_encoder, FEnableMidSideStereo);
FLAC__seekable_stream_encoder_set_loose_mid_side_stereo(_encoder, FEnableLooseMidSideStereo);
end;
FLAC__seekable_stream_encoder_set_blocksize(_encoder, FBlockSize);
FLAC__seekable_stream_encoder_set_max_lpc_order(_encoder, FMaxLPCOrder);
if FQLPCoeffPrecision + FInput.BitsPerSample > 31 then FQLPCoeffPrecision := 31 - FInput.BitsPerSample;
FLAC__seekable_stream_encoder_set_qlp_coeff_precision(_encoder, FQLPCoeffPrecision);
FLAC__seekable_stream_encoder_set_do_qlp_coeff_prec_search(_encoder, FQLPCoeffPrecisionSearch);
FLAC__seekable_stream_encoder_set_min_residual_partition_order(_encoder, FMinResidualPartitionOrder);
FLAC__seekable_stream_encoder_set_max_residual_partition_order(_encoder, FMaxResidualPartitionOrder);
FLAC__seekable_stream_encoder_set_do_exhaustive_model_search(_encoder, FBestModelSearch);
if FInput.Size > 0 then
FLAC__seekable_stream_encoder_set_total_samples_estimate(_encoder, Round(FInput.Size/(FInput.BitsPerSample shr 3)/FInput.Channels));
FLAC__seekable_stream_encoder_set_seek_callback(_encoder, EncSeekCBFunc);
FLAC__seekable_stream_encoder_set_write_callback(_encoder, EncWriteCBFunc);
FLAC__seekable_stream_encoder_set_client_data(_encoder, Self);
if FLAC__seekable_stream_encoder_init(_encoder) <>
FLAC__SEEKABLE_STREAM_ENCODER_OK then
begin
FInput.Flush;
raise EACSException.Create('Failed to initialize FLAC encoder.');
end;
//TODO: Recreate this stuff with uffersize more equal to FBufferSize
FBufSize := FBufferSize div FBlockSize;
FBufSize := FBufSize * (FInput.BitsPerSample shr 3) * FInput.Channels;
GetMem(FBuffer, FBufSize);
end;
procedure TFLACOut.Done;
begin
if not FStreamAssigned then
FLAC__seekable_stream_encoder_finish(_encoder);
FLAC__seekable_stream_encoder_delete(_encoder);
if FBuffer <> nil then
FreeMem(FBuffer);
FBuffer := nil;
FStream.Free;
FInput.Flush;
end;
function TFLACOut.DoOutput(Abort : Boolean):Boolean;
var
Len, i, l, samples : Integer;
FB : PFLACBuf;
B16 : PACSBuffer16;
begin
Result := True;
if not CanOutput then Exit;
if Abort or EndOfInput then
begin
Result := False;
Exit;
end;
while InputLock do;
InputLock := True;
Len := 0;
while Len < FBufSize do
begin
l := Finput.GetData(@FBuffer[Len], FBufSize-Len);
Inc(Len, l);
if l = 0 then
begin
EndOfInput := True;
Break;
end;
end;
InputLock := False;
if Len = 0 then
begin
Result := False;
Exit;
end;
samples := (Len shl 3) div Finput.BitsPerSample;
GetMem(FB, samples*SizeOF(FLAC__int32));
if FInput.BitsPerSample = 16 then
begin
B16 := @FBuffer[0];
for i := 0 to samples - 1 do FB[i] := B16[i];
end else
for i := 0 to samples - 1 do FB[i] := FBuffer[i];
if not FLAC__seekable_stream_encoder_process_interleaved(_encoder, @FB[0], samples div FInput.Channels) then
raise EACSException.Create('Failed to encode data.');
FreeMem(FB);
end;
procedure TFLACOut.SetEnableLooseMidSideStereo;
begin
if Val then FEnableMidSideStereo := True;
FEnableLooseMidSideStereo := Val;
end;
procedure TFLACOut.SetBestModelSearch;
begin
if Val then
begin
FEnableMidSideStereo := True;
FEnableLooseMidSideStereo := False;
end;
FBestModelSearch := Val;
end;
constructor TFLACIn.Create;
begin
inherited Create(AOwner);
if not (csDesigning in ComponentState) then
if not LibFLACLoaded then
raise EACSException.Create(LibFLACPath + ' library could not be loaded.');
end;
destructor TFLACIn.Destroy;
begin
CloseFile;
inherited Destroy;
end;
procedure TFLACIn.OpenFile;
begin
Inc(FOpened);
if FOpened = 1 then
begin
if (not FStreamAssigned) and (FFileName = '') then
raise EACSException.Create('File name is not assigned');
if not FStreamAssigned then FStream := TFileStream.Create(FFileName, fmOpenRead, fmShareDenyNone);
FValid := True;
_decoder := FLAC__seekable_stream_decoder_new;
if _decoder = nil then
raise EACSException.Create('Failed to initialize FLAC decoder.');
// FLAC__seekable_stream_decoder_set_metadata_ignore_all(_decoder);
FLAC__seekable_stream_decoder_set_read_callback(_decoder, DecReadCBFunc);
FLAC__seekable_stream_decoder_set_seek_callback(_decoder, DecSeekCBFunc);
FLAC__seekable_stream_decoder_set_tell_callback(_decoder, DecTellCBFunc);
FLAC__seekable_stream_decoder_set_length_callback(_decoder, DecLengthCBFunc);
FLAC__seekable_stream_decoder_set_eof_callback(_decoder, DecEOFCBFunc);
FLAC__seekable_stream_decoder_set_write_callback(_decoder, DecWriteCBFunc);
FLAC__seekable_stream_decoder_set_metadata_callback(_decoder, DecMetadataCBProc);
FLAC__seekable_stream_decoder_set_error_callback(_decoder, DecErrorCBProc);
FLAC__seekable_stream_decoder_set_client_data(_decoder, Self);
if FLAC__seekable_stream_decoder_init(_decoder) <> FLAC__SEEKABLE_STREAM_DECODER_OK then
raise EACSException.Create('Failed to initialize FLAC decoder.');
if not FLAC__seekable_stream_decoder_process_until_end_of_metadata(_decoder) then
FValid := False;
EndOfStream := False;
end;
end;
procedure TFlacIn.CloseFile;
begin
if FOpened = 1 then
begin
if _decoder <> nil then
begin
FLAC__seekable_stream_decoder_flush(_decoder);
FLAC__seekable_stream_decoder_finish(_decoder);
FLAC__seekable_stream_decoder_delete(_decoder);
_decoder := nil;
end;
if Buff <> nil then FreeMem(Buff);
Buff := nil;
if not FStreamAssigned then FStream.Free
else FStream.Seek(0, soFromBeginning);
end;
if FOpened > 0 then Dec(FOpened);
end;
function TFLACIn.GetData(Buffer : Pointer; BufferSize : Integer): Integer;
var
dec_state, offs : Integer;
begin
if not Busy then raise EACSException.Create('The Stream is not opened');
if BufStart >= BufEnd then
begin
if FOffset <> 0 then
begin
offs := Round((FOffset/100)*Self.FTotalSamples);
FPosition := FPosition + offs*(FBPS shr 3)*FChan;
if FPosition < 0 then FPosition := 0
else if FPosition > FSize then FPosition := FSize;
Seek((FPosition div (FBPS shr 3)) div FChan);
FOffset := 0;
end;
BufStart := 0;
BufEnd := 0;
if FPosition+MinFrameSize > FSize then EndOfStream := True;
if EndOfStream then
begin
if FLoop then
begin
Flush;
Init;
end else
begin
Result := 0;
Exit;
end;
end;
if Buff <> nil then FreeMem(Buff);
Buff := nil;
if not FLAC__seekable_stream_decoder_process_single(_decoder) then
begin
dec_state := FLAC__seekable_stream_decoder_get_state(_decoder);
if dec_state = FLAC__SEEKABLE_STREAM_DECODER_END_OF_STREAM then
begin
EndOfStream := True;
Result := 0;
Exit;
end
else raise EACSException.Create('Error reading FLAC file');
end else BufEnd := Self.BytesPerBlock;
end;
if BufferSize < (BufEnd - BufStart)
then Result := BufferSize
else Result := BufEnd - BufStart;
Move(Buff[BufStart], Buffer^, Result);
Inc(BufStart, Result);
Inc(FPosition, Result);
end;
function TFLACIn.Seek(SampleNum : Integer) : Boolean;
begin
Result := FLAC__seekable_stream_decoder_seek_absolute(_decoder, Samplenum);
end;
initialization
FileFormats.Add('flac','Free Lossless Audio Codec',TFLACIn);
FileFormats.Add('flac','Free Lossless Audio Codec',TFLACOut);
end.
Reference in New Issue View Git Blame Copy Permalink