324 lines
8.4 KiB
ObjectPascal
324 lines
8.4 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
|
|
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
|
|
|
|
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 varSuperShape;
|
|
|
|
interface
|
|
|
|
uses
|
|
BaseVariation, XFormMan;
|
|
|
|
type
|
|
TVariationSuperShape = class(TBaseVariation)
|
|
private
|
|
m, n1, n2, n3, rnd, holes, pa, pb: double;
|
|
inv, p: double;
|
|
|
|
procedure CalcRnd;
|
|
public
|
|
constructor Create;
|
|
|
|
procedure Prepare; override;
|
|
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 CalcFunction; override;
|
|
procedure GetCalcFunction(var f: TCalcFunction); override; // AV: for speed
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math;
|
|
|
|
{ TVariationSuperShape }
|
|
|
|
{ Optimized by Alice V. Koryagina }
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
procedure TVariationSuperShape.Prepare; // AV: added some precalc
|
|
begin
|
|
inv := 1.0 - rnd;
|
|
p := -1 / n1; // assert (n1 <> 0)
|
|
end;
|
|
|
|
procedure TVariationSuperShape.GetCalcFunction(var f: TCalcFunction);
|
|
begin
|
|
if rnd < 1.0 then
|
|
f := CalcFunction
|
|
else
|
|
f := CalcRnd;
|
|
end;
|
|
|
|
procedure TVariationSuperShape.CalcFunction;
|
|
var
|
|
r, theta : double;
|
|
t1, t2, dist: double;
|
|
t1a, t2a: double;
|
|
begin
|
|
(*
|
|
theta := 0; // AV: why?
|
|
if n1 = 0 then // AV: we can check it at startup
|
|
r := 0 // AV: why?
|
|
else begin
|
|
theta := ArcTan2(FTy^, FTx^);
|
|
SinCos((m * theta + pi)/4, t2, t1);
|
|
|
|
t1 := abs(t1);
|
|
t1 := power(t1, n2);
|
|
|
|
t2 := abs(t2);
|
|
t2 := power(t2, n3);
|
|
|
|
dist := power(t1 + t2, -1 / n1); // AV: we can precalc it
|
|
|
|
// AV: why do we we check this const value at every point?
|
|
if rnd < 1.0 then
|
|
r := (rnd * random + (1.0 - rnd) * sqrt(sqr(FTx^) + sqr(FTy^))- holes) * dist
|
|
else
|
|
r := (rnd * random - holes) * dist;
|
|
end;
|
|
|
|
if (r = 0) then // AV: useless assignments...
|
|
begin
|
|
FPx^ := FPx^;
|
|
FPy^ := FPy^;
|
|
end
|
|
else
|
|
begin
|
|
SinCos(theta, t2a, t1a);
|
|
FPx^ := FPx^ + vvar * r * t1a;
|
|
FPy^ := FPy^ + vvar * r * t2a;
|
|
end;
|
|
*)
|
|
|
|
theta := ArcTan2(FTy^, FTx^);
|
|
SinCos((m * theta + pi)/4, t2, t1);
|
|
|
|
t1 := abs(t1 / pa); // AV: added missng super_shape_a
|
|
t1 := power(t1, n2);
|
|
|
|
t2 := abs(t2 / pb); // AV: added missng super_shape_b
|
|
t2 := power(t2, n3);
|
|
|
|
dist := power(t1 + t2, p);
|
|
r := (rnd * random + inv * sqrt(sqr(FTx^) + sqr(FTy^))- holes) * dist;
|
|
|
|
SinCos(theta, t2a, t1a);
|
|
FPx^ := FPx^ + vvar * r * t1a;
|
|
FPy^ := FPy^ + vvar * r * t2a;
|
|
end;
|
|
|
|
procedure TVariationSuperShape.CalcRnd; // AV
|
|
var
|
|
r, theta : double;
|
|
t1, t2, dist: double;
|
|
t1a, t2a: double;
|
|
begin
|
|
theta := ArcTan2(FTy^, FTx^);
|
|
SinCos((m * theta + pi)/4, t2, t1);
|
|
|
|
t1 := abs(t1 / pa);
|
|
t1 := power(t1, n2);
|
|
|
|
t2 := abs(t2 / pb);
|
|
t2 := power(t2, n3);
|
|
|
|
dist := power(t1 + t2, p);
|
|
|
|
r := (rnd * random - holes) * dist;
|
|
|
|
SinCos(theta, t2a, t1a);
|
|
FPx^ := FPx^ + vvar * r * t1a;
|
|
FPy^ := FPy^ + vvar * r * t2a;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
constructor TVariationSuperShape.Create;
|
|
begin
|
|
m := 5.0;
|
|
n1 := 2.0;
|
|
n2 := 0.3;
|
|
n3 := 0.3;
|
|
rnd := 0.0;
|
|
holes := 1.0;
|
|
pa := 1;
|
|
pb := 1;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
class function TVariationSuperShape.GetInstance: TBaseVariation;
|
|
begin
|
|
Result := TVariationSuperShape.Create;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
class function TVariationSuperShape.GetName: string;
|
|
begin
|
|
Result := 'super_shape';
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
function TVariationSuperShape.GetVariableNameAt(const Index: integer): string;
|
|
begin
|
|
case Index Of
|
|
0: Result := 'super_shape_m';
|
|
1: Result := 'super_shape_n1';
|
|
2: Result := 'super_shape_n2';
|
|
3: Result := 'super_shape_n3';
|
|
4: Result := 'super_shape_rnd';
|
|
5: Result := 'super_shape_holes';
|
|
6: Result := 'super_shape_a';
|
|
7: Result := 'super_shape_b';
|
|
else
|
|
Result := '';
|
|
end
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
function TVariationSuperShape.SetVariable(const Name: string; var value: double): boolean;
|
|
begin
|
|
Result := False;
|
|
if Name = 'super_shape_m' then begin
|
|
m := Value;
|
|
Result := True;
|
|
end else if Name = 'super_shape_n1' then begin
|
|
if abs(Value) < 1E-6 then Value := 1E-6; // AV: prevent useless checks
|
|
n1 := Value;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_n2' then begin
|
|
n2 := Value;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_n3' then begin
|
|
n3 := Value;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_rnd' then begin
|
|
if Value > 1.0 then
|
|
rnd := 1.0
|
|
else if Value < 0.0 then
|
|
rnd := 0.0
|
|
else
|
|
rnd := Value;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_holes' then begin
|
|
holes := Value;
|
|
Result := True;
|
|
end else if Name = 'super_shape_a' then begin
|
|
if abs(Value) < 1E-4 then Value := 1E-4;
|
|
pa := Value;
|
|
Result := True;
|
|
end else if Name = 'super_shape_b' then begin
|
|
if abs(Value) < 1E-4 then Value := 1E-4;
|
|
pb := Value;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function TVariationSuperShape.ResetVariable(const Name: string): boolean;
|
|
begin
|
|
Result := False;
|
|
if Name = 'super_shape_m' then begin
|
|
m:= 5;
|
|
Result := True;
|
|
end else if Name = 'super_shape_n1' then begin
|
|
n1 := 2;
|
|
Result := True;
|
|
end else if Name = 'super_shape_n2' then begin
|
|
n2 := 0.3;
|
|
Result := True;
|
|
end else if Name = 'super_shape_n3' then begin
|
|
n3 := 0.3;
|
|
Result := True;
|
|
end else if Name = 'super_shape_rnd' then begin
|
|
rnd := 0;
|
|
Result := True;
|
|
end else if Name = 'super_shape_holes' then begin
|
|
holes := 1;
|
|
Result := True;
|
|
end else if Name = 'super_shape_a' then begin
|
|
pa := 1;
|
|
Result := True;
|
|
end else if Name = 'super_shape_b' then begin
|
|
pb := 1;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
function TVariationSuperShape.GetNrVariables: integer;
|
|
begin
|
|
Result := 8;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
function TVariationSuperShape.GetVariable(const Name: string; var value: double): boolean;
|
|
begin
|
|
Result := False;
|
|
if Name = 'super_shape_m' then begin
|
|
Value := m;
|
|
Result := True;
|
|
end else if Name = 'super_shape_n1' then begin
|
|
Value := n1;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_n2' then begin
|
|
Value := n2;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_n3' then begin
|
|
Value := n3;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_rnd' then begin
|
|
Value := rnd;
|
|
Result := True;
|
|
end
|
|
else if Name = 'super_shape_holes' then begin
|
|
Value := holes;
|
|
Result := True;
|
|
end else if Name = 'super_shape_a' then begin
|
|
Value := pa;
|
|
Result := True;
|
|
end else if Name = 'super_shape_b' then begin
|
|
Value := pb;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
initialization
|
|
RegisterVariation(TVariationClassLoader.Create(TVariationSuperShape), false, false);
|
|
end.
|