unit Audio;

//Audio-hantering i ZzDC

interface

uses ZClasses, Animators;

const
  AudioRate = 22050;  //22khz

  //Realtime constants
  RtTimeStep = 1.0 / 50;
  RtBufferLength = Round(AudioRate * RtTimeStep);
  RtBufferCount = 4;

type
  //One unit of sound used internally
  TSoundUnit = single;
  //Type for mixing sounds, must be the same or higher precision than TSoundUnit
  TSoundMixUnit = single;
  //One unit of sound when output to platform
  TSoundOutputUnit = smallint;
  PSoundOutputUnit = ^TSoundOutputUnit;

  TSoundOutputUnits = array[0..1] of TSoundOutputUnit;
  PSoundOutputUnits = ^TSoundOutputUnits;

  TMusic = class;
  TNote = class;

  TSoundBase = class(TZComponent)
  private
    //ADSR envelope för att kontrollera volym
    EnvState : (esAttack,esSustain,esRelease);
    //EnvVolume är current volume kontrollerad av envelope
    EnvTime,EnvVolume,EnvRate : single;
    procedure Reset; virtual;
  protected
    procedure DefineProperties(List: TZPropertyList); override;
    procedure UpdateEnvelope(const TimeStep : single);
    procedure PlayNote(Music : TMusic; Note : TNote); virtual; abstract;
  public
    Volume : single;  //0..1
    Length : single;  //Length in seconds
    BaseFrequency : single;
    Modulators : TAnimatorGroup;
    AttackTime,ReleaseTime : single;
    PlayingCount : integer; //nr of channels playing this sound
    AlreadyPlayingAction : (apaIgnore,apaRestart);
    //Returnerar true ifall det finns mer data att hämta
    function GetMoreData(var Data : pointer; var DataSize : integer) : boolean; virtual; abstract;
    procedure PrepareMoreData; virtual;
    procedure Play; virtual; abstract;
    {$ifndef minimal}
    constructor Create(OwnerList: TZComponentList); override;
    {$endif}
  end;

  //Complex prerendered sound
  TSoundPreRendered = class(TSoundBase)
  private
    Generated : boolean;
    function Tick : TSoundUnit;
    procedure Reset; override;
    procedure Generate;
    procedure FreeData;
  protected
    procedure DefineProperties(List: TZPropertyList); override;
    procedure PlayNote(Music : TMusic; Note: TNote); override;
  public
    Oscillators : TZComponentList;
    Filters : TZComponentList;
    //Data used by platform-routine
    Data : pointer;
    DataSize : integer;
    destructor Destroy; override;
    procedure Update; override;
    function GetMoreData(var Data: Pointer; var DataSize: Integer): Boolean; override;
    procedure Play; override;
   end;

  //Generates a waveform
  TSoundOscillator = class(TZComponent)
  private
    OwnerSound : TSoundPreRendered;
    WaveInc : single;
    NoiseValue : single;
    function Tick : TSoundUnit;
    procedure PropChanged;
    procedure Reset;
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Waveform : (wfSine,wfSquare,wfSaw,wfNoise,wfExpression);
    Frequency : single;
    Amplitude : single;
    Expression : TZExpressionPropValue;
    WaveIndex : single;
  end;

  //Process a soundunit
  TSoundFilter = class(TZComponent)
  protected
    function Process(const I : TSoundUnit) : TSoundUnit; virtual; abstract;
    procedure Reset; virtual;
  end;

  TMoogFilter = class(TSoundFilter)
  private
    fA   : array[1..5] of single;
    fOld : TSoundUnit;
    f2vg : single;
    fAcr : single;
    procedure FreqCalc;
  protected
    function Process(const I : TSoundUnit) : TSoundUnit; override;
    procedure Reset; override;
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Frequency : single;
    Resonance : single;
  end;

  TFilterOverdrive = class(TSoundFilter)
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  protected
    function Process(const I : TSoundUnit) : TSoundUnit; override;
  public
    Amount : single;
  end;

  TPlaySound = class(TCommand)
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Sound : TSoundBase;
    procedure Execute; override;
    {$ifndef minimal}
    function GetDisplayName: String; override;
    {$endif}
  end;

  TFilterDelay = class(TSoundFilter)
  private
    //Max 2 seconds delay
    Buffer : array[0..AudioRate*2] of TSoundUnit;
    InPoint,OutPoint : integer;
  protected
    procedure DefineProperties(List: TZPropertyList); override;
    procedure Reset; override;
  protected
    function Process(const I : TSoundUnit) : TSoundUnit; override;
  public
    Amount : single;
    Length : single;
  end;

  TSoundRealTime = class(TSoundBase)
  private
    //Two buffers, prepare one while playing the other to prevent pauses
    Buffer : array[0..RtBufferCount-1] of array [0..RtBufferLength-1] of TSoundOutputUnit;
    CurTime : single;
    CurBuf : integer;
    CurValue1,CurValue2 : TSoundOutputUnit;
    //Statevars för integerfilter
    FilterFb,FilterIntCut : integer;
    Buf0,Buf1 : integer;
    //Statevars för delay
    DelayBuffer : array[0..AudioRate*2] of TSoundOutputUnit;
    DelayInPoint,DelayOutPoint : integer;
    procedure Reset; override;
    procedure GenerateTimeStep;
    function IntegerFilter(const Input:TSoundOutputUnit) : TSoundOutputUnit;
    function IntegerDelay(const Input:TSoundOutputUnit) : TSoundOutputUnit;
  protected
    procedure DefineProperties(List: TZPropertyList); override;
    procedure PlayNote(Music : TMusic; Note: TNote); override;
  public
    PulseWidth : single;
    UseFilter : boolean;
    TestFloatFilter : boolean;
    FilterCutoff : single;
    FilterQ : single;
    UseDelay : boolean;
    DelayLength : single;
    Osc1Freq,Osc2Freq : single;
    UseOsc2 : boolean;
    function GetMoreData(var Data: Pointer; var DataSize: Integer): Boolean; override;
    procedure PrepareMoreData; override;
    procedure Play; override;
  end;


