{  Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }

unit varSphereCrop;

interface

uses
  BaseVariation, XFormMan;

type
  TVariationSphereCrop = class(TBaseVariation)

  const
    sx : string = 'spherecrop_x';
    sy : string = 'spherecrop_y';
	sz : string = 'spherecrop_z';
    sradius : string = 'spherecrop_radius';
    szero : string = 'spherecrop_zero';
    sarea : string = 'spherecrop_scatter_area'; 
	smode: string = 'spherecrop_mode';
  private
    x0, y0, z0, radius, scatter_area, ca: double;
    zero, mode: byte;
	
	procedure CalcPre;
	procedure CalcPost;
  public
    constructor Create;

    class function GetName: string; override;
    class function GetInstance: TBaseVariation; override;

    function GetNrVariables: integer; override;
    function GetVariableNameAt(const Index: integer): string; override;

    function SetVariable(const Name: string; var value: double): boolean; override;
    function GetVariable(const Name: string; var value: double): boolean; override;
	  function ResetVariable(const Name: string): boolean; override;

    procedure Prepare; override;
    procedure CalcFunction; override;
	procedure GetCalcFunction(var f: TCalcFunction); override;
  end;


implementation
uses
  Math;

{ TVariationSphereCrop }

//////////////////////////////////////////

procedure TVariationSphereCrop.Prepare;
begin
  ca := max(-1.0, min(scatter_area, 1.0));
end;

procedure TVariationSphereCrop.GetCalcFunction(var f: TCalcFunction);
begin
  case mode of
	  0: f := CalcPre;
	  1: f := CalcFunction;
	  else f := CalcPost;
  end;
end;

procedure TVariationSphereCrop.CalcFunction;
var
    x, y, z, rad, rdc: double;
	ang, phi, sn, cn, sz, cz: double;
begin
  x := FTx^ - x0;
  y := FTy^ - y0;
  z := FTz^ - z0;
  rad := Math.Hypot(x, y, z);

  if (rad > radius) then
  begin
    if (zero = 1) then
    begin
       FPx^ := FPx^;
       FPy^ := FPy^;
       FPz^ := FPz^;
    end else
    begin
      ang := arctan2(y, x);
      SinCos(ang, sn, cn);
	    phi := arcsin(z / rad);
	    SinCos(phi, sz, cz);
      rdc := radius + (random * 0.5 * ca);

      FPx^ := FPx^ + vvar * rdc * cn * cz + x0;
      FPy^ := FPy^ + vvar * rdc * sn * cz + y0;
	    FPz^ := FPz^ + vvar * rdc * sz + z0;
    end;
  end else
  begin
      FPx^ := FPx^ + vvar * x + x0;
      FPy^ := FPy^ + vvar * y + y0;
	    FPz^ := FPz^ + vvar * z + z0;
  end;
end;

procedure TVariationSphereCrop.CalcPost;
var
    x, y, z, rad, rdc: double;
	ang, phi, sn, cn, sz, cz: double;
begin
  x := FPx^ - x0;
  y := FPy^ - y0;
  z := FPz^ - z0;
  rad := Math.Hypot(x, y, z);

  if (rad > radius) then
  begin
    if (zero = 1) then
    begin
      FPx^ := 0;
      FPy^ := 0;
      FPz^ := 0;
    end else
    begin
      ang := arctan2(y, x);
      SinCos(ang, sn, cn);
	    phi := arcsin(z / rad);
	    SinCos(phi, sz, cz);
      rdc := radius + (random * 0.5 * ca);

      FPx^ := vvar * rdc * cn * cz + x0;
      FPy^ := vvar * rdc * sn * cz + y0;
	    FPz^ := vvar * rdc * sz + z0;
    end;
  end else
  begin
      FPx^ := vvar * x + x0;
      FPy^ := vvar * y + y0;
	    FPz^ := vvar * z + z0;
  end;
end;

procedure TVariationSphereCrop.CalcPre;
var
    x, y, z, rad, rdc: double;
	ang, phi, sn, cn, sz, cz: double;
