Apophysis-AV/Variations/varPostCurl.pas
2022-03-08 20:25:51 +03:00

377 lines
8.1 KiB
ObjectPascal

{
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 varPostCurl;
interface
uses
BaseVariation, XFormMan;
const
variation_name = 'post_curl';
num_vars = 2;
{$ifdef Apo7X64}
{$else}
{$define _ASM_}
{$endif}
type
TVariationPostCurl = class(TBaseVariation)
private
c1, c2, c2x2: double;
procedure CalcZeroC2;
procedure CalcZeroC1;
procedure CalcZeroC2C1;
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;
// TVariationPostCurl
///////////////////////////////
procedure TVariationPostCurl.Prepare;
begin
// AV: fixed - it's wrong when vvar <> 1
//c1 := c1 * VVAR;
//c2 := c2 * VVAR;
c2x2 := 2 * c2;
end;
////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl.GetCalcFunction(var f: TCalcFunction);
begin
if IsZero(c1) then begin
if IsZero(c2) then
f := CalcZeroC2C1
else
f := CalcZeroC1
end
else begin
if IsZero(c2) then
f := CalcZeroC2
else
f := CalcFunction
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl.CalcFunction;
{$ifndef _ASM_}
var
x, y, r, re, im: double;
begin
x := FPx^;
y := FPy^;
re := 1 + c1 * x + c2 * (sqr(x) - sqr(y));
im := c1 * y + c2x2 * x * y;
r := vvar / (sqr(re) + sqr(im));
FPx^ := (x * re + y * im) * r;
FPy^ := (y * re - x * im) * r;
{$else}
asm
mov edx, [eax + FTx]
fld qword ptr [edx + 24] // FPy
fld qword ptr [edx + 16] // FPx
fld st(1)
fmul st, st(1)
fmul qword ptr [eax + c2x2]
fld st(2)
fmul qword ptr [eax + c1]
faddp
fld st(2)
fmul st, st
fld st(2)
fmul st, st
fsubrp
fmul qword ptr [eax + c2]
fld1
faddp
fld st(2)
fmul qword ptr [eax + c1]
faddp
fld st(1)
fmul st, st
fld st(1)
fmul st, st
faddp
fdivr qword ptr [eax + vvar]
fld st(3)
fmul st, st(2)
fld st(5)
fmul st, st(4)
faddp
fmul st, st(1)
fstp qword ptr [edx + 16] // FPx
fxch st(4)
fmulp
fxch st(2)
fmulp
fsubp
fmulp
fstp qword ptr [edx + 24] // FPy
{$endif}
end;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPostCurl.CalcZeroC2; // AV: Mobius case
{$ifndef _ASM_}
var
r, x, y: double;
re, im: double;
begin
x := FPx^;
y := FPy^;
re := 1 + c1 * x;
im := c1 * y;
r := vvar / (sqr(re) + sqr(im));
FPx^ := (x*re + y*im) * r;
FPy^ := (y*re - x*im) * r;
//FPz^ := vvar * FPz^;
{$else}
asm
mov edx, [eax + FTx]
fld qword ptr [edx + 24] // FPy
fld qword ptr [edx + 16] // FPx
fld st(1)
fld qword ptr [eax + c1]
fmul st(1), st
fmul st, st(2)
fld1
faddp
fld st(1)
fmul st, st
fld st(1)
fmul st, st
faddp
fdivr qword ptr [eax + vvar]
fld st(3)
fmul st, st(2)
fld st(5)
fmul st, st(4)
faddp
fmul st, st(1)
fstp qword ptr [edx + 16] // FPx
fxch st(4)
fmulp
fxch st(2)
fmulp
fsubp
fmulp
fstp qword ptr [edx + 24] // FPy
{$endif}
end;
procedure TVariationPostCurl.CalcZeroC1;
{$ifndef _ASM_}
var
r, x, y: double;
re, im: double;
begin
x := FPx^;
y := FPy^;
re := 1 + c2*(sqr(x) - sqr(y));
im := c2x2 * x * y;
r := vvar / (sqr(re) + sqr(im));
FPx^ := (x*re + y*im) * r;
FPy^ := (y*re - x*im) * r;
{$else}
asm
mov edx, [eax + FTx]
fld qword ptr [edx + 24] // FPy
fld qword ptr [edx + 16] // FPx
fld st(1)
fmul st, st(1)
fmul qword ptr [eax + c2x2]
fld st(2)
fmul st, st
fld st(2)
fmul st, st
fsubrp
fmul qword ptr [eax + c2]
fld1
faddp
fld st(1)
fmul st, st
fld st(1)
fmul st, st
faddp
fdivr qword ptr [eax + vvar]
fld st(3)
fmul st, st(2)
fld st(5)
fmul st, st(4)
faddp
fmul st, st(1)
fstp qword ptr [edx + 16] // FPx
fxch st(4)
fmulp
fxch st(2)
fmulp
fsubp
fmulp
fstp qword ptr [edx + 24] // FPy
//fwait
{$endif}
end;
procedure TVariationPostCurl.CalcZeroC2C1; // AV: linear case
{$ifndef _ASM_}
var
r: double;
begin
FPx^ := vvar * FPx^;
FPy^ := vvar * FPy^;
{$else}
asm
fld qword ptr [eax + vvar]
mov edx, [eax + FTx]
fld qword ptr [edx + 16] // FPx
fmul st, st(1)
fstp qword ptr [edx + 16]
fld qword ptr [edx + 24] // FPy
fmulp
fstp qword ptr [edx + 24]
//fwait
{$endif}
end;
class function TVariationPostCurl.GetInstance: TBaseVariation;
begin
Result := TVariationPostCurl.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPostCurl.GetName: string;
begin
Result := variation_name;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl.GetVariableNameAt(const Index: integer): string;
begin
case Index of
0: Result := 'post_curl_c1';
1: Result := 'post_curl_c2';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'post_curl_c1' then begin
c1 := value;
Result := True;
end
else if Name = 'post_curl_c2' then begin
c2 := value;
Result := True;
end;
end;
function TVariationPostCurl.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'post_curl_c1' then begin
c1 := 0;
Result := True;
end
else if Name = 'post_curl_c2' then begin
c2 := 0;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl.GetNrVariables: integer;
begin
Result := num_vars;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPostCurl.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'post_curl_c1' then begin
value := c1;
Result := True;
end
else if Name = 'post_curl_c2' then begin
value := c2;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationPostCurl), false, false);
end.