//Music
  TNote = class(TZComponent)
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    NoteNr : byte;
    InstrumentNr : byte;
    Length : single;  //1=normal length
  end;

  TPattern = class(TZComponent)
  private
    Music : TMusic;
    IsFinished : boolean;
    procedure Advance;
    procedure Reset(Owner: TMusic);
  protected
    CurNoteI : integer;
    LastNoteI : integer;
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Length : (ple16,ple32,ple64);
    Notes : TZComponentList;
    function GetLength : integer;
  end;

  //Ett track håller trackentries som refererar till patterns
  TTrackEntry = class(TZComponent)
  private
    Music : TMusic;
    IsFinished : boolean;
    Iteration : integer;
    EndNoteI : integer;
    procedure Advance;
    procedure Reset(Owner : TMusic);
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Pattern : TPattern;
    RepeatCount : integer;
  end;

  TTrack = class(TZComponent)
  private
    Music : TMusic;
    CurEntry : TTrackEntry;
    EntryI : integer;
    IsFinished : boolean;
    procedure Advance;
    procedure Reset(Owner : TMusic);
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Entries : TZComponentList;
    {$ifndef minimal}
    Mute : boolean;
    {$endif}
  end;

  TMusic = class(TZComponent)
  private
    Time,NextNote : single;
    InvTempo : single;
    GlobalNoteI : integer;
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Instruments : TZComponentList;
    Patterns : TZComponentList;
    Tracks : TZComponentList;
    Tempo : single;
    {$ifndef minimal}
    DesignerPattern : TPattern;  //ZDesigner sätter denna för att loopa en pattern
    {$endif}
    Modulators : TAnimatorGroup;
    procedure Reset;
    procedure PlayTimestep(const ATimeStep : single);
    procedure Update; override;
    {$ifndef minimal}
    constructor Create(OwnerList: TZComponentList); override;
    {$endif}
  end;

  TMusicControl = class(TCommand)
  protected
    procedure DefineProperties(List: TZPropertyList); override;
  public
    Kind : (mckStart,mckStop);
    Music : TMusic;
    procedure Execute; override;
  end;

implementation

uses ZPlatform,ZExpressions,ZMath,ZApplication;

const
  P_BITS = 12;  //Filter fixed point

const
  NoteLength = 0.25;

{ TSound }

procedure TSoundPreRendered.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Oscillators',{$ENDIF}integer(@Oscillators) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TSoundOscillator]);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Filters',{$ENDIF}integer(@Filters) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TSoundFilter]);{$endif}
end;

destructor TSoundPreRendered.Destroy;
begin
  //todo: if playing anropa platform_stopsound(this)
  FreeData;
  inherited;
end;

procedure TSoundPreRendered.FreeData;
begin
  if Data<>nil then
  begin
    FreeMem(Data);
    Data:=nil;
    DataSize:=0;
  end;
end;

procedure TSoundPreRendered.Generate;
var
  I,Units : integer;
  P : PSoundOutputUnit;
  TimeStep : single;
begin
  FreeData;

  //Nr of units to output
  Units := Round(AudioRate * Length);

  //Amount to increase modulators between each sample
  TimeStep := 1.0 / AudioRate;

  DataSize := SizeOf(TSoundOutputUnit) * Units;
  GetMem(Data,DataSize);

  Reset;

  Modulators.Start;
  P := Data;
  for I := 0 to Units-1 do
  begin
    P^ := Round( Tick * High(TSoundOutputUnit) );
    Inc(P);
    Modulators.UpdateWithTimeStep(TimeStep);
    UpdateEnvelope(TimeStep);
  end;
  Modulators.Stop;

  Generated := True;
  IsChanged := False;
end;

procedure TSoundPreRendered.Play;
begin
  if ZApplication.NoSound then
    Exit;
  {$ifndef minimal}
  if Data=nil then
    Generate;
  {$endif}
  Platform_PlaySound(Self);
end;

procedure TSoundPreRendered.Update;
begin
  if (not Generated) or IsChanged then
    Generate;
end;

