Apophysis-AV/Variations/varPostCurl3D.pas

277 lines
6.8 KiB
ObjectPascal
Raw Permalink Normal View History

2022-03-08 12:25:51 -05:00
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit varPostCurl3D;
interface
uses
BaseVariation, XFormMan;
const
variation_name = 'post_curl3D';
num_vars = 3;
var_cx_name = 'post_curl3D_cx';
var_cy_name = 'post_curl3D_cy';
var_cz_name = 'post_curl3D_cz';
type
TVariationPostCurl3D = class(TBaseVariation)
private
cx, cy, cz: double;
//_cx, _cy, _cz, // AV: now unused
cx2, cy2, cz2, c2,
c2x, c2y, c2z: double;
procedure CalcCx;
procedure CalcCy;
procedure CalcCz;
procedure CalcLinear;
public
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;
// TVariationCurl3D
procedure TVariationPostCurl3D.Prepare;
begin
// AV : fixed when VVAR <> 1
//_cx := VVAR * cx;
//_cy := VVAR * cy;
//_cz := VVAR * cz;
c2x := 2 * cx;
c2y := 2 * cy;
c2z := 2 * cz;
cx2 := sqr(cx);
cy2 := sqr(cy);
cz2 := sqr(cz);
c2 := cx2 + cy2 + cz2;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl3D.GetCalcFunction(var f: TCalcFunction);
begin
if IsZero(cx) then begin
if IsZero(cy) then begin
if IsZero(cz) then
f := CalcLinear
else
f := CalcCz;
end
else begin
if IsZero(cz) then
f := CalcCy
else
f := CalcFunction;
end
end
else begin
if IsZero(cy) and IsZero(cz) then
f := CalcCx
else
f := CalcFunction;
end;
f := CalcFunction;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl3D.CalcFunction;
var
x, y, z, r, r2: double;
begin
x := Max(-1e100, Min(FPx^, 1e100)); // <--- got weird FP overflow there...
y := Max(-1e100, Min(FPy^, 1e100));
z := Max(-1e100, Min(FPz^, 1e100));
r2 := sqr(x) + sqr(y) + sqr(z);
r := vvar / (r2 * c2 + c2x * x - c2y * y + c2z * z + 1);
FPx^ := r * (x + cx * r2);
FPy^ := r * (y - cy * r2); // AV: fixed the sign
FPz^ := r * (z + cz * r2);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl3D.CalcCx;
var
x, r, r2: double;
begin
r2 := sqr(FPx^) + sqr(FPy^) + sqr(FPz^);
r := vvar / (cx2*r2 + c2x*FPx^ + 1);
FPx^ := r * (FPx^ + cx*r2);
FPy^ := r * FPy^;
FPz^ := r * FPz^;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl3D.CalcCy;
var
r, r2: double;
begin
r2 := sqr(FPx^) + sqr(FPy^) + sqr(FPz^);
r := vvar / (cy2*r2 - c2y*FPy^ + 1);
FPx^ := r * FPx^;
FPy^ := r * (FPy^ - cy*r2);
FPz^ := r * FPz^;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl3D.CalcCz;
var
r, r2: double;
begin
r2 := sqr(FPx^) + sqr(FPy^) + sqr(FPz^);
r := vvar / (cz2*r2 + c2z*FPz^ + 1);
FPx^ := r * FPx^;
FPy^ := r * FPy^;
FPz^ := r * (FPz^ + cz*r2);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl3D.CalcLinear;
var
r: double;
begin
FPx^ := vvar * FTx^;
FPy^ := vvar * FTy^;
FPz^ := vvar * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPostCurl3D.GetInstance: TBaseVariation;
begin
Result := TVariationPostCurl3D.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPostCurl3D.GetName: string;
begin
Result := variation_name;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl3D.GetVariableNameAt(const Index: integer): string;
begin
case Index of
0: Result := var_cx_name;
1: Result := var_cy_name;
2: Result := var_cz_name;
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl3D.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = var_cx_name then begin
cx := value;
Result := True;
end
else if Name = var_cy_name then begin
cy := value;
Result := True;
end
else if Name = var_cz_name then begin
cz := value;
Result := True;
end;
end;
function TVariationPostCurl3D.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = var_cx_name then begin
cx := 0;
Result := True;
end
else if Name = var_cy_name then begin
cy := 0;
Result := True;
end
else if Name = var_cz_name then begin
cz := 0;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl3D.GetNrVariables: integer;
begin
Result := num_vars;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl3D.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = var_cx_name then begin
value := cx;
Result := True;
end
else if Name = var_cy_name then begin
value := cy;
Result := True;
end
else if Name = var_cz_name then begin
value := cz;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationPostCurl3D), true, false);
end.