unit Phaser;

interface

type

TAllPass = class(TObject)
private
  fDelay: Single;
  fA1,fZM1: Single;
  fSampleRate: Single;
public
  constructor Create;
  destructor Destroy; override;
  function Process(const x:single):single;
  procedure SetDelay(v:Single);
  property SampleRate : Single read fSampleRate write fSampleRate;
end;

TPhaser = class(TObject)
private
  fZM1: Single;
  fDepth: Single;
  fLFOInc: Single;
  fLFOPhase: Single;
  fFeedBack: Single;
  fRate: Single;
  fMinimum: Single;
  fMaximum: Single;
  fMin: Single;
  fMax: Single;
  fPhase: Single;
  fSampleRate: Single;
  fAllpassDelay: array[0..5] of TAllPass;
  procedure SetSampleRate(v:Single);
  procedure SetMinimum(v:Single);
  procedure SetMaximum(v:Single);
  procedure SetRate(v:Single);
  procedure Calculate;
public
  constructor Create;
  destructor Destroy; override;
  function Process(const x: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 Minimum: Single read fMin write SetMinimum;
  property Maximum: Single read fMax write SetMaximum;
  property Rate: Single read fRate write SetRate;
  property Phase: Single read fPhase write fPhase;
end;

implementation

const kDenorm=1E-25;

function f_Abs(f:Single):Single;
asm
fld f.Single
fabs
end;

function Tanh2a(x:Single):Single;
var a,b:Single;
begin
a:=f_abs(x);
b:=12+a*(6+a*(3+a));
Result:=(x*b)/(a*b+24);
end;

constructor TAllpass.Create;
begin
inherited;
fA1:=0;
fZM1:=0;
end;

destructor TAllpass.Destroy;
begin
inherited;
end;

function TAllpass.Process(const x:single):single;
begin
Result:=x*-fA1+fZM1;
fZM1:=Result*fA1+x;
end;

procedure TAllpass.SetDelay(v:Single);
begin
fDelay:=v;
fA1:=(1-v)/(1+v);
end;

constructor TPhaser.Create;
var i: Integer;
begin
inherited;
fSampleRate:=44100;
fFeedBack:=0.7;
fLFOPhase:=0;
fDepth:=1;
fZM1:=0;
Minimum:=400;
Maximum:=1600;
Rate:=5;
for i:=0 to Length(fAllpassDelay)-1
do fAllpassDelay[i]:=TAllpass.Create;
Calculate;
end;

destructor TPhaser.Destroy;
var i: Integer;
begin
for i:=0 to Length(fAllpassDelay)-1
do fAllpassDelay[i].Free;
inherited;
end;

procedure TPhaser.SetRate(v:Single);
begin
fLFOInc:=2*Pi*(v/SampleRate);
end;

procedure TPhaser.Calculate;
begin
fMin:=fMinimum/(fSampleRate/2);
fMax:=fMaximum/(fSampleRate/2);
end;

procedure TPhaser.SetMinimum(v:Single);
begin
fMinimum:=v;
Calculate;
end;

procedure TPhaser.SetMaximum(v:Single);
begin
fMaximum:=v;
Calculate;
end;

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

function TPhaser.Process(const x:single):single;
var d: Single;
i: Integer;
begin
d:=fMin+(fMax-fMin)*((sin(fLFOPhase+fPhase)+1)/2);
fLFOPhase:=fLFOPhase+fLFOInc;
if fLFOPhase>=Pi*2
then fLFOPhase:=fLFOPhase-Pi*2;
for i:=0 to 5 do fAllpassDelay[i].SetDelay(d);
Result:= fAllpassDelay[0].Process(
fAllpassDelay[1].Process(
fAllpassDelay[2].Process(
fAllpassDelay[3].Process(
fAllpassDelay[4].Process(
fAllpassDelay[5].Process(kDenorm+x+fZM1*fFeedBack))))));
fZM1:=tanh2a(Result);
Result:=tanh2a(1.4*(x+Result*fDepth));
end;

end.