procedure TSoundPreRendered.Reset;
var
  I : integer;
  Osc : TSoundOscillator;
  Filter : TSoundFilter;
begin
  inherited;
  for I := 0 to Oscillators.Count-1 do
  begin
    Osc := TSoundOscillator(Oscillators[I]);
    Osc.OwnerSound := Self;
    Osc.Reset;
  end;
  for I := 0 to Filters.Count-1 do
  begin
    Filter := TSoundFilter(Filters[I]);
    Filter.Reset;
  end;
end;

function TSoundPreRendered.Tick: TSoundUnit;
var
  Mix : TSoundMixUnit;
  I : integer;
  Osc : TSoundOscillator;
  Filter : TSoundFilter;
begin
  Mix := 0;
  for I := 0 to Oscillators.Count-1 do
  begin
    Osc := TSoundOscillator(Oscillators[I]);
    Mix := Mix + Osc.Tick;
  end;
  Result := Mix;

  for I := 0 to Filters.Count-1 do
  begin
    Filter := TSoundFilter(Filters[I]);
    Result := Filter.Process(Result);
  end;

  Result := Result * EnvVolume;
end;

function TSoundPreRendered.GetMoreData(var Data: Pointer; var DataSize: Integer): Boolean;
begin
  Data := Self.Data;
  DataSize := Self.DataSize;
  Result := False;
end;


{ TSoundOscillator }

procedure TSoundOscillator.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Waveform',{$ENDIF}integer(@Waveform) - integer(Self), zptByte);
    {$ifndef minimal}List.GetLast.SetOptions(['Sine','Square','Saw','Noise','Expression']);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Frequency',{$ENDIF}integer(@Frequency) - integer(Self), zptFloat);
  List.AddProperty({$IFNDEF MINIMAL}'Amplitude',{$ENDIF}integer(@Amplitude) - integer(Self), zptScalar);
    List.GetLast.DefaultValue.FloatValue := 1.0;
  List.AddProperty({$IFNDEF MINIMAL}'Expression',{$ENDIF}integer(@Expression) - integer(Self), zptExpression);
    {$ifndef minimal}
    List.GetLast.DefaultValue.ExpressionValue.Source:='//WaveIndex = time. Return a value in the range -1..+1';
    {$endif}
  List.AddProperty({$IFNDEF MINIMAL}'WaveIndex',{$ENDIF}integer(@WaveIndex) - integer(Self), zptFloat);
    List.GetLast.NeverPersist := True;
end;

procedure TSoundOscillator.PropChanged;
var
  F : single;
begin
  F := OwnerSound.BaseFrequency + Frequency;
  case Waveform of
    wfSine :
      begin
        //Sineincrement = Frequency 1 means one full circle per second
        WaveInc := ((2*PI) / AudioRate) * F;
      end;
    wfSquare :
      begin
        //Squareincrement = Frequency 1 means one full square per second
        WaveInc := (2 / AudioRate) * F;
      end;
    wfSaw :
      begin
        //Noiseincrement = Frequency 1 means one sawtooth every second
        WaveInc := F / AudioRate;
      end;
    wfNoise,wfExpression :
      begin
        //Noiseincrement = Frequency 1 means one new rnd() value every second
        WaveInc := F / AudioRate;
      end;
  end;
end;

procedure TSoundOscillator.Reset;
begin
  WaveIndex := 0;
  PropChanged;
end;

function TSoundOscillator.Tick: TSoundUnit;
var
  I : integer;
begin
  PropChanged;
  //Move forward one unit
  WaveIndex := WaveIndex + WaveInc;
  //Calculate and return current unit of sound
  case Waveform of
    wfSine :
      begin
        Result := Sin(WaveIndex) * Amplitude;
      end;
    wfSquare :
      begin
        I := 1 - ((Trunc(WaveIndex) and 1) shl 1);
        Result := I * Amplitude;
      end;
    wfSaw :
      begin
        Result := (-1 + Frac(WaveIndex) * 2) * Amplitude;
      end;
    wfNoise :
      begin
        if WaveIndex>1 then
        begin
          WaveIndex := WaveIndex - 1;
          NoiseValue := 1 - System.Random * 2;
        end;
        Result := NoiseValue * Amplitude;
      end;
    wfExpression :
      begin
        ZExpressions.RunCode(Expression.Code);
        Result := ZExpressions.gReturnValue * Amplitude;
      end;
    else
      Result := 0; //Skip compiler warning
  end;
end;

{ TPlaySound }

procedure TPlaySound.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Sound',{$ENDIF}integer(@Sound) - integer(Self), zptComponentRef);
    {$ifndef minimal}List.GetLast.SetChildClasses([TSoundBase]);{$endif}
end;

procedure TPlaySound.Execute;
begin
  {$ifndef minimal}if Sound=nil then Exit;{$endif}
  Sound.Play;
end;

{$ifndef minimal}
function TPlaySound.GetDisplayName: String;
begin
  Result := inherited GetDisplayName;
  if Assigned(Sound) then
    Result := Result + '  ' + Sound.Name;
end;
{$endif}


//TMoogFilter
//http://www.musicdsp.org/archive.php?classid=3#196

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