begin
  x := FTx^ - x0;
  y := FTy^ - y0;
  z := FTz^ - z0;
  rad := Math.Hypot(x, y, z);

  if (rad > radius) then
  begin
    if (zero = 1) then
    begin
       FTx^ := 0;
       FTy^ := 0;
       FTz^ := 0;
    end else
    begin
      ang := arctan2(y, x);
      SinCos(ang, sn, cn);
	    phi := arcsin(z / rad);
	    SinCos(phi, sz, cz);
      rdc := radius + (random * 0.5 * ca);

      FTx^ := vvar * rdc * cn * cz + x0;
      FTy^ := vvar * rdc * sn * cz + y0;
	    FTz^ := vvar * rdc * sz + z0;
    end;
  end else
  begin
      FTx^ := vvar * x + x0;
      FTy^ := vvar * y + y0;
	    FTz^ := vvar * z + z0;
  end;
end;

constructor TVariationSphereCrop.Create;
begin
  x0 := 0;
  y0 := 0;
  z0 := 0;
  radius := 1;
  scatter_area := 0;
  zero := 0;
  mode := 1;
end;

class function TVariationSphereCrop.GetInstance: TBaseVariation;
begin
  Result := TVariationSphereCrop.Create;
end;

class function TVariationSphereCrop.GetName: string;
begin
  Result := 'spherecrop';
end;

function TVariationSphereCrop.GetNrVariables: integer;
begin
  Result := 7;
end;

function TVariationSphereCrop.GetVariable(const Name: string;
  var value: double): boolean;
begin
  Result := False;
  if Name = sx then begin
    Value := x0;
    Result := True;
  end
  else if Name = sy then begin
    Value := y0;
    Result := True;
  end
  else if Name = sz then begin
    Value := z0;
    Result := True;
  end
  else if Name = sradius then begin
    Value := radius;
    Result := True;
  end
  else if Name = sarea then begin
    Value := scatter_area;
    Result := True;
  end
  else if Name = szero then begin
    Value := zero;
    Result := True;
  end
  else if Name = smode then begin
    Value := mode;
    Result := True;
  end;
end;

function TVariationSphereCrop.GetVariableNameAt(const Index: integer): string;
begin
  case Index Of
	  0: Result := sradius;
    1: Result := sx;
    2: Result := sy;
	  3: Result := sz;
    4: Result := sarea;
    5: Result := szero;
	  6: Result := smode;
  else
    Result := '';
  end;
end;

function TVariationSphereCrop.ResetVariable(const Name: string): boolean;
begin
Result := False;
  if Name = sx then begin
    x0 := 0;
    Result := True;
  end
  else if Name = sy then begin
    y0 := 0;
    Result := True;
  end
  else if Name = sz then begin
    z0 := 0;
    Result := True;
  end
  else if Name = sradius then begin
    radius := 1;
    Result := True;
  end
  else if Name = sarea then begin
    scatter_area := 0;
    Result := True;
  end
  else if Name = szero then begin
    zero := 0;
    Result := True;
  end
  else if Name = smode then begin
    mode := 1;
    Result := True;
  end;
end;

function TVariationSphereCrop.SetVariable(const Name: string;
  var value: double): boolean;
begin
Result := False;
  if Name = sx then begin
    x0 := Value;
    Result := True;
  end
  else if Name = sy then begin
    y0 := Value;
    Result := True;
  end
  else if Name = sz then begin
    z0 := Value;
    Result := True;
  end
  else if Name = sradius then begin
    radius := Value;
    Result := True;
  end
  else if Name = sarea then begin
    scatter_area := Value;
    Result := True;
  end
  else if Name = szero then begin
    if Value < 0 then Value := 0;
    if Value > 1 then Value := 1;
    zero := Round(Value);
    Result := True;
  end 
  else if Name = smode then begin
    if Value < 0 then Value := 0;
    if Value > 2 then Value := 2;
    mode := Round(Value);
    Result := True;
  end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
  RegisterVariation(TVariationClassLoader.Create(TVariationSphereCrop), true, false);

end.