unit Flange;

interface

const
MaxFLABUFLEN = 4000;
FLABUFLEN = 400;
pi2 = 2*pi;
pid2 = pi/2;
pi32 = 3*pid2;

type

  TFlanger = class(TObject)
    private
      fFLLine: array[0..MaxFLABUFLEN-1] of Single;
      fDelay: Single;
      fDepth: Single;
      fLFOInc: Single;
      fLFOPhase: Single;
      fFeedBack: Single;
      fRate: Single;
      fCount: integer;
      fPhase: Single;
      fSampleRate: Single;
      fWet: Single;
      fdry: Single;
      procedure SetSampleRate(v:Single);
      procedure SetRate(v:Single);
      procedure SetPhase(v:Single);
      function Tri(x:single):single; //Функция треугольного LFO
    public
      constructor Create;
      destructor Destroy; override;
      procedure Flush;
      function Process(const v:single):single;
      property SampleRate : Single read fSampleRate write SetSampleRate;
      property Depth: Single read fDepth write fDepth; //0..1
      property Feedback: Single read fFeedback write fFeedback; // 0..<1
      property Rate: Single read fRate write SetRate;
      property Phase: Single read fPhase write SetPhase;
      property Wet: Single read fwet write fwet;
      property Dry: Single read fdry write fdry;
    end;

implementation

constructor TFlanger.Create;
begin
inherited;
fSampleRate:=44100;
fFeedBack:=0;
fLFOPhase:=0;
fDepth:=1;
fRate:=0.5;
Rate:=0.5;
fPhase:=0;
fCount:=0;
fwet:=1;
fdry:=1;
Flush;
end;

destructor TFlanger.Destroy;
begin
inherited;
end;

function TFlanger.Tri(x:single):single; 
begin
if x>=pi2 then x:=x-pi2*trunc(x/pi2);
if x<0 then x:=x+pi2*trunc(1-x/pi2);
result:=x*2/pi;
if x>pid2 then result:=2-result;
if x>pi32 then result:=-2-result;
end;

procedure TFlanger.Flush;
begin
ZeroMemory(@fFLLine,SizeOf(fFLLine));
end;

procedure TFlanger.SetRate(v:Single);
begin
fRate:=v;
fLFOInc:=2*Pi*((v+fPhase)/SampleRate);
end;

procedure TFlanger.SetPhase(v:Single);
begin
fPhase:=v;
SetRate(fRate);
end;

procedure TFlanger.SetSampleRate(v:Single);
begin
fSampleRate:=v;
end;

function TFlanger.Process(const v:single):single;
var
back:double;
index0,index_1,index1,index2:integer;
c0,c1,c2,c3,x,y_1,y0,y1,y2:single;
begin
fDelay:=FLABUFLEN/2+(FLABUFLEN-FLABUFLEN/2)*fDepth*((tri(fLFOPhase)+1)/2); //Сюда можно поставить любой другой LFO
fLFOPhase:=fLFOPhase+fLFOInc;
if fLFOPhase>=Pi*2
then fLFOPhase:=fLFOPhase-Pi*2;
back:=fCount-fDelay;
if back<0.0 then back:=FLABUFLEN+back;
index0:=Trunc(back); //тут начинается самое ответственное - интерполяция
index_1:=index0-1;
index1:=index0+1;
index2:=index0+2;
if index_1<0 then index_1:=FLABUFLEN-1;
if index1>=FLABUFLEN then index1:=0;
if index2>=FLABUFLEN then index2:=0;
y_1:=fFLLine[index_1];
y0:=fFLLine[index0];
y1:=fFLLine[index1];
y2:=fFLLine[index2];
x:=back-index0;
c0:=y0;
c1:=0.5*(y1-y_1);
c2:=y_1-2.5*y0+2.0*y1-0.5*y2;
c3:=0.5*(y2-y_1)+1.5*(y0-y1);
result:=fwet*(((c3*x+c2)*x+c1)*x+c0)+v*fdry;
fFLLine[fCount]:=v+result*fFeedBack;
inc(fCount);
if fCount>=FLABUFLEN then fCount:=0;
end;

end.