procedure TMoogFilter.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Frequency',{$ENDIF}integer(@Frequency) - integer(Self), zptFloat);
  List.AddProperty({$IFNDEF MINIMAL}'Resonance',{$ENDIF}integer(@Resonance) - integer(Self), zptScalar);
end;

procedure TMoogFilter.FreqCalc;
const
  i2      : single = 40000;
//  ipi     : single = 1.744700666e-39; //4*arctan(1)
var
  fFc  : single;
  fFcr : single;
begin
 fFc:=  Frequency/AudioRate;
 // frequency & amplitude correction
 fFcr := 1.8730*(fFc*fFc*fFc) + 0.4955*(fFc*fFc) - 0.6490*fFc + 0.9988;
 fAcr := -3.9364*(fFc*fFc) + 1.8409*fFc + 0.9968;

 f2vg := i2*(1-exp(-2.0 * pi * fFcr * fFc)); // filter tuning

// f2vg := i2*(1-exp(-ipi*fFcr*fFc)); // Filter Tuning
end;

{procedure TMoogFilter.SetFrequency(v:single);
begin
  fF:=v;
  FreqCalc;
end;}


function TMoogFilter.Process(const I : TSoundUnit):TSoundUnit;
const
  i2v     : single = 1/20000;
  noise   : single = 1E-10;
begin
 //todo: Nu anropas FreqCalc varje gång
 //Behövs ej ifall freq är constant
 FreqCalc;

 // cascade of 4 1st order sections
 fA[1]:=fA[1]+f2vg*(Tanh2((I+(noise*System.Random)-2*Resonance*fAcr*fOld)*i2v)-Tanh2(fA[1]*i2v));
// fA[1]:=fA[1]+(f2vg*(Tanh2((I+(noise*Random)-2*fQ*fOld*fAcr)*i2v)-Tanh2(fA[1]*i2v)));
 fA[2]:=fA[2]+f2vg*(Tanh2(fA[1]*i2v)-Tanh2(fA[2]*i2v));
 fA[3]:=fA[3]+f2vg*(Tanh2(fA[2]*i2v)-Tanh2(fA[3]*i2v));
 fA[4]:=fA[4]+f2vg*(Tanh2(fA[3]*i2v)-Tanh2(fA[4]*i2v));

 // 1/2-sample delay for phase compensation
 fOld:=fA[4]+fA[5];
 fA[5]:=fA[4];

 // oversampling
 fA[1]:=fA[1]+f2vg*(Tanh2((-2*Resonance*fAcr*fOld)*i2v)-Tanh2(fA[1]*i2v));
 fA[2]:=fA[2]+f2vg*(Tanh2(fA[1]*i2v)-Tanh2(fA[2]*i2v));
 fA[3]:=fA[3]+f2vg*(Tanh2(fA[2]*i2v)-Tanh2(fA[3]*i2v));
 fA[4]:=fA[4]+f2vg*(Tanh2(fA[3]*i2v)-Tanh2(fA[4]*i2v));

 fOld:=fA[4]+fA[5];
 fA[5]:=fA[4];

 Result:=fOld;
end;



procedure TMoogFilter.Reset;
begin
  FillChar(fA,SizeOf(fA),0);
  fOld := 0;
end;

{ TSoundFilter }

procedure TSoundFilter.Reset;
begin
  //
end;

{ TFilterOverdrive }

procedure TFilterOverdrive.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Amount',{$ENDIF}integer(@Amount) - integer(Self), zptFloat);
end;

function TFilterOverdrive.Process(const I: TSoundUnit): TSoundUnit;
var
//  K : single;
//  X,A : single;
  Z,S : single;
begin
{  K := 2*Amount/(1-Amount);
  Result := (1+K) * I / (1+K*Abs(I));}

{  x := I * Amount;
  a := 1 + exp (sqrt (abs (I)) * -0.75);
  result := (exp (x) - exp (-x * a)) / (exp (x) + exp (-x));}

  z := PI * Amount;
  s := 1/sin(z);
//  b := 1/Amount;
//  if I > b then
//    Result := 1
//  else
    Result := sin(z*I)*s;
end;

{ TFilterDelay }

//Principen från STK Perry Cook

procedure TFilterDelay.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Amount',{$ENDIF}integer(@Amount) - integer(Self), zptScalar);
  List.AddProperty({$IFNDEF MINIMAL}'Length',{$ENDIF}integer(@Length) - integer(Self), zptFloat);
end;

function TFilterDelay.Process(const I: TSoundUnit): TSoundUnit;
begin
  //Läs från delay
  Result := Buffer[OutPoint];
  Inc(OutPoint);
  if OutPoint=High(Buffer) then
    OutPoint := 0;

  //Mixa med input
  Result := (Amount * Result) + (I * (1.0 - Amount));

  //Skriv det mixade värdet till delay-buffer för feedback
  Buffer[InPoint]:=Result;
  Inc(InPoint);
  if InPoint=High(Buffer) then
    InPoint := 0;
end;

procedure TFilterDelay.Reset;
var
  I : integer;
