674 lines
19 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_vorbis.pas,v $
Revision 1.8 2006/07/04 17:12:45 z0m3ie
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)
Revision 1.4 2006/01/01 18:46:40 z0m3ie
*** empty log message ***
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.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.3 2005/09/10 08:25:40 z0m3ie
*** empty log message ***
Revision 1.2 2005/08/22 20:17:01 z0m3ie
changed Headers to log
changed mail adress
}
unit acs_vorbis;
{$ifdef fpc}
{$mode delphi}
{$endif}
{$DEFINE USE_VORBIS_11}
interface
uses
ACS_File,Classes, SysUtils, ACS_Classes, ogg, vorbiscodec, VorbisFile, VorbisEnc,ACS_Strings
{$IFDEF LINUX}
,baseunix;
{$ENDIF}
{$IFDEF WINDOWS}
,Windows,Dialogs;
{$ENDIF}
type
TVorbisBitRate = (brAutoSelect, br45, br48, br56, br64, br80, br96,
br112, br128, br144, br160, br192, br224, br256, br320, br499);
TVorbisOut = class(TACSCustomFileOut)
private
FComments : TStringList;
FSerial : Integer;
FDesiredNominalBitrate : TVorbisBitRate;
FDesiredMaximumBitrate : TVorbisBitRate;
FMinimumBitrate : TVorbisBitRate;
OggSS : ogg_stream_state;
OggPg : ogg_page;
OggPk : ogg_packet;
VInfo : vorbis_info;
VComm : vorbis_comment;
Vdsp : vorbis_dsp_state;
VBlock : vorbis_block;
header, header_comm, header_code : ogg_packet;
FCompression : Single;
EndOfStream : Boolean;
procedure SetComments(vComments : TStringList);
procedure SetDesiredNominalBitrate(Value : TVorbisBitRate);
procedure SetDesiredMaximumBitrate(Value : TVorbisBitRate);
procedure SetMinimumBitrate(Value : TVorbisBitRate);
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 Compression : Single read FCompression write FCompression stored True;
property Comments : TStringList read FComments write SetComments stored True;
property DesiredMaximumBitrate : TVorbisBitRate read FDesiredMaximumBitrate write SetDesiredMaximumBitrate;
property DesiredNominalBitrate : TVorbisBitRate read FDesiredNominalBitrate write SetDesiredNominalBitrate;
property MinimumBitrate : TVorbisBitRate read FMinimumBitrate write SetMinimumBitrate;
property Serial : Integer read FSerial write FSerial;
//property Vendor : String read FVendor write FVendor;
end;
TVorbisIn = class(TACSCustomFileIn)
private
FComments : TStringList;
// FVendor : String;
VFile : OggVorbis_File;
cursec : Integer;
FMaxBitrate: Integer;
FNominalBitrate: Integer;
FMinBitrate : Integer;
EndOfStream : Boolean;
function GetMaxBitrate: Integer;
function GetNominalBitrate: Integer;
function GetMinBitrate : Integer;
function GetComments : TStringList;
function GetBitStreams : Integer;
function GetInstantBitRate : Integer;
function GetCurrentBitStream : Integer;
procedure SetCurrentBitStream(BS : 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;
property BitStreams : Integer read GetBitStreams;
property Comments : TStringList read GetComments;
property CurrentBitStream : Integer read GetCurrentBitStream write SetCurrentBitStream;
property InstantBitRate : Integer read GetInstantBitRate;
//property Vendor : String read FVendor;
property MaxBitrate: Integer read GetMaxBitrate;
property MinBitrate: Integer read GetMinBitrate;
property NominalBitrate: Integer read GetNominalBitrate;
end;
implementation
function cbRead(ptr : Pointer; size, nmemb : Cardinal;const datasource : Pointer) : Cardinal; cdecl;
var
VI : TVorbisIn;
Buffer : array of Byte;
begin
VI := TVorbisIn(datasource);
SetLength(Buffer, size*nmemb);
Result := VI.FStream.Read(Buffer[0], size*nmemb);
Move(Buffer[0], ptr^, Result);
Setlength(Buffer,0);
Buffer := nil;
end;
function cbSeek(const datasource : Pointer; offset : ogg_int64_t; whence : Integer) : Integer; cdecl;
var
VI : TVorbisIn;
Origin : TSeekOrigin;
begin
VI := TVorbisIn(datasource);
if not VI.Seekable then
begin
Result := -1;
Exit;
end;
case whence of
SEEK_SET : Origin := TSeekOrigin(soFromBeginning);
SEEK_CUR : Origin := TSeekOrigin(soFromCurrent);
SEEK_END : Origin := TSeekOrigin(soFromEnd);
end;
Result := VI.FStream.Seek(offset, Origin);
end;
function cbClose(const datasource : Pointer) : Integer; cdecl;
var
VI : TVorbisIn;
begin
VI := TVorbisIn(datasource);
if not VI.FStreamAssigned then VI.FStream.Free
else VI.FStream.Seek(0, soFromBeginning);
Result := 0;
end;
function cbTell(const datasource : Pointer) : Integer; cdecl;
var
VI : TVorbisIn;
begin
VI := TVorbisIn(datasource);
Result := VI.FStream.Position
end;
function VorbisBitrateToInt(Bitrate : TVorbisBitrate) : Integer;
begin
case Bitrate of
br45 : Result := 45000;
br48 : Result := 48000;
br56 : Result := 46000;
br64 : Result := 64000;
br80 : Result := 80000;
br96 : Result := 96000;
br112 : Result := 112000;
br128 : Result := 128000;
br144 : Result := 144000;
br160 : Result := 160000;
br192 : Result := 192000;
br224 : Result := 224000;
br256 : Result := 256000;
br320 : Result := 320000;
br499 : Result := 499000;
else Result := -1;
end;
end;
constructor TVorbisOut.Create;
begin
inherited Create(AOwner);
FBufferSize := $10000;
VORBISLoadLibrary;
FCompression := 0.2;
FComments := TStringList.Create;
FDesiredNominalBitrate := br64;
FDesiredMaximumBitrate := br112;
FMinimumBitrate := br48;
if not (csDesigning in ComponentState) then
begin
VORBISLoadLibrary;
if not LiboggLoaded then
raise EACSException.Create(Format(strCoudntloadLib,[Liboggpath]));
if not LibvorbisLoaded then
raise EACSException.Create(Format(strCoudntloadLib,[LibvorbisPath]));
if not LibvorbisfileLoaded then
raise EACSException.Create(Format(strCoudntloadLib,[LibvorbisfilePath]));
//if not LibvorbisencLoaded then
//raise EACSException.Create(Format(strCoudntloadLib,[LibvorbisencPath]));
end;
end;
destructor TVorbisOut.Destroy;
begin
FComments.Free;
inherited Destroy;
end;
procedure TVorbisOut.SetComments;
begin
FComments.Assign(vComments);
end;
procedure TVorbisOut.Prepare;
var
i, maxbr, minbr, nombr : Integer;
Name, Value : String;
rm : ovectl_ratemanage2_arg;
begin
GetMem(FBuffer,FBufferSize);
if not FStreamAssigned then
begin
if not Assigned(FInput) then
raise EACSException.Create(strInputNotAssigned);
if FFileName = '' then raise EACSException.Create(strNoFileOpened);
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 then
FStream.Seek(0, soFromEnd);
EndOfStream := False;
vorbis_info_init(VInfo);
if DesiredNominalBitrate = brAutoSelect then
begin
{$IFNDEF USE_VORBIS_11}
vorbis_encode_init_vbr(VInfo, FInput.Channels, FInput.SampleRate, FCompression);
{$ENDIF}
{$IFDEF USE_VORBIS_11}
vorbis_encode_setup_vbr(VInfo, FInput.Channels, FInput.SampleRate, FCompression);
vorbis_encode_setup_init(VInfo);
{$ENDIF}
end else
begin
nombr := VorbisBitrateToInt(FDesiredNominalBitrate);
maxbr := VorbisBitrateToInt(FDesiredMaximumBitrate);
if maxbr < nombr then maxbr := nombr;
minbr := VorbisBitrateToInt(Self.FMinimumBitrate);
if minbr < 0 then minbr := nombr;
vorbis_encode_init(VInfo, FInput.Channels, FInput.SampleRate, maxbr, nombr, minbr);
end;
vorbis_comment_init(VComm);
for i := 0 to FComments.Count - 1 do
begin
Name := FComments.Names[i];
Value := FComments.Values[Name];
vorbis_comment_add_tag(VComm, PChar(Name), PChar(Value));
end;
vorbis_analysis_init(Vdsp, VInfo);
vorbis_block_init(Vdsp, VBlock);
ogg_stream_init(OggSS, FSerial);
vorbis_analysis_headerout(Vdsp, VComm, header, header_comm, header_code);
ogg_stream_packetin(OggSS, header);
ogg_stream_packetin(OggSS, header_comm);
ogg_stream_packetin(OggSS, header_code);
while ogg_stream_flush(OggSS, OggPg) <> 0 do
begin
FStream.Write(OggPg.header^, OggPg.header_len);
FStream.Write(OggPg.body^, OggPg.body_len);
end;
end;
procedure TVorbisOut.Done;
begin
if not FStreamAssigned then
FStream.Free;
FInput.Flush;
FComments.Clear;
ogg_stream_clear(OggSS);
vorbis_block_clear(VBlock);
vorbis_dsp_clear(Vdsp);
vorbis_comment_clear(VComm);
vorbis_info_clear(VInfo);
FreeMem(FBuffer);
end;
function TVorbisOut.DoOutput(Abort : Boolean):Boolean;
var
Len, i,chc : Integer;
out_buf : PPFloat;
tmpBuf1, tmpBuf2 : PFloat;
begin
// No exceptions Here
Result := True;
if not CanOutput then Exit;
if Abort or EndOfStream then
begin
(* We don't close file here to avoide exceptions
if output componenet's Stop method is called *)
Result := False;
Exit;
end;
while InputLock do;
InputLock := True;
chc := Finput.Channels;
Len := Finput.GetData(@FBuffer[0], FBufferSize);
InputLock := False;
if Len <> 0 then
begin
if chc = 2 then
begin
out_buf := vorbis_analysis_buffer(Vdsp, FBufferSize shr 2);
(* A bit of pointer arithmetics. What is easy in C
is not so easy in Pascal. *)
tmpBuf1 := out_buf^;
Inc(out_buf);
tmpBuf2 := out_buf^;
for i:=0 to (Len shr 2)-1 do
begin
tmpBuf1[i] := FBuffer[i*2]/$8000;
tmpBuf2[i] := FBuffer[i*2+1]/$8000;
end;
vorbis_analysis_wrote(Vdsp, Len shr 2);
end else
begin
out_buf := vorbis_analysis_buffer(Vdsp, FBufferSize shr 1);
for i:=0 to (Len shr 1)-1 do
out_buf^[i] := FBuffer[i]/$8000;
vorbis_analysis_wrote(Vdsp, Len shr 1);
end;
end else
vorbis_analysis_wrote(Vdsp, 0);
while vorbis_analysis_blockout(Vdsp, VBlock) = 1 do
begin
vorbis_analysis(VBlock, nil);
vorbis_bitrate_addblock(VBlock);
while vorbis_bitrate_flushpacket(Vdsp, OggPk) = 1 do
begin
ogg_stream_packetin(OggSS, OggPk);
while not EndOfStream do
begin
if ogg_stream_pageout(OggSS, OggPg) = 0 then Break;
FStream.Write(OggPg.header^, OggPg.header_len);
FStream.Write(OggPg.body^, OggPg.body_len);
if ogg_page_eos(OggPg) <> 0 then EndOfStream := True;
end;
end;
end;
end;
constructor TVorbisIn.Create;
begin
inherited Create(AOwner);
BufferSize := $2000;
FComments := TStringList.Create;
if not (csDesigning in ComponentState) then
begin
VORBISLoadLibrary;
if not LiboggLoaded then
raise EACSException.Create(Format(strCoudntloadLib,[LiboggPath]));
if not LibvorbisLoaded then
raise EACSException.Create(Format(strCoudntloadLib,[LibvorbisPath]));
if not LibvorbisfileLoaded then
raise EACSException.Create(Format(strCoudntloadLib,[LibvorbisfilePath]));
//if not LibvorbisencLoaded then
//raise EACSException.Create(Format(strCoudntloadLib,[LibvorbisencPath]));
end;
end;
destructor TVorbisIn.Destroy;
begin
FComments.Free;
inherited Destroy;
end;
procedure TVorbisIn.OpenFile;
var
PVComm : PVORBIS_COMMENT;
PVInfo : PVORBIS_INFO;
PComment : PPChar;
Comment : PChar;
Callbacks : OV_CALLBACKS;
begin
if FOpened = 0 then
begin
FValid := True;
EndOfStream := False;
if not FStreamAssigned then
try
Stream := TFileStream.Create(FileName, fmOpenRead) as TFileStream;
except
FValid := False;
Exit;
end;
Callbacks.read_func := cbRead;
Callbacks.close_func := cbClose;
Callbacks.seek_func := cbSeek;
Callbacks.tell_func := cbTell;
ov_open_callbacks(Self, VFile, nil, 0, Callbacks);
FComments.Clear;
{ PVComm := ov_comment(VFile, -1);
PComment := PVComm.user_comments;
Comment := PComment^;
while Comment <> nil do
begin
FComments.Add(String(Comment));
Inc(LongWord(PComment), 4);
Comment := PComment^;
end;}
// FVendor := PVComm.vendor;
PVInfo := ov_info(VFile, -1);
FChan := PVInfo.channels;
FSR := PVInfo.rate;
FBPS := 16;
FMaxBitrate := PVInfo.bitrate_upper;
FNominalBitrate := PVInfo.bitrate_nominal;
FMinBitrate := PVInfo.bitrate_lower;
FTotalSamples := ov_pcm_total(VFile, -1);
FSize := (FTotalSamples shl 1) * PVInfo.channels;
cursec := -1;
FTime := Round(ov_time_total(VFile, -1));
// ov_pcm_seek(VFile, FOffset);
end;
Inc(FOpened);
end;
procedure TVorbisIn.CloseFile;
begin
if FOpened = 1 then
begin
if ov_seekable(VFile) <> 0 then
ov_pcm_seek(VFile, 0);
ov_clear(VFile);
end;
if FOpened > 0 then Dec(FOpened);
end;
function TVorbisIn.GetData(Buffer : Pointer; BufferSize : Integer): Integer;
var
l, 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)*FSize);
FPosition := FPosition + offs;
if FPosition < 0 then FPosition := 0
else if FPosition > FSize then FPosition := FSize;
// tmp := (FPosition/FSize)*FTime;
if ov_seekable(VFile) <> 0 then
ov_pcm_seek(VFile, (FPosition shr 1) div FChan);
FOffset := 0;
end;
BufStart := 1;
BufEnd := 0;
if not EndOfStream then
begin
(* The ov_read function can return data in quite small chunks
(of about 512 bytes). We keep reading data until the buffer is filled
or there is no more data to read. *)
while BufEnd < BufferSize do
begin
l := ov_read(VFile, @FBuffer[BufEnd + 1], BufferSize - BufEnd, 0, 2, 1, @cursec);
if l <= 0 then
begin
EndOfStream := True;
Break;
end;
Inc(BufEnd, l);
if (FPosition + BufEnd) >= FSize then
begin
BufEnd := FSize - FPosition;
if BufEnd <= 0 then EndOfStream := True;
Break;
end;
end;
end;
if EndOfStream and FLoop then
begin
Flush;
Init;
EndOfStream := False;
while BufEnd < BufferSize do
begin
l := ov_read(VFile, @FBuffer[BufEnd + 1], BufferSize - BufEnd, 0, 2, 1, @cursec);
if l <= 0 then
begin
EndOfStream := True;
Break;
end;
Inc(BufEnd, l);
end;
end;
end;
if BufferSize < (BufEnd - BufStart + 1)
then Result := BufferSize
else Result := BufEnd - BufStart + 1;
Move(FBuffer[BufStart], Buffer^, Result);
Inc(BufStart, Result);
Inc(FPosition, Result);
end;
function TVorbisIn.GetMaxBitrate : Integer;
begin
OpenFile;
Result := FMaxBitrate;
CloseFile;
end;
function TVorbisIn.GetNominalBitrate : Integer;
begin
OpenFile;
Result := FNominalBitrate;
CloseFile;
end;
function TVorbisIn.GetComments : TStringList;
begin
OpenFile;
Result := FComments;
CloseFile;
end;
function TVorbisIn.GetMinBitrate : Integer;
begin
OpenFile;
Result := FMinBitrate;
CloseFile;
end;
procedure TVorbisOut.SetFileMode;
begin
FFileMode := aMode;
end;
function TVorbisIn.GetBitStreams : Integer;
begin
Result := 0;
if Busy then
begin
if ov_seekable(VFile)<>0 then
Result := ov_streams(VFile);
end;
end;
function TVorbisIn.GetInstantBitRate : Integer;
begin
Result := 0;
if Busy then
begin
Result := ov_bitrate_instant(VFile);
end;
end;
function TVorbisIn.GetCurrentBitStream : Integer;
begin
Result := -1;
if Busy then
begin
if ov_seekable(VFile)<>0 then
Result := VFile.current_link;
end;
end;
procedure TVorbisIn.SetCurrentBitStream;
var
Offset : POGG_INT64_T;
begin
if Busy then
begin
if ov_seekable(VFile)<>0 then
if (BS >= 0) and (BS < ov_streams(VFile)) then
begin
Offset := VFile.offsets;
Inc(Offset, BS);
FStream.Seek(Offset^, soFromBeginning);
end;
end;
end;
procedure TVorbisOut.SetDesiredNominalBitrate;
begin
FDesiredNominalBitrate := Value;
if FMinimumBitrate > FDesiredNominalBitrate then
FMinimumBitrate := FDesiredNominalBitrate;
if FDesiredMaximumBitrate < FDesiredNominalBitrate then
FDesiredMaximumBitrate := FDesiredNominalBitrate;
if FDesiredNominalBitrate = brAutoSelect then
FDesiredMaximumBitrate := brAutoSelect;
end;
procedure TVorbisOut.SetDesiredMaximumBitrate;
begin
if FDesiredNominalBitrate = brAutoSelect then Exit;
if (Value = brAutoSelect) or (Value >= FDesiredNominalBitrate) then
FDesiredMaximumBitrate := Value;
end;
procedure TVorbisOut.SetMinimumBitrate;
begin
if Value <= FDesiredNominalBitrate then
FMinimumBitrate := Value;
end;
function TVorbisIn.Seek(SampleNum : Integer) : Boolean;
begin
Result := False;
if not FSeekable then Exit;
Result := True;
OpenFile;
ov_pcm_seek(VFile, SampleNum);
CloseFile;
end;
initialization
FileFormats.Add('ogg','Ogg Vorbis',TVorbisOut);
FileFormats.Add('ogg','Ogg Vorbis',TVorbisIn);
end.