Apophysis-AV/Variations/varNBlur.pas

536 lines
18 KiB
ObjectPascal
Raw Permalink Normal View History

2022-03-08 12:25:51 -05:00
{
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
Original nBlur plugin by FractalDesire:
http://fractaldesire.deviantart.com/art/nBlur-plugin-190401515,
Optimized and translated into Delphi by Alice V. Koryagina
}
unit varNBlur;
interface
uses
BaseVariation, XFormMan;
type
TVariationNBlur = class(TBaseVariation)
private
numEdges, numStripes: integer;
circumCircle, adjustToLinear, equalBlur, exactCalc: byte;
ratioStripes, ratioHole, highlightEdges, ratioComplement, maxStripes, angStripes, midAngle, angStart,
tan90_m_2, sina, cosa, arc_tan1, arc_tan2, speedCalc1, speedCalc2, nStripes: double;
hasStripes, negStripes: boolean;
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;
end;
implementation
uses
Math;
{ TVariationNBlur }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationNBlur.Prepare;
begin
//*********Prepare stripes related stuff*********
nStripes := numStripes; // AV: to fix a bug with negative stripes count
if (nStripes <> 0) then
begin
hasStripes := True;
if (nStripes < 0) then
begin
negStripes := True;
nStripes := -nStripes;
end else
negStripes := False;
end else begin
hasStripes := False;
negStripes := False;
end;
//**********Prepare angle related stuff**********
midAngle := 2 * pi / numEdges;
if hasStripes then
begin
angStripes := midAngle / (2 * nStripes);
angStart := angStripes * 0.5;
ratioComplement := 2 - ratioStripes;
end;
//**********Prepare hole related stuff***********
if (ratioHole > 0.95) and (exactCalc = 1) and (circumCircle = 0) then ratioHole := 0.95;
//*********Prepare edge calculation related stuff*********
tan90_m_2 := tan((pi + midAngle) * 0.5);
SinCos(midAngle * 0.5, sina, cosa);
//*********Adjustment of width of shape*********
if (adjustToLinear = 1) then
begin
if((numEdges mod 4) = 0) then
VVAR := VVAR / (sqrt(2 - 2 * cos(midAngle *(numEdges * 0.5 - 1))) * 0.5)
else
VVAR := VVAR / (sqrt(2 - 2 * cos(midAngle * floor(numEdges * 0.5))) * 0.5);
end;
//*********Prepare circumCircle-calculation*********
if (circumCircle = 1) then
begin
exactCalc := 0;
highlightEdges := 0.1;
end;
//*********Prepare speed up related stuff*********
speedCalc1 := ratioComplement * angStart;
speedCalc2 := ratioStripes * angStart;
maxStripes := 2 * numStripes;
if(negStripes = False) then
arc_tan1 := 13.0 / power(numEdges, 1.3) * highlightEdges
else
arc_tan1 := 7.5 / power(numEdges, 1.3) * highlightEdges;
arc_tan2 := 2 * arctan(arc_tan1 *(-0.5));
end;
procedure TVariationNBlur.CalcFunction;
var
x, y, xTmp, yTmp, lenOuterEdges, lenInnerEdges, lenXY: double;
procedure RandXY;
var
angXY, ranTmp, angTmp, angMem, rotTmp,
ratioTmp, ratioTmpNum, ratioTmpDen, step, speedCalcTmp: double;
count: integer;
begin
if (exactCalc = 1) then
angXY := random * PI2
else
angXY := (arctan(arc_tan1 * (random - 0.5)) / arc_tan2 + 0.5 + Random(numEdges)) * midAngle;
SinCos(angXY, x, y);
angMem := angXY;
while (angXY > midAngle) do angXY := angXY - midAngle;
//********Begin of xy-calculation of radial stripes********
if hasStripes then
begin
angTmp := angStart;
count := 0;
while(angXY > angTmp) do
begin
angTmp := angTmp + angStripes;
if (angTmp > midAngle) then angTmp := midAngle;
inc(count);
end;
if (angTmp <> midAngle) then angTmp := angTmp - angStart;
if (not negStripes) then
begin
if Odd(count) then
begin
if(angXY > angTmp) then
begin
angXY := angXY + angStart;
angMem := angMem + angStart;
SinCos(angMem, x, y);
angTmp := angTmp + angStripes;
inc(count);
end
else begin
angXY := angXY - angStart;
angMem := angMem - angStart;
SinCos(angMem, x, y);
angTmp := angTmp - angStripes;
dec(count);
end;
end;
if (not Odd(count)) and (ratioStripes > 1.0) then
begin
if (angXY > angTmp) and (count <> maxStripes) then
begin
angMem := angMem - angXY + angTmp + (angXY - angTmp) / angStart * ratioStripes * angStart;
angXY := angTmp + (angXY - angTmp) / angStart * ratioStripes * angStart;
SinCos(angMem, x, y);
end
else begin
angMem := angMem - angXY + angTmp - (angTmp - angXY)/ angStart * ratioStripes * angStart;
angXY := angTmp + (angXY - angTmp)/ angStart * ratioStripes * angStart;
SinCos(angMem, x, y);
end;
end;
if (not Odd(count)) and (ratioStripes < 1.0) then
begin
if (abs(angXY - angTmp) > speedCalc2) and (count <> maxStripes) then
begin
if (angXY - angTmp) > speedCalc2 then
begin
ratioTmpNum := (angXY -(angTmp + speedCalc2)) * speedCalc2;
ratioTmpDen := angStart - speedCalc2;
ratioTmp := ratioTmpNum / ratioTmpDen;
SinCos((angMem - angXY + angTmp + ratioTmp), x, y);
angXY := angTmp + ratioTmp;
end;
if (angTmp - angXY) > speedCalc2 then
begin
ratioTmpNum := (angTmp - speedCalc2 - angXY) * speedCalc2;
ratioTmpDen := angStart - speedCalc2;
ratioTmp := ratioTmpNum / ratioTmpDen;
SinCos((angMem - angXY + angTmp - ratioTmp), x, y);
angXY := angTmp - ratioTmp;
end;
end;
if (count = maxStripes) then
if (angTmp - angXY) > speedCalc2 then
begin
ratioTmpNum := (angTmp - speedCalc2 - angXY) * speedCalc2;
ratioTmpDen := angStart - speedCalc2;
ratioTmp := ratioTmpNum / ratioTmpDen;
SinCos((angMem - angXY + angTmp - ratioTmp), x, y);
angXY := angTmp - ratioTmp;
end;
end;
end
else begin
//********Change ratio and ratioComplement********
ratioTmp := ratioStripes;
ratioStripes := ratioComplement;
ratioComplement := ratioTmp;
speedCalcTmp := speedCalc1;
speedCalc1 := speedCalc2;
speedCalc2 := speedCalcTmp;
//************************************************
if not Odd(count) then
begin
if (angXY > angTmp) and (count <> maxStripes) then
begin
angXY := angXY + angStart;
angMem := angMem + angStart;
SinCos(angMem, x, y);
angTmp := angTmp + angStripes;
inc(count);
end
else begin
angXY := angXY - angStart;
angMem := angMem - angStart;
SinCos(angMem, x, y);
angTmp := angTmp - angStripes;
dec(count);
end;
end;
if Odd(count) and (ratioStripes > 1.0) then
begin
if (angXY > angTmp) and (count <> maxStripes) then
begin
angMem := angMem - angXY + angTmp + (angXY - angTmp) / angStart * ratioStripes * angStart;
angXY := angTmp + (angXY - angTmp) / angStart * ratioStripes * angStart;
SinCos(angMem, x, y);
end
else begin
angMem := angMem - angXY + angTmp - (angTmp - angXY)/ angStart * ratioStripes * angStart;
angXY := angTmp + (angXY - angTmp)/ angStart * ratioStripes * angStart;
SinCos(angMem, x, y);
end;
end;
if Odd(count) and (ratioStripes < 1.0) then
begin
if (abs(angXY - angTmp) > speedCalc2) and (count <> maxStripes) then
begin
if (angXY - angTmp) > speedCalc2 then
begin
ratioTmpNum := (angXY -(angTmp + speedCalc2)) * speedCalc2;
ratioTmpDen := angStart - speedCalc2;
ratioTmp := ratioTmpNum / ratioTmpDen;
SinCos((angMem - angXY + angTmp + ratioTmp), x, y);
angXY := angTmp + ratioTmp;
end;
if (angTmp - angXY) > speedCalc2 then
begin
ratioTmpNum := (angTmp - speedCalc2 - angXY) * speedCalc2;
ratioTmpDen := angStart - speedCalc2;
ratioTmp := ratioTmpNum / ratioTmpDen;
SinCos((angMem - angXY + angTmp - ratioTmp), x, y);
angXY := angTmp - ratioTmp;
end;
end;
if (count = maxStripes) then
begin
angTmp := midAngle;
if (angTmp - angXY) > speedCalc2 then
begin
ratioTmpNum := (angTmp - speedCalc2 - angXY) * speedCalc2;
ratioTmpDen := angStart - speedCalc2;
ratioTmp := ratioTmpNum / ratioTmpDen;
SinCos((angMem - angXY + angTmp - ratioTmp), x, y);
angXY := angTmp - ratioTmp;
end;
end;
end;
//********Restore ratio and ratioComplement*******
ratioTmp := ratioStripes;
ratioStripes := ratioComplement;
ratioComplement := ratioTmp;
speedCalcTmp := speedCalc1;
speedCalc1 := speedCalc2;
speedCalc2 := speedCalcTmp;
//************************************************
end;
end;
//********End of xy-calculation of radial stripes********
//********Begin of calculation of edge limits********
xTmp := tan90_m_2 / (tan90_m_2 - tan(angXY));
yTmp := xTmp * tan(angXY);
lenOuterEdges := hypot(xTmp, yTmp);
//*********End of calculation of edge limits********
//********Begin of radius-calculation (optionally hole)********
if(exactCalc = 1) then
if (equalBlur = 1) then ranTmp := sqrt(random)
else ranTmp := random
else begin
if(circumCircle = 1) then
if (equalBlur = 1) then ranTmp := sqrt(random)
else ranTmp := random
else
if (equalBlur = 1) then ranTmp := sqrt(random) * lenOuterEdges
else ranTmp := random * lenOuterEdges;
end;
lenInnerEdges := ratioHole * lenOuterEdges;
if (exactCalc = 0) then
begin
if(ranTmp < lenInnerEdges) then
begin
if (circumCircle = 1) then
if (equalBlur = 1) then ranTmp := lenInnerEdges + sqrt(random) * (1.0 - lenInnerEdges + 1e-300)
else ranTmp := lenInnerEdges + random * (1.0 - lenInnerEdges + 1e-300)
else
if (equalBlur = 1) then ranTmp := lenInnerEdges + sqrt(random) * (lenOuterEdges - lenInnerEdges)
else ranTmp := lenInnerEdges + random * (lenOuterEdges - lenInnerEdges);
end;
end;
x := x * ranTmp;
y := y * ranTmp;
lenXY := hypot(x, y);
//*********End of radius-calculation (optionally hole)*********
end; // of procedure
begin
RandXY;
//********Exact calculation slower - interpolated calculation faster********
if (exactCalc = 1) and (circumCircle = 0) then
while ((lenXY < lenInnerEdges) or (lenXY > lenOuterEdges)) do RandXY;
if (exactCalc = 1) and (circumCircle = 1) then
while (lenXY < lenInnerEdges) do RandXY;
xTmp := x;
yTmp := y;
//**************************************************************************
//********Begin of horizontal adjustment (rotation)********
x := cosa * xTmp - sina * yTmp;
y := sina * xTmp + cosa * yTmp;
//*********End of horizontal adjustment (rotation)*********
FPx^ := FPx^ + VVAR * x;
FPy^ := FPy^ + VVAR * y;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationNBlur.Create;
begin
numEdges := 3;
numStripes := 0;
ratioStripes := 1.0;
ratioHole := 0;
circumCircle := 0;
adjustToLinear := 1;
equalBlur := 1;
exactCalc := 0;
highlightEdges := 1.0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationNBlur.GetInstance: TBaseVariation;
begin
Result := TVariationNBlur.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationNBlur.GetName: string;
begin
Result := 'nBlur';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationNBlur.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'nb_numEdges';
1: Result := 'nb_numStripes';
2: Result := 'nb_ratioStripes';
3: Result := 'nb_ratioHole';
4: Result := 'nb_circumCircle';
5: Result := 'nb_adjustToLinear';
6: Result := 'nb_equalBlur';
7: Result := 'nb_exactCalc';
8: Result := 'nb_highlightEdges';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationNBlur.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'nb_numEdges' then begin
if (value < 3) then Value := 3;
numEdges := Round(Value);
Result := True;
end else if Name = 'nb_numStripes' then begin
numStripes := Round(Value);
Result := True;
end else if Name = 'nb_ratioStripes' then begin
if (value < 0) then Value := 0;
if (value > 2) then Value := 2;
ratioStripes := Value;
Result := True;
end else if Name = 'nb_ratioHole' then begin
if (value < 0) then Value := 0;
if (value > 1) then Value := 1;
ratioHole := Value;
Result := True;
end else if Name = 'nb_circumCircle' then begin
if (value < 0) then Value := 0;
if (value > 1) then Value := 1;
circumCircle := Round(Value);
Result := True;
end else if Name = 'nb_adjustToLinear' then begin
if (value < 0) then Value := 0;
if (value > 1) then Value := 1;
adjustToLinear := Round(Value);
Result := True;
end else if Name = 'nb_equalBlur' then begin
if (value < 0) then Value := 0;
if (value > 1) then Value := 1;
equalBlur := Round(Value);
Result := True;
end else if Name = 'nb_exactCalc' then begin
if (value < 0) then Value := 0;
if (value > 1) then Value := 1;
exactCalc := Round(Value);
Result := True;
end else if Name = 'nb_highlightEdges' then begin
if (value < 0.1) then Value := 0.1;
highlightEdges := Value;
Result := True;
end
end;
function TVariationNBlur.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'nb_numEdges' then begin
numEdges:= 3;
Result := True;
end else if Name = 'nb_numStripes' then begin
numStripes := 0;
Result := True;
end else if Name = 'nb_highlightEdges' then begin
highlightEdges := 1;
Result := True;
end else if Name = 'nb_ratioStripes' then begin
ratioStripes := 1;
Result := True;
end else if Name = 'nb_ratioHole' then begin
ratioHole := 0;
Result := True;
end else if Name = 'nb_circumCircle' then begin
circumCircle := 0;
Result := True;
end else if Name = 'nb_adjustToLinear' then begin
adjustToLinear := 1;
Result := True;
end else if Name = 'nb_equalBlur' then begin
equalBlur := 1;
Result := True;
end else if Name = 'nb_exactCalc' then begin
exactCalc := 0;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationNBlur.GetNrVariables: integer;
begin
Result := 9;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationNBlur.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'nb_numEdges' then begin
Value := numEdges;
Result := True;
end else if Name = 'nb_numStripes' then begin
Value := numStripes;
Result := True;
end else if Name = 'nb_ratioStripes' then begin
Value := ratioStripes;
Result := True;
end else if Name = 'nb_ratioHole' then begin
Value := ratioHole;
Result := True;
end else if Name = 'nb_circumCircle' then begin
Value := circumCircle;
Result := True;
end else if Name = 'nb_adjustToLinear' then begin
Value := adjustToLinear;
Result := True;
end else if Name = 'nb_equalBlur' then begin
Value := equalBlur;
Result := True;
end else if Name = 'nb_exactCalc' then begin
Value := exactCalc;
Result := True;
end else if Name = 'nb_highlightEdges' then begin
Value := highlightEdges;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationNBlur), false, false);
end.