begin
  FillChar(Buffer,SizeOf(Buffer),0);
  I := Trunc( ZMath.Clamp(Length * AudioRate,1,High(Buffer)) );
  InPoint := 0;
  OutPoint := High(Buffer)-I;
end;

{ TSoundBase }

{$ifndef minimal}
constructor TSoundBase.Create(OwnerList: TZComponentList);
begin
  inherited;
  //Inlinekompnenter behöver bara skapas i designer, runtime så skapas dom vid läsning
  Modulators := TAnimatorGroup.Create(nil);
end;
{$endif}

procedure TSoundBase.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Length',{$ENDIF}integer(@Length) - integer(Self), zptFloat);
    List.GetLast.DefaultValue.FloatValue := 1.0;
  List.AddProperty({$IFNDEF MINIMAL}'Volume',{$ENDIF}integer(@Volume) - integer(Self), zptScalar);
    List.GetLast.DefaultValue.FloatValue := 1.0;
  List.AddProperty({$IFNDEF MINIMAL}'BaseFrequency',{$ENDIF}integer(@BaseFrequency) - integer(Self), zptFloat);
    List.GetLast.DefaultValue.FloatValue := 261.63; //C4
  List.AddProperty({$IFNDEF MINIMAL}'Modulators',{$ENDIF}integer(@Modulators) - integer(Self), zptInlineComponent);
  List.AddProperty({$IFNDEF MINIMAL}'AttackTime',{$ENDIF}integer(@AttackTime) - integer(Self), zptFloat);
  List.AddProperty({$IFNDEF MINIMAL}'ReleaseTime',{$ENDIF}integer(@ReleaseTime) - integer(Self), zptFloat);
  List.AddProperty({$IFNDEF MINIMAL}'AlreadyPlayingAction',{$ENDIF}integer(@AlreadyPlayingAction) - integer(Self), zptByte);
    {$ifndef minimal}List.GetLast.SetOptions(['Ignore','Restart']);{$endif}
end;

procedure TSoundBase.PrepareMoreData;
begin
  //
end;

procedure TSoundBase.Reset;
begin
  //Nollställ envelope
  EnvTime := 0;
  EnvState := esAttack;
  if AttackTime>0 then
  begin
    EnvVolume := 0;
    EnvRate := Volume/AttackTime;
  end else
  begin
    EnvVolume := Volume;
    EnvRate := 0;
  end;
end;

procedure TSoundBase.UpdateEnvelope(const TimeStep: single);
begin
  EnvTime := EnvTime + TimeStep;
  case EnvState of
    esAttack :
      begin
        EnvVolume := EnvVolume + EnvRate * TimeStep;
        if EnvVolume>=Volume then
        begin
          EnvVolume := Volume;
          EnvState := esSustain;
        end;
      end;
    esSustain :
      begin
        if EnvTime>=Length-AttackTime-ReleaseTime then
        begin
          EnvState := esRelease;
          if ReleaseTime>0 then
            EnvRate := Volume/ReleaseTime
          else
          begin
            EnvVolume := 0;
            EnvRate := -1;
          end;
        end;
      end;
    esRelease :
      begin
        EnvVolume := EnvVolume - EnvRate * TimeStep;
        if EnvVolume<0 then
          EnvVolume := 0;
      end;
  end;
end;

{ TSoundRealTime }


procedure TSoundRealTime.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Osc1Freq',{$ENDIF}integer(@Osc1Freq) - integer(Self), zptFloat);
  List.AddProperty({$IFNDEF MINIMAL}'UseOsc2',{$ENDIF}integer(@UseOsc2) - integer(Self), zptBoolean);
  List.AddProperty({$IFNDEF MINIMAL}'Osc2Freq',{$ENDIF}integer(@Osc2Freq) - integer(Self), zptFloat);

  List.AddProperty({$IFNDEF MINIMAL}'PulseWidth',{$ENDIF}integer(@PulseWidth) - integer(Self), zptScalar);
  List.AddProperty({$IFNDEF MINIMAL}'UseFilter',{$ENDIF}integer(@UseFilter) - integer(Self), zptBoolean);
  List.AddProperty({$IFNDEF MINIMAL}'FilterCutoff',{$ENDIF}integer(@FilterCutoff) - integer(Self), zptScalar);
  List.AddProperty({$IFNDEF MINIMAL}'FilterQ',{$ENDIF}integer(@FilterQ) - integer(Self), zptScalar);

  List.AddProperty({$IFNDEF MINIMAL}'TestFloatFilter',{$ENDIF}integer(@TestFloatFilter) - integer(Self), zptBoolean);

  List.AddProperty({$IFNDEF MINIMAL}'UseDelay',{$ENDIF}integer(@UseDelay) - integer(Self), zptBoolean);
  List.AddProperty({$IFNDEF MINIMAL}'DelayLength',{$ENDIF}integer(@DelayLength) - integer(Self), zptScalar);
end;

procedure TSoundRealTime.GenerateTimeStep;
const
  RtOutputBitLength = SizeOf(TSoundOutputUnit)*8;
  RtOutputRange = High(TSoundOutputUnit)+Abs(Low(TSoundOutputUnit));
  RtSignBit = 1 shl (RtOutputBitLength-1);
