{ 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 varSphyp3D; interface uses BaseVariation, XFormMan; const ssx = 'sphyp3D_stretchX'; ssy = 'sphyp3D_stretchY'; ssz = 'sphyp3D_stretchZ'; szon = 'sphyp3D_zOn'; EPS: double = 1E-100; type TVariationSphyp3D = class(TBaseVariation) private sx, sy, sz: double; zon: byte; procedure CalcLinear; procedure CalcSpherical; procedure CalcHyperbolicX; procedure CalcHyperbolicY; 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 CalcFunction; override; procedure GetCalcFunction(var f: TCalcFunction); override; end; implementation uses Math; { TVariationSphyp3D } /////////////////////////////////////////////////////////////////////////////// procedure TVariationSphyp3D.GetCalcFunction(var f: TCalcFunction); begin if (sx = 1) and (sy = 1) and (sz = 1) then f := CalcSpherical else if (sx = 0) and (sy = 0) and (sz = 0) then f := CalcLinear else if (sx = 1) and (sy = 0) then f := CalcHyperbolicX else if (sx = 0) and (sy = 1) then f := CalcHyperbolicY else f := CalcFunction; end; ////////////////////////////////////////// procedure TVariationSphyp3D.CalcFunction; var t, rx, ry, rz: double; begin t := sqr(FTx^) + sqr(FTy^) + sqr(FTz^) + EPS; rx := vvar * power(t, -sx); ry := vvar * power(t, -sy); FPx^ := FPx^ + FTx^ * rx; FPy^ := FPy^ + FTy^ * ry; // Optional 3D calculation if (zon = 1) then begin rz := vvar * power(t, -sz); FPz^ := FPz^ + FTz^ * rz; end; end; ////////////////////////////////////////// procedure TVariationSphyp3D.CalcHyperbolicX; var t, r: double; begin t := sqr(FTx^) + sqr(FTy^) + sqr(FTz^) + EPS; r := vvar / t; FPx^ := FPx^ + FTx^ * r; FPy^ := FPy^ + FTy^ * vvar; // Optional 3D calculation if (zon = 1) then begin r := vvar * power(t, -sz); FPz^ := FPz^ + FTz^ * r; end; end; ////////////////////////////////////////// procedure TVariationSphyp3D.CalcHyperbolicY; var t, r: double; begin t := sqr(FTx^) + sqr(FTy^) + sqr(FTz^) + EPS; r := vvar / t; FPx^ := FPx^ + FTx^ * vvar; FPy^ := FPy^ + FTy^ * r; // Optional 3D calculation if (zon = 1) then begin r := vvar * power(t, -sz); FPz^ := FPz^ + FTz^ * r; end; end; ////////////////////////////////////////// procedure TVariationSphyp3D.CalcSpherical; // default case var t: double; begin t := sqr(FTx^) + sqr(FTy^) + sqr(FTz^) + EPS; t := vvar / t; FPx^ := FPx^ + FTx^ * t; FPy^ := FPy^ + FTy^ * t; // Optional 3D calculation if (zon = 1) then FPz^ := FPz^ + FTz^ * t; end; ////////////////////////////////////////// procedure TVariationSphyp3D.CalcLinear; begin FPx^ := FPx^ + FTx^ * vvar; FPy^ := FPy^ + FTy^ * vvar; // Optional 3D calculation if (zon = 1) then FPz^ := FPz^ + FTz^ * vvar; end; /////////////////////////////////////////////////////////////////////////////// constructor TVariationSphyp3D.Create; begin sx := 1; sy := 1; sz := 1; zon := 1; end; /////////////////////////////////////////////////////////////////////////////// class function TVariationSphyp3D.GetInstance: TBaseVariation; begin Result := TVariationSphyp3D.Create; end; /////////////////////////////////////////////////////////////////////////////// class function TVariationSphyp3D.GetName: string; begin Result := 'sphyp3D'; end; /////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// function TVariationSphyp3D.GetVariableNameAt(const Index: integer): string; begin case Index of 0: Result := ssx; 1: Result := ssy; 2: Result := ssz; 3: Result := szon; else Result := ''; end end; /////////////////////////////////////////////////////////////////////////////// function TVariationSphyp3D.SetVariable(const Name: string; var value: double): boolean; begin Result := False; if Name = ssx then begin sx := Value; Result := True; end else if Name = ssy then begin sy := value; Result := True; end else if Name = ssz then begin sz := value; Result := True; end else if Name = szon then begin if (Value > 1) then Value := 1; if (Value < 0) then Value := 0; zon := Round(Value); Result := True; end; end; function TVariationSphyp3D.ResetVariable(const Name: string): boolean; begin Result := False; if Name = ssx then begin sx := 1; Result := True; end else if Name = ssy then begin sy := 1; Result := True; end else if Name = ssz then begin sz := 1; Result := True; end else if Name = szon then begin zon := IfThen(zon = 0, 1, 0); Result := True; end; end; ///////////////////////////////////////////////////////////////////// function TVariationSphyp3D.GetNrVariables: integer; begin Result := 4; end; /////////////////////////////////////////////////////////////////////////////// function TVariationSphyp3D.GetVariable(const Name: string; var value: double): boolean; begin Result := False; if Name = ssx then begin Value := sx; Result := true; end else if Name = ssy then begin Value := sy; Result := true; end else if Name = ssz then begin Value := sz; Result := true; end else if Name = szon then begin Value := zon; Result := true; end; end; /////////////////////////////////////////////////////////////////////////////// initialization RegisterVariation(TVariationClassLoader.Create(TVariationSphyp3D), true, false); end.