var
  I : integer;
  W,PWAdd,WStep,Value,IVol : TSoundOutputUnit;
  StartBuf,P : PSoundOutputUnit;
begin
  StartBuf := @Buffer[CurBuf];

  //Oscillator 1
  W := CurValue1;
  //WStep is sawtooth
  WStep := Round( ( (BaseFrequency+Osc1Freq) / AudioRate) * RtOutputRange );
  PWAdd := Round(High(TSoundOutputUnit)*(-1+PulseWidth*2));
  P := StartBuf;
  for I := 0 to RtBufferLength-1 do
  begin
    //Sawtooth
    Value := W + PWAdd;
    //Convert to squarewave by using sign-bit of sawtooth
    if (Value and RtSignBit=0) then
      Value := Low(TSoundOutputUnit)
    else
      Value := High(TSoundOutputUnit);
    P^ := Value;
    Inc(P);
    Inc(W,WStep);
  end;
  CurValue1 := W;

  //Oscillator 2
  if UseOsc2 then
  begin
    W := CurValue2;
    //WStep is sawtooth
    WStep := Round( ( (BaseFrequency+Osc2Freq) / AudioRate) * RtOutputRange );
    PWAdd := Round(High(TSoundOutputUnit)*(-1+PulseWidth*2));
    P := StartBuf;
    for I := 0 to RtBufferLength-1 do
    begin
      //Sawtooth
      Value := W + PWAdd;
      //Convert to squarewave by using sign-bit of sawtooth
      if (Value and RtSignBit=0) then
        Value := Low(TSoundOutputUnit)
      else
        Value := High(TSoundOutputUnit);
      //Mix with osc1
      P^ := (P^ div 2) + (Value div 2);
      Inc(P);
      Inc(W,WStep);
    end;
    CurValue2 := W;
  end;

  if UseFilter then
  //Prepare filter constants
  begin
    //set feedback amount given f and q between 0 and 1
    FilterFb := Round( (FilterQ + FilterQ/(1.0 - FilterCutoff)) * (1 shl P_BITS) );
    FilterIntCut := Round(FilterCutoff * (1 shl P_BITS) );
    P := StartBuf;
    for I := 0 to RtBufferLength-1 do
    begin
      P^:=IntegerFilter(P^);
      Inc(P);
    end;
  end;

  if UseDelay then
  begin
    DelayOutPoint := (DelayInPoint + Trunc(DelayLength * AudioRate)) mod High(DelayBuffer);
    P := StartBuf;
    for I := 0 to RtBufferLength-1 do
    begin
      P^:=IntegerDelay(P^);
      Inc(P);
    end;
  end;

  //Volume
  IVol := Trunc( 1.0 / EnvVolume );
  if IVol>1 then
  begin
    P := StartBuf;
    for I := 0 to RtBufferLength-1 do
    begin
      P^:=P^ div IVol;
      Inc(P);
    end;
  end;

  CurTime := CurTime + RtTimeStep;
  Modulators.UpdateWithTimeStep(RtTimeStep);
  UpdateEnvelope(RtTimeStep);
end;

function TSoundRealTime.GetMoreData(var Data: Pointer; var DataSize: Integer): Boolean;
begin
  Data := pointer(@Buffer[CurBuf]);
  DataSize := SizeOf(Buffer[0]);
  Inc(CurBuf); //Next buffer
  if CurBuf=RtBufferCount then
    CurBuf := 0;
  Result := CurTime<Length;
end;

procedure TSoundRealTime.Play;
begin
  if ZApplication.NoSound then
    Exit;
  if (PlayingCount>0) and (AlreadyPlayingAction=apaIgnore) then
    Exit;
  Reset;
  PrepareMoreData;
  Platform_Playsound(Self);
end;

procedure TSoundRealTime.PrepareMoreData;
begin
  GenerateTimeStep;
end;

procedure TSoundRealTime.Reset;
begin
  inherited;
  Modulators.Start;
  CurTime := 0;
  CurBuf := 0;
  CurValue1 := 0;
  CurValue2 := 0;
  Buf0 := 0;
  Buf1 := 0;
end;

function TSoundRealTime.IntegerFilter(const Input : TSoundOutputUnit) : TSoundOutputUnit;
var
  Temp1 : integer;
begin
  //for each sample...
  Temp1 := (FilterFb * (buf0 - buf1)) div (1 shl P_BITS);
  Temp1 := Input - buf0 + Temp1;
  Temp1 := (FilterIntCut * Temp1);
  Temp1 := Temp1 div (1 shl P_BITS);
  buf0 := buf0 + Temp1;

  Temp1 := (FilterIntCut * (buf0 - buf1)) div (1 shl P_BITS);
  buf1 := buf1 + Temp1;

  Result := buf1;
end;

function TSoundRealTime.IntegerDelay(const Input: TSoundOutputUnit): TSoundOutputUnit;
begin
  //Läs från delay
  Result := DelayBuffer[DelayOutPoint];
  Inc(DelayOutPoint);
  if DelayOutPoint=High(DelayBuffer) then
    DelayOutPoint := 0;

  //Mixa med input
  Result := (Result div 2) + (Input div 2);

  //Skriv det mixade värdet till delay-buffer för feedback
  DelayBuffer[DelayInPoint]:=Result;
  Inc(DelayInPoint);
  if DelayInPoint=High(DelayBuffer) then
    DelayInPoint := 0;
end;


procedure TSoundRealTime.PlayNote(Music : TMusic; Note: TNote);
begin
  //Set length
  //440Hz * 2^{{notenumber - 69}/12}
  //http://www.techlib.com/reference/musical_note_frequencies.htm
  BaseFrequency := 440.0 * Power(2, (Note.NoteNr - 69)/12);
  Length := (Note.Length * NoteLength - 0.025) * Music.InvTempo;  //note.length * 1/Music.Tempo
  Play;
end;


{ TNote }

procedure TNote.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'NoteNr',{$ENDIF}integer(@NoteNr) - integer(Self), zptByte);
  List.AddProperty({$IFNDEF MINIMAL}'InstrumentNr',{$ENDIF}integer(@InstrumentNr) - integer(Self), zptByte);
  List.AddProperty({$IFNDEF MINIMAL}'Length',{$ENDIF}integer(@Length) - integer(Self), zptFloat);
    List.GetLast.DefaultValue.FloatValue := 1.0;
end;

{ TPattern }

procedure TPattern.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Notes',{$ENDIF}integer(@Notes) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TNote]);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Length',{$ENDIF}integer(@Length) - integer(Self), zptByte);
end;

procedure TPattern.Reset(Owner: TMusic);
begin
  Self.Music := Owner;
  CurNoteI := 0;
  LastNoteI := -1;
  IsFinished := False;
end;

procedure TPattern.Advance;
var
  Instrument : TSoundBase;
  CurNote : TNote;
begin
  if (Music.GlobalNoteI=LastNoteI) or IsFinished then
    Exit;

  if CurNoteI>=Notes.Count then
  begin
    IsFinished := True;
    Exit;
  end;

  CurNote := TNote(Notes[CurNoteI]);
  Inc(CurNoteI);

  {$ifndef minimal}
  Assert(CurNote.InstrumentNr<Music.Instruments.Count);
  {$endif}

  if CurNote.NoteNr<>0 then
  begin
    Instrument := TSoundBase(Music.Instruments[CurNote.InstrumentNr]);
    Instrument.PlayNote(Music,CurNote);
  end;

  LastNoteI := Music.GlobalNoteI;
end;

function TPattern.GetLength: integer;
begin
  Result := 16 shl ord(Length);
end;

{ TTrack }

procedure TTrack.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Entries',{$ENDIF}integer(@Entries) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TTrackEntry]);{$endif}
  {$ifndef minimal}
  List.AddProperty({$IFNDEF MINIMAL}'Mute',{$ENDIF}integer(@Mute) - integer(Self), zptBoolean);
    List.GetLast.NeverPersist := True;
  {$endif}
end;

procedure TTrack.Advance;
begin
  {$ifndef minimal}
  if (Entries.Count=0) or (Mute) then Exit;
  {$endif}

  if (CurEntry=nil) or (CurEntry.IsFinished) then
  begin
    if EntryI>=Entries.Count then
    begin
      IsFinished := True;
      Exit;
    end
    else
    begin
      CurEntry := TTrackEntry(Entries[EntryI]);
      CurEntry.Reset(Music);
      Inc(EntryI);
    end;
  end;

  CurEntry.Advance;
end;

procedure TTrack.Reset(Owner: TMusic);
begin
  Self.Music := Owner;
  CurEntry := nil;
  EntryI := 0;
  IsFinished := False;
end;


{ TTrackEntry }

procedure TTrackEntry.Advance;
begin
  if (Pattern<>nil) then
  begin
    Pattern.Advance;
    if Pattern.IsFinished then
    begin
      Inc(Iteration);
      if Iteration<=RepeatCount then
        Pattern.Reset(Music);
    end;
  end;
  if Music.GlobalNoteI>=EndNoteI then
    IsFinished := True;
end;

procedure TTrackEntry.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Pattern',{$ENDIF}integer(@Pattern) - integer(Self), zptComponentRef);
    {$ifndef minimal}List.GetLast.SetChildClasses([TPattern]);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'RepeatCount',{$ENDIF}integer(@RepeatCount) - integer(Self), zptInteger);
end;

procedure TTrackEntry.Reset(Owner: TMusic);
var
  Pl : integer;
begin
  Self.Music := Owner;
  IsFinished := False;
  Iteration := 0;
  if Pattern<>nil then
  begin
    Pattern.Reset(Music);
    Pl := Pattern.GetLength;
  end
  else
    Pl := 16;
  EndNoteI := Music.GlobalNoteI + (Pl * (RepeatCount+1));
end;

{ TMusic }
{$ifndef minimal}
constructor TMusic.Create(OwnerList: TZComponentList);
begin
  inherited;
  Modulators := TAnimatorGroup.Create(nil);
end;
{$endif}

procedure TMusic.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Instruments',{$ENDIF}integer(@Instruments) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TSoundBase]);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Patterns',{$ENDIF}integer(@Patterns) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TPattern]);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Tracks',{$ENDIF}integer(@Tracks) - integer(Self), zptComponentList);
    {$ifndef minimal}List.GetLast.SetChildClasses([TTrack]);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Tempo',{$ENDIF}integer(@Tempo) - integer(Self), zptFloat);
    List.GetLast.DefaultValue.FloatValue := 1;
  List.AddProperty({$IFNDEF MINIMAL}'Modulators',{$ENDIF}integer(@Modulators) - integer(Self), zptInlineComponent);
end;

procedure TMusic.PlayTimestep(const ATimeStep : single);
var
  I : integer;
  T : TTrack;
  TimeStep : single;
begin
  TimeStep := ATimeStep * Tempo;
  if TimeStep>NoteLength then
  begin
    //Stop playing while timestep is too large
    //I'ts better to be silent than playing too fast
    Exit;
  end;
  InvTempo := 1/Tempo;
  //Update patterns before increasing time
  //Othewise nothing will play att Time=0
  {$ifndef minimal}
  if DesignerPattern<>nil then
  begin  //Just loop the current pattern
    DesignerPattern.Advance;
  end else
  {$endif}
  for I := 0 to Tracks.Count-1 do
  begin
    T := TTrack(Tracks[I]);
    if not T.IsFinished then
      T.Advance;
  end;
  //Increase time
  Time := Time + TimeStep;
  NextNote := NextNote - TimeStep;
  if NextNote<=0 then
  begin
    //GlobalNoteI är index som styr klockan
    Inc(GlobalNoteI);
    NextNote := NextNote + NoteLength;
  end;
  Modulators.UpdateWithTimeStep(TimeStep);
end;

procedure TMusic.Reset;
var
  I : integer;
  T : TTrack;
begin
  Modulators.Start;
  Time := 0;
  GlobalNoteI := 0;
  NextNote := NoteLength;
  for I := 0 to Tracks.Count-1 do
  begin
    T := TTrack(Tracks[I]);
    T.Reset(Self);
  end;
  {$ifndef minimal}
  if DesignerPattern<>nil then
    DesignerPattern.Reset(Self);
  {$endif}
end;

procedure TSoundPreRendered.PlayNote(Music : TMusic; Note: TNote);
begin
  Play;
end;

procedure TMusic.Update;
begin
  //Detta behövs så att alla ljud genereras vid load.
  Instruments.Update;
end;

{ TMusicControl }

procedure TMusicControl.DefineProperties(List: TZPropertyList);
begin
  inherited;
  List.AddProperty({$IFNDEF MINIMAL}'Kind',{$ENDIF}integer(@Kind) - integer(Self), zptByte);
    {$ifndef minimal}List.GetLast.SetOptions(['Start','Stop']);{$endif}
  List.AddProperty({$IFNDEF MINIMAL}'Music',{$ENDIF}integer(@Music) - integer(Self), zptComponentRef);
    {$ifndef minimal}List.GetLast.SetChildClasses([TMusic]);{$endif}
end;

procedure TMusicControl.Execute;
begin
  case Kind of
    mckStart :
      begin
        {$ifndef minimal}if Music=nil then Exit;{$endif}
        Music.Reset;
        ZApp.CurrentMusic := Music;
      end;
    mckStop : ZApp.CurrentMusic := nil;
  end;
end;

initialization

  ZClasses.Register(TSoundPreRendered,Ord(SoundPreRenderedClassId));
    {$ifndef minimal}ComponentManager.LastAdded.ImageIndex:=1;{$endif}
  ZClasses.Register(TSoundOscillator,Ord(SoundOscillatorClassId));
  ZClasses.Register(TPlaySound,Ord(PlaySoundClassId));
  ZClasses.Register(TMoogFilter,Ord(MoogFilterClassId));
  ZClasses.Register(TFilterOverdrive,Ord(FilterOverdriveClassId));
  ZClasses.Register(TFilterDelay,Ord(FilterDelayClassId));
    {$ifndef minimal}ComponentManager.LastAdded.HelpText := 'Simple audio delay (echo) filter';{$endif}

  ZClasses.Register(TSoundRealTime,Ord(SoundRealTimeClassId));
    {$ifndef minimal}ComponentManager.LastAdded.ImageIndex:=1;{$endif}

  ZClasses.Register(TMusic,Ord(MusicClassId));
  ZClasses.Register(TTrack,Ord(TrackClassId));
  ZClasses.Register(TPattern,Ord(PatternClassId));
  ZClasses.Register(TNote,Ord(NoteClassId));
  ZClasses.Register(TTrackEntry,Ord(TrackEntryClassId));
  ZClasses.Register(TMusicControl,Ord(MusicControlClassId));
    {$ifndef minimal}ComponentManager.LastAdded.HelpText := 'Start/stop playing of music';{$endif}

end.

