mirror-github-bspeice/Apophysis-AV
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
25a72c3c86
Apophysis-AV/Flame/ControlPoint.pas

3159 lines
93 KiB
ObjectPascal
Raw Normal View History

Initial commit
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
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 ControlPoint;
interface
//{$define VAR_STR}
uses
Classes, Windows, Cmap, XForm, XFormMan, Binary,
SysUtils, math, ZLib, Bezier;
const
SUB_BATCH_SIZE = 10000;
PROP_TABLE_SIZE = 1024;
PREFILTER_WHITE = (1 shl 26);
FILTER_CUTOFF = 1.8;
BRIGHT_ADJUST = 2.3;
//FUSE = 15; // AV: moved to Global since it became a variable
type
TCoefsArray= array[0..2, 0..1] of double;
pCoefsArray= ^TCoefsArray;
TTriangle = record
x: array[0..2] of double;
y: array[0..2] of double;
end;
TTriangles = array[-1..NXFORMS] of TTriangle;
TSPoint = record
x: double;
y: double;
end;
TSRect = record
Left, Top, Right, Bottom: double;
end;
TMapPalette = record
Red: array[0..255] of byte;
Green: array[0..255] of byte;
Blue: array[0..255] of byte;
end;
TColorMaps = record
Identifier: string;
UGRFile: string;
end;
pPixArray = ^TPixArray;
TPixArray = array[0..1279, 0..1023, 0..3] of integer;
pPreviewPixArray = ^TPreviewPixArray;
TPreviewPixArray = array[0..159, 0..119, 0..3] of integer;
TFileType = (ftIfs, ftFla, ftXML);
type //?
PLongintArray = ^TLongintArray;
TLongintArray = array[0..8192] of Longint;
type
TVariation = (vLinear, vCustom, vRandom = 1000); // AV: fixed outdated values
type
TPointsArray = array of TCPpoint;
TPointsXYArray = array of TXYpoint;
P2Cpoint = ^T2Cpoint;
T2CPointsArray = array of T2Cpoint;
TControlPoint = class
public
finalXform: TXForm;
finalXformEnabled: boolean;
useFinalXform: boolean;
soloXform: integer;
curvePoints: array [0..3] of BezierPoints;
curveWeights: array [0..3] of BezierWeights;
Transparency: boolean;
cameraPitch, cameraYaw, cameraPersp, cameraDOF: double;
cameraZpos, cameraRoll: double;
ProjectionFunc: procedure(pPoint: PCPPoint) of object;
xform: array[0..NXFORMS] of TXForm;
noLinearFix: boolean;
variation: TVariation;
cmap: TColorMap;
cmapindex: integer;
time: double;
Fbrightness: double; // 1.0 = normal
contrast: double; // 1.0 = normal
gamma: double;
Width: integer;
Height: integer;
spatial_oversample: integer;
name, nick, url: string;
center: array[0..1] of double; // camera center
vibrancy: double; // blend between color algs (0=old,1=new)
hue_rotation: double; // applies to cmap, 0-1
background: array[0..3] of Integer; // Changed to integers so no conversion needed - mt
zoom: double; // effects ppu and sample density
pixels_per_unit: double; // and scale
spatial_filter_radius: double; // variance of gaussian
sample_density: extended; // samples per pixel (not bucket)
(* in order to motion blur more accurately we compute the logs of the
sample density many times and average the results. we interplate
only this many times. *)
actual_density: extended; // for incomplete renders
nbatches: integer; // this much color resolution. but making it too high induces clipping
white_level: integer;
cmap_inter: integer; // if this is true, then color map interpolates one entry
// at a time with a bright edge
symmetry: integer;
pulse: array[0..1, 0..1] of double; // [i][0]=magnitute [i][1]=frequency */
wiggle: array[0..1, 0..1] of double; // frequency is /minute, assuming 30 frames/s */
estimator, estimator_min, estimator_curve: double; // density estimator.
jitters: integer;
gamma_threshold: double;
enable_de : boolean;
used_plugins : TStringList;
// PropTable: array of TXForm;
FAngle: Double;
//FTwoColorDimensions: Boolean;
procedure FillUsedPlugins;
private
invalidXform: TXForm;
CameraMatrix: array[0..2, 0..2] of double;
DofCoef: double;
gauss_rnd: array [0..3] of double;
gauss_N: integer;
sinPitch, cosPitch, sinRoll, cosRoll,
sinYaw, cosYaw: double;
procedure ProjectNone(pPoint: PCPPoint);
procedure ProjectPitch(pPoint: PCPPoint);
procedure ProjectPitchYaw(pPoint: PCPPoint);
procedure ProjectPitchDOF(pPoint: PCPPoint);
procedure ProjectPitchYawDOF(pPoint: PCPPoint);
// AV: for rotation around Y-axis
procedure ProjectPitchRoll(pPoint: PCPPoint);
procedure ProjectPitchRollYaw(pPoint: PCPPoint);
procedure ProjectPitchRollYawDOF(pPoint: PCPPoint);
function getppux: double;
function getppuy: double;
function GetBrightness: double;
procedure SetBrightness(br: double);
function GetRelativeGammaThreshold: double;
procedure SetRelativeGammaThreshold(gtr: double);
public
xdata : string;
procedure SaveToStringlist(sl: TStringlist);
procedure SaveToFile(Filename: string);
procedure SaveToBinary(const handle: File);
procedure ParseString(aString: string);
procedure ParseStringList(sl: TStringlist);
procedure RandomCP(min: integer = 2; max: integer = NXFORMS; calc: boolean = true);
procedure RandomCP1;
procedure CalcBoundbox;
function BlowsUp(NrPoints: integer): boolean;
procedure SetVariation(vari: TVariation);
procedure Clear;
procedure InterpolateX(cp1, cp2: TControlPoint; Tm: double);
procedure InterpolateAll(cp1, cp2: TControlPoint; Tm: double; it: integer);
procedure IterateXY(NrPoints: integer; var Points: TPointsXYArray);
procedure IterateXYC(NrPoints: integer; var Points: TPointsArray);
procedure Prepare;
function Clone: TControlPoint;
procedure Copy(cp1: TControlPoint; KeepSizes: boolean = false; nt: byte = NXFORMS); // AV
function HasFinalXForm: boolean;
// CP-specific functions moved from unit Main
function NumXForms: integer;
function TrianglesFromCP(var Triangles: TTriangles): integer;
procedure GetFromTriangles(const Triangles: TTriangles; const t: integer);
procedure GetTriangle(var Triangle: TTriangle; const n: integer);
procedure GetPostTriangle(var Triangle: TTriangle; const n: integer);
procedure EqualizeWeights;
procedure NormalizeWeights;
procedure RandomizeWeights;
procedure ComputeWeights(Triangles: TTriangles; t: integer);
procedure NormalizeProbabilities; // AV
procedure CalculateWeights; // AV
procedure CalculateColorSpeed; // AV
procedure AdjustScale(w, h: integer);
constructor Create;
destructor Destroy; override;
procedure ZoomtoRect(R: TSRect);
procedure ZoomOuttoRect(R: TSRect);
procedure MoveRect(R: TSRect);
procedure ZoomIn(Factor: double);
procedure Rotate(Angle: double);
property ppux: double read getppux;
property ppuy: double read getppuy;
property brightness: double
read GetBrightness
write SetBrightness;
property gammaThreshRelative: double
read GetRelativeGammaThreshold
write SetRelativeGammaThreshold;
end;
function add_symmetry_to_control_point(var cp: TControlPoint; sym: integer): integer;
procedure tile_control_point(var cp: TControlPoint; sym: integer);
function CalcUPRMagn(const cp: TControlPoint): double;
procedure FillVarDisturb;
function CalcBinaryFlameSize(cp: TControlPoint): integer;
implementation
uses global;
var
var_distrib: array of integer;
mixed_var_distrib: array of integer;
{ TControlPoint }
function sign(n: double): double;
begin
if n < 0 then Result := -1
else if n > 0 then Result := 1
else Result := 0;
end;
procedure TControlPoint.FillUsedPlugins;
var
i, j, k, f : integer;
v : double;
s : String;
begin
used_plugins.Clear;
f := -1;
if self.finalXformEnabled then f := 0;
for i := 0 to Min(NumXForms+f, NXFORMS) do
with xform[i] do begin
for j := 0 to NRVAR - 1 do begin
v := self.xform[i].GetVariation(j);
if (v <> 0) and // uses variation
(used_plugins.IndexOf(Varnames(j)) < 0) // not listed yet
then begin
used_plugins.Add(Varnames(j));
s := s + Varnames(j) + ' on TX #' + IntToStr(i + 1) + #13#10;
end;
end;
end;
// Faulty...
(*
for i := 0 to NumXforms-1 do begin
for j := NumBuiltinVars to xform[i].NumVariations-1 do begin
v := self.xform[i].GetVariation(j);
if (v = 0) then continue;
s := Varnames(j);
k := used_plugins.IndexOf(s);
if (k < 0) or (k >= used_plugins.Count) then
used_plugins.Add(s);
end;
end;
if finalXformEnabled then begin
for j := NumBuiltinVars to self.finalXform.NumVariations-1 do begin
v := self.finalXform.GetVariation(j);
s := Varnames(j);
if (v = 0) then continue;
k := used_plugins.IndexOf(s);
if (k < 0) or (k >= used_plugins.Count) then
used_plugins.Add(s);
end;
end;
*)
end;
constructor TControlPoint.Create;
var
i: Integer;
begin
for i := 0 to NXFORMS do begin
xform[i] := TXForm.Create;
end;
invalidXform := TXForm.Create;
soloXform := -1;
pulse[0][0] := 0;
pulse[0][1] := 60;
pulse[1][0] := 0;
pulse[1][1] := 60;
wiggle[0][0] := 0;
wiggle[0][1] := 60;
wiggle[1][0] := 0;
wiggle[1][1] := 60;
background[0] := 0;
background[1] := 0;
background[2] := 0;
for i := 0 to 3 do
begin
curvePoints[i][0].x := 0.00; curvePoints[i][0].y := 0.00; curveWeights[i][0] := 1;
curvePoints[i][1].x := 0.00; curvePoints[i][1].y := 0.00; curveWeights[i][1] := 1;
curvePoints[i][2].x := 1.00; curvePoints[i][2].y := 1.00; curveWeights[i][2] := 1;
curvePoints[i][3].x := 1.00; curvePoints[i][3].y := 1.00; curveWeights[i][3] := 1;
end;
center[0] := 0;
center[1] := 0;
pixels_per_unit := 50;
width := 100;
Height := 100;
spatial_oversample := 1;
spatial_filter_radius := 0.5;
FAngle := 0;
gamma := 1;
vibrancy := 1;
contrast := 1;
Fbrightness := 1;
hue_rotation := 1; // AV
sample_density := 50;
zoom := 0;
nbatches := 1;
white_level := 200;
estimator := 9.0;
estimator_min := 0.0;
estimator_curve := 0.4;
enable_de := false;
jitters := 1;
gamma_threshold := 0.01;
//FTwoColorDimensions := False;
finalXformEnabled := false;
Transparency := false;
cameraPitch := 0;
cameraYaw := 0;
cameraRoll := 0;
cameraPersp := 0;
cameraZpos := 0;
cameraDOF := 0;
used_plugins := TStringList.Create;
xdata := '';
end;
destructor TControlPoint.Destroy;
var
i: Integer;
begin
for i := 0 to NXFORMS do
xform[i].Free;
invalidXform.Free;
used_plugins.Free; // <<< -X- commenting out = hack - fixme!
// AV: uncommented to save user's PC memory from leaking - fixme!
inherited;
end;
procedure TControlPoint.Prepare;
var
i, n: Integer;
propsum: double;
LoopValue: double;
j: integer;
TotValue: double;
k: integer;
tp: array[0..NXFORMS] of double;
begin
// SetLength(PropTable, PROP_TABLE_SIZE);
//totValue := 0;
n := NumXforms;
assert(n > 0);
finalXform := xform[n];
finalXform.Prepare;
useFinalXform := FinalXformEnabled and HasFinalXform;
for i := 0 to n - 1 do begin
xform[i].Prepare;
//totValue := totValue + xform[i].density;
end;
invalidXform.PrepareInvalidXForm;
if soloXform >= 0 then begin
for i := 0 to n - 1 do begin
xform[i].transOpacity := 0;
end;
xform[soloXform].transOpacity := 1;
end;
for k := 0 to n - 1 do begin
totValue := 0;
SetLength(xform[k].PropTable, PROP_TABLE_SIZE);
for i := 0 to n - 1 do begin
tp[i] := xform[i].density * xform[k].modWeights[i];
totValue := totValue + tp[i];
end;
if totValue > 0 then begin
LoopValue := 0;
for i := 0 to PROP_TABLE_SIZE-1 do begin
propsum := 0;
j := -1;
repeat
inc(j);
propsum := propsum + tp[j];//xform[j].density;
until (propsum > LoopValue) or (j = n - 1);
//assert(tp[j]<>0);
xform[k].PropTable[i] := xform[j];
LoopValue := LoopValue + TotValue / PROP_TABLE_SIZE;
end;
end
else begin
for i := 0 to PROP_TABLE_SIZE-1 do
xform[k].PropTable[i] := invalidXform;
end;
end;
(*
CameraMatrix[0, 0] := cos(-CameraYaw);
CameraMatrix[1, 0] := -sin(-CameraYaw);
CameraMatrix[2, 0] := 0;
CameraMatrix[0, 1] := cos(CameraPitch) * sin(-CameraYaw);
CameraMatrix[1, 1] := cos(CameraPitch) * cos(-CameraYaw);
CameraMatrix[2, 1] := -sin(CameraPitch);
CameraMatrix[0, 2] := sin(CameraPitch) * sin(-CameraYaw);
CameraMatrix[1, 2] := sin(CameraPitch) * cos(-CameraYaw);
CameraMatrix[2, 2] := cos(CameraPitch);
*)
// AV: added 3D camera precalc
SinCos(cameraPitch, sinPitch, cosPitch);
SinCos(cameraRoll, sinRoll, cosRoll);
SinCos(-cameraYaw, sinYaw, cosYaw);
// AV: recalculate the matrix in order to support Y-rotation
CameraMatrix[0, 0] := cosRoll * cosYaw;
CameraMatrix[1, 0] := -cosRoll * sinYaw;
CameraMatrix[2, 0] := sinRoll;
CameraMatrix[0, 1] := sinPitch * sinRoll * cosYaw + cosPitch * sinYaw;
CameraMatrix[1, 1] := -sinPitch * sinRoll * sinYaw + cosPitch * cosYaw;
CameraMatrix[2, 1] := -sinPitch * cosRoll;
CameraMatrix[0, 2] := -cosPitch * sinRoll * cosYaw + sinPitch * sinYaw;
CameraMatrix[1, 2] := cosPitch * sinRoll * sinYaw + sinPitch * cosYaw;
CameraMatrix[2, 2] := cosPitch * cosRoll;
DofCoef := 0.1 * CameraDOF;
gauss_rnd[0] := random;
gauss_rnd[1] := random;
gauss_rnd[2] := random;
gauss_rnd[3] := random;
gauss_N := 0;
if (CameraDOF <> 0) then begin
if (CameraRoll = 0) then
begin
if (CameraYaw <> 0) then
ProjectionFunc := ProjectPitchYawDOF
else
ProjectionFunc := ProjectPitchDOF;
end else // Roll and DOF
ProjectionFunc := ProjectPitchRollYawDOF;
end
else if (CameraPitch <> 0) or (CameraRoll <> 0) or (CameraYaw <> 0) then begin
if (CameraRoll <> 0) then
ProjectionFunc := ProjectPitchRollYaw
else if (CameraYaw <> 0) then // Roll = 0
ProjectionFunc := ProjectPitchYaw
else // Roll = Yaw = 0
ProjectionFunc := ProjectPitch;
end
else ProjectionFunc := ProjectNone;
end;
procedure TControlPoint.IterateXY(NrPoints: integer; var Points: TPointsXYArray);
var
i: Integer;
px, py: double;
pPoint: PXYPoint;
xf: TXform;
begin
px := 2 * random - 1;
py := 2 * random - 1;
try
xf := xform[0]; //random(NumXForms)];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPointXY(px,py);
end;
pPoint := @Points[0];
if UseFinalXform then
for i := 0 to NrPoints - 1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPointXY(px,py);
if (xf.transOpacity = 0) or
((xf.transOpacity < 1) and (random > xf.transOpacity)) then
pPoint^.x := 1e300 // MaxDouble // hack
else begin
pPoint^.X := px;
pPoint^.Y := py;
end;
finalXform.NextPointXY(pPoint^.X, pPoint^.y);
Inc(pPoint);
end
else
for i := 0 to NrPoints - 1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPointXY(px,py);
if (xf.transOpacity = 0) or // AV
((xf.transOpacity < 1) and (random > xf.transOpacity)) then // AV
pPoint^.x := 1e300 // MaxDouble // hack
else begin
pPoint.X := px;
pPoint.Y := py;
end;
Inc(pPoint);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TControlPoint.IterateXYC(NrPoints: integer; var Points: TPointsArray);
var
i: Integer;
p: TCPPoint;
pPoint: PCPPoint;
xf: TXform;
begin
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.z := 0; // AV: fixed - someone forgot to initialize this variable
p.c := random;
try
xf := xform[0]; //random(NumXForms)];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
end;
pPoint := @Points[0];
if UseFinalXform then
for i := 0 to NrPoints - 1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
if (xf.transOpacity = 0) or // AV: moved here from rendering unit
((xf.transOpacity < 1) and (random > xf.transOpacity)) then
pPoint^.x := 1e300 // MaxDouble // hack
else
begin
finalXform.NextPointTo(p, pPoint^);
ProjectionFunc(pPoint);
end;
Inc(pPoint);
end
else
for i := 0 to NrPoints - 1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
if (xf.transOpacity = 0) or // AV: moved here from rendering unit
((xf.transOpacity < 1) and (random > xf.transOpacity)) then
pPoint^.x := 1e300 // MaxDouble // hack
else
begin
pPoint^ := p;
ProjectionFunc(pPoint);
end;
Inc(pPoint);
end;
except
on EMathError do begin
exit;
end;
on EInvalidPointer do exit; // AV
end;
end;
procedure TControlPoint.ProjectNone(pPoint: PCPPoint);
var
zr: double;
begin
zr := 1 - cameraPersp * (pPoint^.z - CameraZpos);
pPoint^.x := pPoint^.x / zr;
pPoint^.y := pPoint^.y / zr;
//pPoint^.z := pPoint^.z - CameraZpos; // AV: ?
end;
procedure TControlPoint.ProjectPitch(pPoint: PCPPoint);
var
y, z, zr: double;
begin
z := pPoint^.z - CameraZpos;
y := CameraMatrix[1,1] * pPoint^.y - sinPitch * z;
zr := 1 - cameraPersp *
(CameraMatrix[1,2] * pPoint^.y + cosPitch * z);
pPoint^.x := pPoint^.x / zr;
pPoint^.y := y / zr;
//pPoint^.z := pPoint^.z - CameraZpos;
end;
procedure TControlPoint.ProjectPitchYaw(pPoint: PCPPoint);
var
x, y, z, zr: double;
begin
z := pPoint^.z - CameraZpos;
x := cosYaw * pPoint^.x - sinYaw * pPoint^.y;
y := CameraMatrix[0,1] * pPoint^.x + CameraMatrix[1,1] * pPoint^.y - sinPitch * z;
zr := 1 - cameraPersp *
(CameraMatrix[0,2]* pPoint^.x + CameraMatrix[1,2]*pPoint^.y + cosPitch * z);
pPoint^.x := x / zr;
pPoint^.y := y / zr;
//pPoint^.z := pPoint^.z - CameraZpos;
end;
procedure TControlPoint.ProjectPitchDOF(pPoint: PCPPoint);
var
x, y, z, zr, dr: double;
dsin, dcos: double;
t: double;
begin
z := pPoint^.z - CameraZpos;
y := CameraMatrix[1,1] * pPoint^.y - sinPitch * z;
z := CameraMatrix[1,2] * pPoint^.y + cosPitch * z;
zr := 1 - cameraPersp * z;
//{$define GAUSSIAN_DOF}
{$ifdef GAUSSIAN_DOF}
asm
fld qword ptr [eax + gauss_rnd]
fadd qword ptr [eax + gauss_rnd+8]
fadd qword ptr [eax + gauss_rnd+16]
fadd qword ptr [eax + gauss_rnd+24]
fld1
fadd st, st
fsubp st(1),st
fmul qword ptr [eax + dofCoef]
fmul qword ptr [z]
fstp qword ptr [dr]
call AsmRandExt
mov edx, [eax + gauss_N]
fst qword ptr [eax + gauss_rnd + edx*8]
inc edx
and edx,$03
mov [eax + gauss_N], edx
fadd st, st
fldpi
fmulp
fsincos
fstp qword ptr [dcos]
fstp qword ptr [dsin]
end;
{$else}
t := random * 2 * pi;
SinCos(t, dsin, dcos);
dr := random * dofCoef * z;
{
asm
fld qword ptr [z]
fmul st, st
fmul qword ptr [eax + dofCoef]
fldpi
fadd st, st
call AsmRandExt
fmulp
fsincos
fstp qword ptr [dcos]
fstp qword ptr [dsin]
call AsmRandExt
fmulp
fstp qword ptr [dr]
end;
}
{$endif}
pPoint^.x := (pPoint^.x + dr*dcos) / zr;
pPoint^.y := (y + dr*dsin) / zr;
//pPoint^.z := pPoint^.z - CameraZpos;
end;
procedure TControlPoint.ProjectPitchYawDOF(pPoint: PCPPoint);
var
x, y, z, zr, dr: double;
dsin, dcos: double;
t : double;
begin
z := pPoint^.z - CameraZpos;
x := cosYaw * pPoint^.x - sinYaw * pPoint^.y;
y := CameraMatrix[0,1] * pPoint^.x + CameraMatrix[1,1] * pPoint^.y - sinPitch * z;
z := CameraMatrix[0,2] * pPoint^.x + CameraMatrix[1,2] * pPoint^.y + cosPitch * z;
zr := 1 - cameraPersp * z;
{$ifdef GAUSSIAN_DOF}
asm
fld qword ptr [eax + gauss_rnd]
fadd qword ptr [eax + gauss_rnd+8]
fadd qword ptr [eax + gauss_rnd+16]
fadd qword ptr [eax + gauss_rnd+24]
fld1
fadd st, st
fsubp st(1),st
fmul qword ptr [eax + dofCoef]
fmul qword ptr [z]
fstp qword ptr [dr]
call AsmRandExt
mov edx, [eax + gauss_N]
fst qword ptr [eax + gauss_rnd + edx*8]
inc edx
and edx,$03
mov [eax + gauss_N], edx
fadd st, st
fldpi
fmulp
fsincos
fstp qword ptr [dcos]
fstp qword ptr [dsin]
end;
{$else}
t := random * 2 * pi;
SinCos(t, dsin, dcos);
dr := random * dofCoef * z;
{
asm
fld qword ptr [z]
fmul st, st
fmul qword ptr [eax + dofCoef]
fldpi
fadd st, st
call AsmRandExt
fmulp
fsincos
fstp qword ptr [dcos]
fstp qword ptr [dsin]
call AsmRandExt
fmulp
fstp qword ptr [dr]
end;
}
{$endif}
pPoint^.x := (x + dr*dcos) / zr;
pPoint^.y := (y + dr*dsin) / zr;
// pPoint^.z := pPoint^.z - CameraZpos;
end;
procedure TControlPoint.ProjectPitchRoll(pPoint: PCPPoint);
var // AV: added Y-rotation
x, y, z, zr: double;
begin
z := pPoint^.z - CameraZpos;
x := cosRoll * pPoint^.x + CameraMatrix[1,0] * pPoint^.y + CameraMatrix[1,0] * z;
y := cosPitch * pPoint^.y - sinPitch * z;
zr := 1 - cameraPersp *
(sinRoll * pPoint^.x + CameraMatrix[1,2] * pPoint^.y + CameraMatrix[2,2] * z);
pPoint^.x := x / zr;
pPoint^.y := y / zr;
end;
procedure TControlPoint.ProjectPitchRollYaw(pPoint: PCPPoint);
var // AV: added Y-rotation
x, y, z, zr: double;
begin
z := pPoint^.z - CameraZpos;
x := CameraMatrix[0,0] * pPoint^.x + CameraMatrix[1,0] * pPoint^.y + CameraMatrix[2,0] * z;
y := CameraMatrix[0,1] * pPoint^.x + CameraMatrix[1,1] * pPoint^.y + CameraMatrix[2,1] * z;
zr := 1 - cameraPersp *
(CameraMatrix[0,2]* pPoint^.x + CameraMatrix[1,2]*pPoint^.y + CameraMatrix[2,2] * z);
pPoint^.x := x / zr;
pPoint^.y := y / zr;
end;
procedure TControlPoint.ProjectPitchRollYawDOF(pPoint: PCPPoint);
var // AV: added Y-rotation
x, y, z, zr, dr: double;
dsin, dcos: double;
t : double;
begin
z := pPoint^.z - CameraZpos;
x := CameraMatrix[0,0] * pPoint^.x + CameraMatrix[1,0] * pPoint^.y + CameraMatrix[2,0] * z;
y := CameraMatrix[0,1] * pPoint^.x + CameraMatrix[1,1] * pPoint^.y + CameraMatrix[2,1] * z;
z := CameraMatrix[0,2]* pPoint^.x + CameraMatrix[1,2]*pPoint^.y + CameraMatrix[2,2] * z;
zr := 1 - cameraPersp * z;
t := random * 2 * pi;
SinCos(t, dsin, dcos);
dr := random * dofCoef * z;
pPoint^.x := (x + dr * dcos) / zr;
pPoint^.y := (y + dr * dsin) / zr;
end;
function TControlPoint.BlowsUp(NrPoints: integer): boolean;
var
i, n: Integer;
px, py: double;
minx, maxx, miny, maxy: double;
Points: TPointsXYArray;
CurrentPoint: PXYPoint;
xf: TXForm;
begin
Result := false;
n := min(SUB_BATCH_SIZE, NrPoints);
SetLength(Points, n);
px := 2 * random - 1;
py := 2 * random - 1;
Prepare;
try
xf := xform[random(NumXForms)];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPointXY(px,py);
end;
CurrentPoint := @Points[0];
for i := 0 to n-1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPointXY(px,py);
CurrentPoint.X := px;
CurrentPoint.Y := py;
Inc(CurrentPoint);
// random CPs don't use finalXform...
end;
except
on EMathError do begin
Result := True;
Exit;
end;
end;
// It is possible that the transformation will grow very large but remain below the overflow line
minx := 1E10;
maxx := -1E10;
miny := 1E10;
maxy := -1E10;
for i := 0 to n-1 do begin
minx := min(minx, Points[i].x);
maxx := max(maxx, Points[i].x);
miny := min(miny, Points[i].y);
maxy := max(maxy, Points[i].y);
end;
if ((Maxx - MinX) > 1000) or ((Maxy - Miny) > 1000) then
Result := True;
end;
procedure TControlPoint.ParseString(aString: string);
var
ParseValues: TStringList;
ParsePos: integer;
CurrentToken: string;
CurrentXForm: integer;
i: integer;
OldDecimalSperator: Char;
v: double;
begin
ParseValues := TStringList.Create;
ParseValues.CommaText := AString;
OldDecimalSperator := FormatSettings.DecimalSeparator;
FormatSettings.DecimalSeparator := '.';
CurrentXForm := 0;
ParsePos := 0;
while (ParsePos < ParseValues.Count) do begin
CurrentToken := ParseValues[ParsePos];
if AnsiCompareText(CurrentToken, 'xform') = 0 then begin
Inc(ParsePos);
CurrentXForm := StrToInt(ParseValues[ParsePos]);
(*end else if AnsiCompareText(CurrentToken, 'plugins') = 0 then begin
used_plugins.Clear;
i := 0;
while true do begin
if (ParsePos + 1) >= ParseValues.Count then
break;
Inc(ParsePos);
used_plugins.Add(ParseValues[ParsePos]);
Inc(i);
end; *)
end else if AnsiCompareText(CurrentToken, 'finalxformenabled') = 0 then begin
Inc(ParsePos);
finalxformenabled := StrToInt(ParseValues[ParsePos]) <> 0;
end else if AnsiCompareText(CurrentToken, 'soloxform') = 0 then begin
Inc(ParsePos);
soloxform := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'time') = 0 then begin
Inc(ParsePos);
time := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'brightness') = 0 then begin
Inc(ParsePos);
brightness := StrToFloat(ParseValues[ParsePos]) / BRIGHT_ADJUST;
end else if AnsiCompareText(CurrentToken, 'zoom') = 0 then begin // mt
Inc(ParsePos); // mt
zoom := StrToFloat(ParseValues[ParsePos]); // mt
end else if AnsiCompareText(CurrentToken, 'angle') = 0 then begin
Inc(ParsePos);
FAngle := StrToFloat(ParseValues[ParsePos]);
// 3d camera stuff
end else if AnsiCompareText(CurrentToken, 'cam_pitch') = 0 then begin
Inc(ParsePos);
cameraPitch := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cam_yaw') = 0 then begin
Inc(ParsePos);
cameraYaw := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cam_roll') = 0 then begin
Inc(ParsePos); // AV: add third angle
cameraRoll := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cam_persp') = 0 then begin
Inc(ParsePos);
cameraPersp := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cam_zpos') = 0 then begin
Inc(ParsePos);
cameraZpos := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cam_dof') = 0 then begin
Inc(ParsePos);
cameraDOF := abs(StrToFloat(ParseValues[ParsePos]));
// end 3d
end else if AnsiCompareText(CurrentToken, 'contrast') = 0 then begin
Inc(ParsePos);
contrast := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'gamma') = 0 then begin
Inc(ParsePos);
gamma := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'vibrancy') = 0 then begin
Inc(ParsePos);
vibrancy := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'gamma_threshold') = 0 then begin
Inc(ParsePos);
gamma_threshold := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'hue_rotation') = 0 then begin
Inc(ParsePos);
hue_rotation := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'zoom') = 0 then begin
Inc(ParsePos);
zoom := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'imagesize') = 0 then begin
Inc(ParsePos);
Width := StrToInt(ParseValues[ParsePos]);
Inc(ParsePos);
Height := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'image_size') = 0 then begin
Inc(ParsePos);
Width := StrToInt(ParseValues[ParsePos]);
Inc(ParsePos);
Height := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'center') = 0 then begin
Inc(ParsePos);
center[0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
center[1] := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'background') = 0 then begin
Inc(ParsePos);
// Trap conversion errors for older parameters
try
background[0] := StrToInt(ParseValues[ParsePos]);
except on EConvertError do
background[0] := 0;
end;
Inc(ParsePos);
try
background[1] := StrToInt(ParseValues[ParsePos]);
except on EConvertError do
background[1] := 0;
end;
Inc(ParsePos);
try
background[2] := StrToInt(ParseValues[ParsePos]);
except on EConvertError do
background[2] := 0;
end;
end else if AnsiCompareText(CurrentToken, 'curves') = 0 then begin
for i := 0 to 3 do
begin
Inc(ParsePos);curvePoints[i][0].x := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][0].y := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curveWeights[i][0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][1].x := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][1].y := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curveWeights[i][1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][2].x := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][2].y := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curveWeights[i][2] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][3].x := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curvePoints[i][3].y := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);curveWeights[i][3] := StrToFloat(ParseValues[ParsePos]);
end;
end else if AnsiCompareText(CurrentToken, 'pulse') = 0 then begin
Inc(ParsePos);
pulse[0, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
pulse[0, 1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
pulse[1, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
pulse[1, 1] := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'wiggle') = 0 then begin
Inc(ParsePos);
wiggle[0, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
wiggle[0, 1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
wiggle[1, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
wiggle[1, 1] := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'pixels_per_unit') = 0 then begin
Inc(ParsePos);
pixels_per_unit := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'spatial_filter_radius') = 0 then begin
Inc(ParsePos);
spatial_filter_radius := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'spatial_oversample') = 0 then begin
Inc(ParsePos);
spatial_oversample := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'sample_density') = 0 then begin
Inc(ParsePos);
sample_density := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'nbatches') = 0 then begin
Inc(ParsePos);
nbatches := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'white_level') = 0 then begin
Inc(ParsePos);
white_level := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cmap') = 0 then begin
Inc(ParsePos);
cmapindex := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'cmap_inter') = 0 then begin
Inc(ParsePos);
cmap_inter := StrToInt(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'palette') = 0 then begin
// Inc(ParsePos);
// cmapindex := StrToInt(ParseValues[ParsePos]);
OutputDebugString(Pchar('NYI import Palette'));
end else if AnsiCompareText(CurrentToken, 'density') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].Density := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'color') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].color := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'symmetry') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].symmetry := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'coefs') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].c[0, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].c[0, 1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].c[1, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].c[1, 1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].c[2, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].c[2, 1] := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'post') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].p[0, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].p[0, 1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].p[1, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].p[1, 1] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].p[2, 0] := StrToFloat(ParseValues[ParsePos]);
Inc(ParsePos);
xform[CurrentXForm].p[2, 1] := StrToFloat(ParseValues[ParsePos]);
end else if AnsiCompareText(CurrentToken, 'postxswap') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].postXswap := (ParseValues[ParsePos] = '1');
end else if AnsiCompareText(CurrentToken, 'autozscale') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].autoZscale := (ParseValues[ParsePos] = '1');
end
////////////////////
else if AnsiCompareText(CurrentToken, 'var_order') = 0 then begin
for i := 0 to NRVAR - 1 do
xform[CurrentXForm].ifs[i] := Varnames(i);
i := 0;
while true do begin
if (ParsePos + 1) >= ParseValues.Count then
break;
if CharInSet(ParseValues[ParsePos + 1][1], ['a'..'z', 'A'..'Z', '.']) then
break;
Inc(ParsePos);
xform[CurrentXForm].ifs[i] := Varnames(StrToInt(ParseValues[ParsePos]));
Inc(i);
end;
end
//////////////////////////
else if AnsiCompareText(CurrentToken, 'vars') = 0 then begin
for i := 0 to NRVAR - 1 do begin
xform[CurrentXForm].SetVariation(i, 0.0);
end;
i := 0;
while true do begin
if (ParsePos + 1) >= ParseValues.Count then
break;
if CharInSet(ParseValues[ParsePos + 1][1], ['a'..'z', 'A'..'Z']) then
break;
Inc(ParsePos);
xform[CurrentXForm].SetVariation(i, StrToFloat(ParseValues[ParsePos]));
Inc(i);
end;
end else if AnsiCompareText(CurrentToken, 'variables') = 0 then begin
{
v := 0;
for i:= 0 to GetNrVariableNames-1 do begin
xform[CurrentXForm].SetVariable(GetVariableNameAt(i), v);
end;
}
for i:= 0 to GetNrVariableNames-1 do begin
xform[CurrentXForm].ResetVariable(GetVariableNameAt(i));
end;
i := 0;
while true do begin
if (ParsePos + 1) >= ParseValues.Count then
break;
if CharInSet(ParseValues[ParsePos + 1][1], ['a'..'z', 'A'..'Z']) then
break;
Inc(ParsePos);
v := StrToFloat(ParseValues[ParsePos]);
xform[CurrentXForm].SetVariable(GetVariableNameAt(i), v);
Inc(i);
end;
end else if AnsiCompareText(CurrentToken, 'chaos') = 0 then begin
i := 0;
while true do begin
if (ParsePos + 1) >= ParseValues.Count then
break;
if CharInSet(ParseValues[ParsePos + 1][1], ['a'..'z', 'A'..'Z']) then
break;
Inc(ParsePos);
v := StrToFloat(ParseValues[ParsePos]);
xform[CurrentXForm].modWeights[i] := v;
Inc(i);
end;
end else if AnsiCompareText(CurrentToken, 'plotmode') = 0 then begin
Inc(ParsePos);
if((StrToInt(ParseValues[ParsePos]) = 1)) then
xform[CurrentXForm].transOpacity := 0;
end else if AnsiCompareText(CurrentToken, 'opacity') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].transOpacity := (StrToFloat(ParseValues[ParsePos]));
end else if AnsiCompareText(CurrentToken, 'var_color') = 0 then begin
Inc(ParsePos);
xform[CurrentXForm].pluginColor := (StrToFloat(ParseValues[ParsePos]));
end else begin
OutputDebugString(Pchar('Unknown Token: ' + CurrentToken));
end;
Inc(ParsePos);
end;
GetCmap(cmapindex, hue_rotation, Cmap);
ParseValues.Free;
FormatSettings.DecimalSeparator := OldDecimalSperator;
end;
procedure TControlPoint.SetVariation(vari: TVariation);
var
i, j, v: integer;
rv: integer;
VarPossible: boolean;
begin
FillVarDisturb;
VarPossible := false;
for j := 0 to NRVAR - 1 do begin
VarPossible := VarPossible or Variations[j];
end;
if VarPossible then begin
repeat
rv := var_distrib[random(Length(var_distrib))];
until Variations[rv];
end else begin
rv := 0;
end;
for i := 0 to NXFORMS - 1 do begin
for j := 0 to NRVAR - 1 do begin
xform[i].SetVariation(j, 0.0);
end;
if vari = vRandom then
begin
if rv < 0 then
begin
if VarPossible then begin
repeat
v := Mixed_var_distrib[random(Length(mixed_var_distrib))];
until Variations[v]; // Use only Variations set in options
end else begin
v := 0;
end;
xform[i].SetVariation(v, 1.0);
end
else
xform[i].SetVariation(rv, 1.0);
end
else
xform[i].SetVariation(integer(vari), 1);
end;
end;
procedure TControlPoint.RandomCP(min: integer = 2; max: integer = NXFORMS; calc: boolean = true);
var
nrXforms: integer;
i, j: integer;
v, rv: integer;
VarPossible: boolean;
begin
//hue_rotation := random;
hue_rotation := 1;
cmapindex := RANDOMCMAP;
GetCmap(cmapindex, hue_rotation, cmap);
time := 0.0;
//nrXforms := xform_distrib[random(13)];
nrXforms := random(Max - (Min - 1)) + Min;
FillVarDisturb;
VarPossible := false;
for j := 0 to NRVAR - 1 do begin
VarPossible := VarPossible or Variations[j];
end;
if VarPossible then begin
repeat
rv := var_distrib[random(Length(var_distrib))];
until Variations[rv];
end else begin
rv := 0;
end;
for i := 0 to NXFORMS - 1 do begin
xform[i].density := 0;
end;
for i := 0 to nrXforms - 1 do begin
xform[i].density := 1.0 / nrXforms;
xform[i].color := i / (nrXforms - 1);
xform[i].c[0][0] := 2 * random - 1;
xform[i].c[0][1] := 2 * random - 1;
xform[i].c[1][0] := 2 * random - 1;
xform[i].c[1][1] := 2 * random - 1;
xform[i].c[2][0] := 4 * random - 2;
xform[i].c[2][1] := 4 * random - 2;
for j := 0 to NRVAR - 1 do begin
xform[i].SetVariation(j, 0);
end;
{for j := 0 to NRVAR - 1 do begin
xform[i].SetVariation(j, 0);
end; } // AV: why do we do it twice?
if rv < 0 then begin
if VarPossible then begin
repeat
v := Mixed_var_distrib[random(Length(mixed_var_distrib))];
until Variations[v]; // use only variations set in options
end else begin
v := 0;
end;
xform[i].SetVariation(v, 1);
end else
xform[i].SetVariation(rv, 1);
end;
if calc then
CalcBoundbox;
end;
procedure TControlPoint.RandomCP1;
var
i, j: Integer;
begin
RandomCP;
for i := 0 to NXFORMS - 1 do begin
for j := 0 to NRVAR - 1 do begin
xform[i].SetVariation(j, 0);
end;
xform[i].SetVariation(0, 1);
end;
CalcBoundbox;
end;
procedure TControlPoint.CalcBoundbox;
const
limit = 50; // AV
var
Points: TPointsArray; // AV: fixed - was TPointsXYArray;
i, j: integer;
deltax, minx, maxx: double;
cntminx, cntmaxx: integer;
deltay, miny, maxy: double;
cntminy, cntmaxy: integer;
LimitOutSidePoints: integer;
begin
// RandSeed := 1234567;
try
SetLength(Points, SUB_BATCH_SIZE);
Prepare;
IterateXYC(SUB_BATCH_SIZE, points); // AV: fixed - was IterateXY
LimitOutSidePoints := Round(0.05 * SUB_BATCH_SIZE);
// who've been coding this nonsence?!
minx := limit; // 1e99;
maxx := -limit; // -1e99;
miny := limit; // 1e99;
maxy := -limit; // -1e99;
for i := 0 to SUB_BATCH_SIZE - 1 do begin
//if Points[i].x > 1e200 then continue;
// AV: rewrote the block to fix the crash
if InRange(Points[i].x, -limit, limit) then
begin
minx := min(minx, Points[i].x);
maxx := max(maxx, Points[i].x);
end
else
begin
minx := -limit;
maxx := limit;
end;
if InRange(Points[i].y, -limit, limit) then
begin
miny := min(miny, Points[i].y);
maxy := max(maxy, Points[i].y);
end
else
begin
miny := -limit;
maxy := limit;
end;
end;
deltax := (maxx - minx) * 0.25;
maxx := (maxx + minx) / 2;
minx := maxx;
deltay := (maxy - miny) * 0.25;
maxy := (maxy + miny) / 2;
miny := maxy;
for j := 0 to 10 do begin
cntminx := 0;
cntmaxx := 0;
cntminy := 0;
cntmaxy := 0;
for i := 0 to SUB_BATCH_SIZE - 1 do begin
// AV: rewrote the block to fix the crash
if InRange(Points[i].x, -limit, limit) then
begin
if (Points[i].x < minx) then Inc(cntminx);
if (Points[i].x > maxx) then Inc(cntmaxx);
end;
if InRange(Points[i].y, -limit, limit) then
begin
if (Points[i].y < miny) then Inc(cntminy);
if (Points[i].y > maxy) then Inc(cntmaxy);
end;
end;
if (cntMinx < LimitOutSidePoints) then begin
minx := minx + deltax;
end else begin
minx := minx - deltax;
end;
if (cntMaxx < LimitOutSidePoints) then begin
maxx := maxx - deltax;
end else begin
maxx := maxx + deltax;
end;
deltax := deltax / 2;
if (cntMiny < LimitOutSidePoints) then begin
miny := miny + deltay;
end else begin
miny := miny - deltay;
end;
if (cntMaxy < LimitOutSidePoints) then begin
maxy := maxy - deltay;
end else begin
maxy := maxy + deltay;
end;
deltay := deltay / 2;
end;
if (abs(maxx - minx) > 1000) or
(abs(maxy - miny) > 1000) then
raise EMathError.Create('Flame area too large');
center[0] := (minx + maxx) / 2;
center[1] := (miny + maxy) / 2;
if (abs(maxx - minx) > 0.001) and (abs(maxy - miny) > 0.001) then
pixels_per_unit := 0.65 * Min(Width / abs(maxx - minx),
Height / abs(maxy - miny))
else
pixels_per_unit := 10;
except on EMathError do
begin // default
center[0] := 0;
center[1] := 0;
pixels_per_unit := 10;
end;
end;
end;
function CalcUPRMagn(const cp: TControlPoint): double;
const
limit = 50; // AV
var
Points: TPointsXYArray;
i, j: integer;
deltax, minx, maxx: double;
cntminx, cntmaxx: integer;
deltay, miny, maxy: double;
cntminy, cntmaxy: integer;
LimitOutSidePoints: integer;
xLength, yLength: double;
begin
try
SetLength(Points, SUB_BATCH_SIZE);
cp.iterateXY(SUB_BATCH_SIZE, Points);
LimitOutSidePoints := Round(0.05 * SUB_BATCH_SIZE);
minx := limit; // AV // 1E99;
maxx := -limit; // AV // -1E99;
miny := limit; // AV // 1E99;
maxy := -limit; // AV // -1E99;
{ // AV: commented out
for i := 0 to SUB_BATCH_SIZE - 1 do begin
minx := min(minx, Points[i].x);
maxx := max(maxx, Points[i].x);
miny := min(miny, Points[i].y);
maxy := max(maxy, Points[i].y);
end;
}
for i := 0 to SUB_BATCH_SIZE - 1 do begin // AV
if InRange(Points[i].x, -limit, limit) then
begin
minx := min(minx, Points[i].x);
maxx := max(maxx, Points[i].x);
end
else
begin
minx := -limit;
maxx := limit;
end;
if InRange(Points[i].y, -limit, limit) then
begin
miny := min(miny, Points[i].y);
maxy := max(maxy, Points[i].y);
end
else
begin
miny := -limit;
maxy := limit;
end;
end;
deltax := (maxx - minx) * 0.25;
maxx := (maxx + minx) / 2;
minx := maxx;
deltay := (maxy - miny) * 0.25;
maxy := (maxy + miny) / 2;
miny := maxy;
for j := 0 to 10 do begin
cntminx := 0;
cntmaxx := 0;
cntminy := 0;
cntmaxy := 0;
{ // AV: commented out
for i := 0 to SUB_BATCH_SIZE - 1 do begin
if (Points[i].x < minx) then Inc(cntminx);
if (Points[i].x > maxx) then Inc(cntmaxx);
if (Points[i].y < miny) then Inc(cntminy);
if (Points[i].y > maxy) then Inc(cntmaxy);
end;
}
for i := 0 to SUB_BATCH_SIZE - 1 do begin // AV
if InRange(Points[i].x, -limit, limit) then
begin
if (Points[i].x < minx) then Inc(cntminx);
if (Points[i].x > maxx) then Inc(cntmaxx);
end;
if InRange(Points[i].y, -limit, limit) then
begin
if (Points[i].y < miny) then Inc(cntminy);
if (Points[i].y > maxy) then Inc(cntmaxy);
end;
end;
if (cntMinx < LimitOutSidePoints) then begin
minx := minx + deltax;
end else begin
minx := minx - deltax;
end;
if (cntMaxx < LimitOutSidePoints) then begin
maxx := maxx - deltax;
end else begin
maxx := maxx + deltax;
end;
deltax := deltax / 2;
if (cntMiny < LimitOutSidePoints) then begin
miny := miny + deltay;
end else begin
miny := miny - deltay;
end;
if (cntMaxy < LimitOutSidePoints) then begin
maxy := maxy - deltay;
end else begin
maxy := maxy + deltay;
end;
deltay := deltay / 2;
end;
if ((maxx - minx) > 1000) or
((maxy - miny) > 1000) then
raise EMathError.Create('Flame area too large');
cp.center[0] := (minx + maxx) / 2;
cp.center[1] := (miny + maxy) / 2;
if ((maxx - minx) > 0.001) and ((maxy - miny) > 0.001) then
cp.pixels_per_unit := 0.7 * Min(cp.width / (maxx - minx), cp.height / (maxy - miny))
else
cp.pixels_per_unit := 10;
// Calculate magn for UPRs
xLength := maxx - minx;
yLength := maxy - miny;
if xLength >= yLength then
begin
result := 1 / xLength * 2;
end
else
begin
result := 1 / yLength * 2;
end;
except on E: EMathError do
begin// default
cp.center[0] := 0;
cp.center[1] := 0;
cp.pixels_per_unit := 10;
raise Exception.Create('CalcUPRMagn: ' + e.Message);
end;
end;
end;
// AV: this one from mine is used only for scripting, the original method was left for mutants
procedure TControlPoint.InterpolateAll(cp1, cp2: TControlPoint; Tm: double; it: integer);
var
result: TControlPoint;
c0, c1, k: double;
i, j: integer;
numTX, numTX1, numTX2: word;
r, s, t: array[0..2] of double;
v1, v2: double;
function AngOpt(ang0, ang1: double): double;
var delta: double;
begin
delta := ang1 - ang0;
if (delta > pi) then Result := ang1 - 2 * pi
else if (delta < -pi)then Result := ang1 + 2 * pi
else Result := ang1;
end;
begin
if (it > 3) or (it < 0) then Exit;
if (cp2.time - cp1.time) > 1E-6 then
begin
if (it < 2) then begin // 0 or 1: cosine interpolation
k := (cp2.time - tm) / (cp2.time - cp1.time);
c0 := (1 - cos(pi*k))* 0.5;
end
else // 2 or 3: linear interpolation
c0:=(cp2.time - tm) / (cp2.time - cp1.time);
c1 := 1 - c0;
end else begin
c0 := 1;
c1 := 0;
end;
Result := TControlPoint.Create;
Result.time := Tm;
if Odd(it) then // 1 or 3: hsv interpolation
for i := 0 to 255 do
begin
r[0] := cp1.cmap[i][0] / 255;
r[1] := cp1.cmap[i][1] / 255;
r[2] := cp1.cmap[i][2] / 255;
rgb2hsv(r, s);
r[0] := cp2.cmap[i][0] / 255;
r[1] := cp2.cmap[i][1] / 255;
r[2] := cp2.cmap[i][2] / 255;
rgb2hsv(r, t);
t[0] := c0 * s[0] + c1 * t[0];
t[1] := c0 * s[1] + c1 * t[1];
t[2] := c0 * s[2] + c1 * t[2];
hsv2rgb(t, r);
Result.cmap[i][0] := Round(255 * r[0]);
Result.cmap[i][1] := Round(255 * r[1]);
Result.cmap[i][2] := Round(255 * r[2]);
end
else // 0 or 2: rgb interpolation
for i := 0 to 255 do
begin
Result.cmap[i][0] := Round(c0 * cp1.cmap[i][0] + c1 * cp2.cmap[i][0]);
Result.cmap[i][1] := Round(c0 * cp1.cmap[i][1] + c1 * cp2.cmap[i][1]);
Result.cmap[i][2] := Round(c0 * cp1.cmap[i][2] + c1 * cp2.cmap[i][2]);
end;
Result.cmapindex := -1;
Result.Fbrightness := c0 * cp1.Fbrightness + c1 * cp2.Fbrightness;
Result.contrast := c0 * cp1.contrast + c1 * cp2.contrast;
Result.gamma := c0 * cp1.gamma + c1 * cp2.gamma;
Result.vibrancy := c0 * cp1.vibrancy + c1 * cp2.vibrancy;
Result.gamma_threshold := c0 * cp1.gamma_threshold + c1 * cp2.gamma_threshold;
Result.width := cp1.width;
Result.height := cp1.height;
Result.spatial_oversample := Round(c0 * cp1.spatial_oversample + c1 * cp2.spatial_oversample);
Result.center[0] := c0 * cp1.center[0] + c1 * cp2.center[0];
Result.center[1] := c0 * cp1.center[1] + c1 * cp2.center[1];
Result.FAngle := c0 * cp1.FAngle + c1 * AngOpt(cp1.FAngle, cp2.FAngle);
Result.pixels_per_unit := c0 * cp1.pixels_per_unit + c1 * cp2.pixels_per_unit;
Result.background[0] := Round(c0 * cp1.background[0] + c1 * cp2.background[0]);
Result.background[1] := Round(c0 * cp1.background[1] + c1 * cp2.background[1]);
Result.background[2] := Round(c0 * cp1.background[2] + c1 * cp2.background[2]);
Result.spatial_filter_radius := c0 * cp1.spatial_filter_radius + c1 * cp2.spatial_filter_radius;
Result.sample_density := c0 * cp1.sample_density + c1 * cp2.sample_density;
Result.zoom := c0 * cp1.zoom + c1 * cp2.zoom;
Result.nbatches := Round(c0 * cp1.nbatches + c1 * cp2.nbatches);
Result.white_level := Round(c0 * cp1.white_level + c1 * cp2.white_level);
Result.finalXformEnabled := cp1.finalXformEnabled or cp2.finalXformEnabled;
{ AV: global 3D-parameters}
Result.cameraPitch := c0 * cp1.cameraPitch + c1 * AngOpt(cp1.cameraPitch, cp2.cameraPitch);
Result.cameraYaw := c0 * cp1.cameraYaw + c1 * AngOpt(cp1.cameraYaw, cp2.cameraYaw);
Result.cameraRoll := c0 * cp1.cameraRoll + c1 * AngOpt(cp1.cameraRoll, cp2.cameraRoll);
Result.cameraPersp := c0 * cp1.cameraPersp + c1 * cp2.cameraPersp;
Result.cameraZpos := c0 * cp1.cameraZpos + c1 * cp2.cameraZpos;
Result.cameraDOF := c0 * cp1.cameraDOF + c1 * cp2.cameraDOF;
for i := 0 to 3 do begin
// Result.pulse[i div 2][i mod 2] := c0 * cp1.pulse[i div 2][i mod 2] + c1 * cp2.pulse[i div 2][i mod 2];
// Result.wiggle[i div 2][i mod 2] := c0 * cp1.wiggle[i div 2][i mod 2] + c1 * cp2.wiggle[i div 2][i mod 2];
Result.curvePoints[i][0].x := c0 * cp1.curvePoints[i][0].x + c1 * cp2.curvePoints[i][0].x;
Result.curvePoints[i][0].y := c0 * cp1.curvePoints[i][0].y + c1 * cp2.curvePoints[i][0].y;
Result.curveWeights[i][0] := c0 * cp1.curveWeights[i][0] + c1 * cp2.curveWeights[i][0];
Result.curvePoints[i][1].x := c0 * cp1.curvePoints[i][1].x + c1 * cp2.curvePoints[i][1].x;
Result.curvePoints[i][1].y := c0 * cp1.curvePoints[i][1].y + c1 * cp2.curvePoints[i][1].y;
Result.curveWeights[i][1] := c0 * cp1.curveWeights[i][1] + c1 * cp2.curveWeights[i][1];
Result.curvePoints[i][2].x := c0 * cp1.curvePoints[i][2].x + c1 * cp2.curvePoints[i][2].x;
Result.curvePoints[i][2].y := c0 * cp1.curvePoints[i][2].y + c1 * cp2.curvePoints[i][2].y;
Result.curveWeights[i][2] := c0 * cp1.curveWeights[i][2] + c1 * cp2.curveWeights[i][2];
Result.curvePoints[i][3].x := c0 * cp1.curvePoints[i][2].x + c1 * cp2.curvePoints[i][2].x;
Result.curvePoints[i][3].y := c0 * cp1.curvePoints[i][3].y + c1 * cp2.curvePoints[i][3].y;
Result.curveWeights[i][3] := c0 * cp1.curveWeights[i][3] + c1 * cp2.curveWeights[i][3];
end;
numTX1 := cp1.NumXForms;
numTX2 := cp2.NumXForms;
numTX := max(numTX1, numTX2); // actual xforms including final
if Result.finalXformEnabled then
begin
if cp1.finalXformEnabled then
begin
if numTX1 < numTX then
begin
cp1.xform[numTX].Assign(cp1.xform[numTX1]);
cp1.xform[numTX1].Clear;
end;
end
else
cp1.xform[numTX].symmetry := 1;
if cp2.finalXformEnabled then
begin
if numTX2 < numTX then
begin
cp2.xform[numTX].Assign(cp2.xform[numTX2]);
cp2.xform[numTX2].Clear;
end;
end
else
cp2.xform[numTX].symmetry := 1;
// final XForm
Result.xform[numTX].color := c0 * cp1.xform[numTX].color + c1 * cp2.xform[numTX].color;
Result.xform[numTX].symmetry := c0 * cp1.xform[numTX].symmetry + c1 * cp2.xform[numTX].symmetry;
Result.xform[numTX].pluginColor := c0 * cp1.xform[numTX].pluginColor + c1 * cp2.xform[numTX].pluginColor;
Result.xform[numTX].ifs.Assign(cp2.xform[numTX].ifs); // AV: target variation order
for j := 0 to NrVar-1 do
Result.xform[numTX].SetVariation(j, c0 * cp1.xform[numTX].GetVariation(j) + c1 * cp2.xform[numTX].GetVariation(j));
for j:= 0 to GetNrVariableNames-1 do begin
cp1.xform[numTX].GetVariable(GetVariableNameAt(j), v1);
cp2.xform[numTX].GetVariable(GetVariableNameAt(j), v2);
v1 := c0 * v1 + c1 * v2;
Result.xform[numTX].SetVariable(GetVariableNameAt(j), v1);
end;
for j := 0 to 2 do begin
Result.xform[numTX].c[j, 0] := c0 * cp1.xform[numTX].c[j, 0] + c1 * cp2.xform[numTX].c[j, 0];
Result.xform[numTX].c[j, 1] := c0 * cp1.xform[numTX].c[j, 1] + c1 * cp2.xform[numTX].c[j, 1];
Result.xform[numTX].p[j, 0] := c0 * cp1.xform[numTX].p[j, 0] + c1 * cp2.xform[numTX].p[j, 0];
Result.xform[numTX].p[j, 1] := c0 * cp1.xform[numTX].p[j, 1] + c1 * cp2.xform[numTX].p[j, 1];
end;
end else
Result.xform[numTX].symmetry := 1;
// regular xforms
for i := 0 to numTX-1 do begin
Result.xform[i].density := c0 * cp1.xform[i].density + c1 * cp2.xform[i].density;
Result.xform[i].color := c0 * cp1.xform[i].color + c1 * cp2.xform[i].color;
Result.xform[i].symmetry := c0 * cp1.xform[i].symmetry + c1 * cp2.xform[i].symmetry;
Result.xform[i].transOpacity := c0 * cp1.xform[i].transOpacity + c1 * cp2.xform[i].transOpacity;
Result.xform[i].pluginColor := c0 * cp1.xform[i].pluginColor + c1 * cp2.xform[i].pluginColor;
for j := 0 to numTX - 1 do
Result.xform[i].modWeights[j] := c0 * cp1.xform[i].modWeights[j] + c1 * cp2.xform[i].modWeights[j];
Result.xform[i].ifs.Assign(cp2.xform[i].ifs); // AV: target variation order
for j := 0 to NrVar-1 do
Result.xform[i].SetVariation(j, c0 * cp1.xform[i].GetVariation(j) + c1 * cp2.xform[i].GetVariation(j));
for j:= 0 to GetNrVariableNames-1 do begin
cp1.xform[i].GetVariable(GetVariableNameAt(j), v1);
cp2.xform[i].GetVariable(GetVariableNameAt(j), v2);
v1 := c0 * v1 + c1 * v2;
Result.xform[i].SetVariable(GetVariableNameAt(j), v1);
end;
// interpol matrices
for j := 0 to 2 do begin
Result.xform[i].c[j, 0] := c0 * cp1.xform[i].c[j, 0] + c1 * cp2.xform[i].c[j, 0];
Result.xform[i].c[j, 1] := c0 * cp1.xform[i].c[j, 1] + c1 * cp2.xform[i].c[j, 1];
Result.xform[i].p[j, 0] := c0 * cp1.xform[i].p[j, 0] + c1 * cp2.xform[i].p[j, 0];
Result.xform[i].p[j, 1] := c0 * cp1.xform[i].p[j, 1] + c1 * cp2.xform[i].p[j, 1];
end;
end;
if Result.NumXForms < numTX then
begin
Result.xform[Result.NumXForms].Assign(Result.xform[numTX]);
Result.xform[numTX].Clear;
end;
if numTX1 < numTX then
begin
cp1.xform[numTX1].Assign(cp1.xform[numTX]);
cp1.xform[numTX].Clear;
end;
if numTX2 < Result.NumXForms then
begin
cp2.xform[numTX2].Assign(cp2.xform[numTX]);
cp2.xform[numTX].Clear;
end;
Copy(Result, false, numTX);
cmap := Result.cmap;
result.free;
end;
procedure TControlPoint.InterpolateX(cp1, cp2: TControlPoint; Tm: double);
var
result: TControlPoint;
c0, c1: double;
i, j: integer;
r, s, t: array[0..2] of double;
v1, v2: double;
// totvar: double;
{z,rhtime: double;}
nXforms1, nXforms2: integer;
begin
if (cp2.time - cp1.time) > 1E-6 then begin
c0 := (cp2.time - tm) / (cp2.time - cp1.time);
c1 := 1 - c0;
end else begin
c0 := 1;
c1 := 0;
end;
Result := TControlPoint.Create;
Result.time := Tm;
{ // AV: since from now this is used only for mutants, we can skip it
if cp1.cmap_inter = 0 then
for i := 0 to 255 do begin
r[0] := cp1.cmap[i][0] / 255;
r[1] := cp1.cmap[i][1] / 255;
r[2] := cp1.cmap[i][2] / 255;
rgb2hsv(r, s);
r[0] := cp2.cmap[i][0] / 255;
r[1] := cp2.cmap[i][1] / 255;
r[2] := cp2.cmap[i][2] / 255;
rgb2hsv(r, t);
t[0] := c0 * s[0] + c1 * t[0];
t[1] := c0 * s[1] + c1 * t[1];
t[2] := c0 * s[2] + c1 * t[2];
hsv2rgb(t, r);
Result.cmap[i][0] := Round(255 * r[0]);
Result.cmap[i][1] := Round(255 * r[1]);
Result.cmap[i][2] := Round(255 * r[2]);
end;
}
Result.cmap := cp1.cmap; // AV
Result.cmapindex := -1;
Result.Fbrightness := c0 * cp1.Fbrightness + c1 * cp2.Fbrightness;
Result.contrast := c0 * cp1.contrast + c1 * cp2.contrast;
Result.gamma := c0 * cp1.gamma + c1 * cp2.gamma;
Result.vibrancy := c0 * cp1.vibrancy + c1 * cp2.vibrancy;
Result.gamma_threshold := c0 * cp1.gamma_threshold + c1 * cp2.gamma_threshold;
Result.width := cp1.width;
Result.height := cp1.height;
Result.spatial_oversample := Round(c0 * cp1.spatial_oversample + c1 * cp2.spatial_oversample);
Result.center[0] := c0 * cp1.center[0] + c1 * cp2.center[0];
Result.center[1] := c0 * cp1.center[1] + c1 * cp2.center[1];
Result.FAngle := c0 * cp1.FAngle + c1 * cp2.FAngle;
Result.pixels_per_unit := c0 * cp1.pixels_per_unit + c1 * cp2.pixels_per_unit;
{ // AV: since from now this is used only for mutants, we can skip it
Result.background[0] := c0 * cp1.background[0] + c1 * cp2.background[0];
Result.background[1] := c0 * cp1.background[1] + c1 * cp2.background[1];
Result.background[2] := c0 * cp1.background[2] + c1 * cp2.background[2];
}
Result.spatial_filter_radius := c0 * cp1.spatial_filter_radius + c1 * cp2.spatial_filter_radius;
Result.sample_density := c0 * cp1.sample_density + c1 * cp2.sample_density;
Result.zoom := c0 * cp1.zoom + c1 * cp2.zoom;
Result.nbatches := Round(c0 * cp1.nbatches + c1 * cp2.nbatches);
{
Result.white_level := Round(c0 * cp1.white_level + c1 * cp2.white_level);
for i := 0 to 3 do begin
Result.pulse[i div 2][i mod 2] := c0 * cp1.pulse[i div 2][i mod 2] + c1 * cp2.pulse[i div 2][i mod 2];
Result.wiggle[i div 2][i mod 2] := c0 * cp1.wiggle[i div 2][i mod 2] + c1 * cp2.wiggle[i div 2][i mod 2];
end;
}
Result.cameraPitch := c0 * cp1.cameraPitch; // AV
Result.cameraYaw := c0 * cp1.cameraYaw; // AV
Result.cameraRoll := c0 * cp1.cameraRoll; // AV
// save finalxform from mut(il)ation ;)
nXforms1 := cp1.NumXForms;
if cp1.HasFinalXForm then
begin
if nXforms1 < NXFORMS then
begin
cp1.xform[NXFORMS].Assign(cp1.xform[nXforms1]);
cp1.xform[nXforms1].Clear;
end;
end
else begin
cp1.xform[NXFORMS].Clear;
cp1.xform[NXFORMS].symmetry := 1;
end;
nXforms2 := cp2.NumXForms;
if cp2.HasFinalXForm then
begin
if nXforms2 < NXFORMS then
begin
cp2.xform[NXFORMS].Assign(cp2.xform[nXforms2]);
cp2.xform[nXforms2].Clear;
end;
end
else begin
cp2.xform[NXFORMS].Clear;
cp2.xform[NXFORMS].symmetry := 1;
end;
for i := 0 to NXFORMS do
begin
Result.xform[i].density := c0 * cp1.xform[i].density + c1 * cp2.xform[i].density;
// AV: since we don't change final xforms, we can speed up the calculations
if Result.xform[i].density = 0.0 then break;
Result.xform[i].color := c0 * cp1.xform[i].color + c1 * cp2.xform[i].color;
Result.xform[i].symmetry := c0 * cp1.xform[i].symmetry + c1 * cp2.xform[i].symmetry;
Result.xform[i].transOpacity := c0 * cp1.xform[i].transOpacity + c1; // AV
for j := 0 to NrVar-1 do
Result.xform[i].SetVariation(j, c0 * cp1.xform[i].GetVariation(j) + c1 * cp2.xform[i].GetVariation(j));
for j:= 0 to GetNrVariableNames-1 do begin
cp1.xform[i].GetVariable(GetVariableNameAt(j), v1);
cp2.xform[i].GetVariable(GetVariableNameAt(j), v2);
v1 := c0 * v1 + c1 * v2;
Result.xform[i].SetVariable(GetVariableNameAt(j), v1);
end;
// interpol matrix
for j := 0 to 2 do begin
Result.xform[i].c[j, 0] := c0 * cp1.xform[i].c[j, 0] + c1 * cp2.xform[i].c[j, 0];
Result.xform[i].c[j, 1] := c0 * cp1.xform[i].c[j, 1] + c1 * cp2.xform[i].c[j, 1];
// AV
Result.xform[i].p[j, 0] := c0 * cp1.xform[i].p[j, 0] + c1 * cp2.xform[i].p[j, 0];
Result.xform[i].p[j, 1] := c0 * cp1.xform[i].p[j, 1] + c1 * cp2.xform[i].p[j, 1];
end;
end;
// finalxform was supposed to be mutate-able too, but somehow it's always
// getting confused by random-generated mutatns :-\
if Result.NumXForms < NXFORMS then
begin
Result.xform[Result.NumXForms].Assign(cp1.xform[NXFORMS]); //result.xform[NXFORMS]);
Result.xform[NXFORMS].Clear;
end;
Result.finalXformEnabled := cp1.finalXformEnabled;
// restore finalxforms in source CPs
if nXforms1 < NXFORMS then
begin
cp1.xform[nXforms1].Assign(cp1.xform[NXFORMS]);
cp1.xform[NXFORMS].Clear;
end;
if nXforms2 < NXFORMS then
begin
cp2.xform[nXforms2].Assign(cp2.xform[NXFORMS]);
cp2.xform[NXFORMS].Clear;
end;
Copy(Result, false, max(nxForms1, nxForms2)); // AV: added 2 parameters
cmap := Result.cmap;
result.free;
end;
procedure TControlPoint.SaveToFile(Filename: string);
var
sl: TStringlist;
begin
sl := TStringlist.Create;
SaveToStringlist(sl);
sl.SaveToFile(filename);
sl.Free;
end;
procedure TControlPoint.SaveToStringlist(sl: TStringlist);
var
i, j, k: Integer;
s: string;
OldDecimalSperator: Char;
v: double;
str: string;
curves: string;
begin
OldDecimalSperator := FormatSettings.DecimalSeparator;
FormatSettings.DecimalSeparator := '.';
sl.add(format('time %f', [time]));
if cmapindex >= 0 then
sl.add(format('cmap %d', [cmapindex]));
sl.add(format('zoom %g', [zoom])); // mt
sl.add(format('angle %g', [FAngle]));
sl.add(format('cam_pitch %g', [cameraPitch]));
sl.add(format('cam_yaw %g', [cameraYaw]));
sl.add(format('cam_roll %g', [cameraRoll])); // AV
sl.add(format('cam_persp %g', [cameraPersp]));
sl.add(format('cam_zpos %g', [cameraZpos]));
sl.add(format('cam_dof %g', [cameraDOF]));
for i := 0 to 3 do
begin
curves := curves + FloatToStr(curvePoints[i][0].x) + ' ';
curves := curves + FloatToStr(curvePoints[i][0].y) + ' ';
curves := curves + FloatToStr(curveWeights[i][0]) + ' ';
curves := curves + FloatToStr(curvePoints[i][1].x) + ' ';
curves := curves + FloatToStr(curvePoints[i][1].y) + ' ';
curves := curves + FloatToStr(curveWeights[i][1]) + ' ';
curves := curves + FloatToStr(curvePoints[i][2].x) + ' ';
curves := curves + FloatToStr(curvePoints[i][2].y) + ' ';
curves := curves + FloatToStr(curveWeights[i][2]) + ' ';
curves := curves + FloatToStr(curvePoints[i][3].x) + ' ';
curves := curves + FloatToStr(curvePoints[i][3].y) + ' ';
curves := curves + FloatToStr(curveWeights[i][3]) + ' ';
end;
curves := trim(curves);
sl.Add(Format('curves %s', [curves]));
sl.add(format('image_size %d %d center %g %g pixels_per_unit %f',
[Width, Height, center[0], center[1], pixels_per_unit]));
sl.add(format('spatial_oversample %d spatial_filter_radius %f',
[spatial_oversample, spatial_filter_radius]));
sl.add(format('sample_density %g', [sample_density]));
// sl.add(format('nbatches %d white_level %d background %f %f %f', - changed to integers - mt
sl.add(format('nbatches %d white_level %d background %d %d %d',
[nbatches, white_level, background[0], background[1], background[2]]));
sl.add(format('brightness %f gamma %f contrast %f vibrancy %f gamma_threshold %f hue_rotation %f cmap_inter %d',
[Fbrightness * BRIGHT_ADJUST, gamma, contrast, vibrancy, gamma_threshold, hue_rotation, cmap_inter])); // AV: added contrast
sl.add(format('finalxformenabled %d', [ifthen(finalxformenabled, 1, 0)]));
sl.add(format('soloxform %d', [soloXform]));
(*str := '';
for i := 0 to used_plugins.Count-1 do begin
str := str + used_plugins[i];
if (i = used_plugins.Count-1) then break;
str := str + ' ';
end;
sl.Add(format('plugins %s', [str])); *)
for i := 0 to Min(NumXForms+1, NXFORMS) do
with xform[i] do begin
//if density = 0 then continue; - FinalXform has weight=0
sl.add(format('xform %d density %g color %g symmetry %g', [i, density, color, symmetry]));
/////// AV: try to write variation order
s := 'var_order';
for j := 0 to NRVAR - 1 do begin
s := format('%s %d', [s, GetVariationIndex(ifs[j])]);
end;
sl.add(s);
//////////////////////////
s := 'vars';
for j := 0 to NRVAR - 1 do begin
s := format('%s %g', [s, GetVariation(j)]);
end;
sl.add(s);
s := 'variables';
for j:= 0 to GetNrVariableNames-1 do begin
{$ifndef VAR_STR}
GetVariable(GetVariableNameAt(j), v);
s := format('%s %g', [s, v]);
{$else}
s := s + ' ' + GetVariableStr(GetVariableNameAt(j));
{$endif}
end;
sl.add(s);
sl.Add(format('coefs %.6f %.6f %.6f %.6f %.6f %.6f',
[c[0][0], c[0][1], c[1][0], c[1][1], c[2][0], c[2][1]]));
sl.Add(format('post %.6f %.6f %.6f %.6f %.6f %.6f',
[p[0][0], p[0][1], p[1][0], p[1][1], p[2][0], p[2][1]]));
if postXswap then
sl.Add('postxswap 1')
else
sl.Add('postxswap 0');
if autoZscale then
sl.Add('autozscale 1')
else
sl.Add('autozscale 0');
s := 'chaos';
for j := 0 to NumXForms+1 do begin
s := s + format(' %g', [modWeights[j]]);
end;
sl.Add(s);
sl.Add(format('opacity %g', [transOpacity]));
sl.Add(format('var_color %g', [pluginColor]));
end;
FormatSettings.DecimalSeparator := OldDecimalSperator;
end;
procedure WriteDoubles(const handle: File; data: array of double);
var
block: TBlock;
i: integer;
begin
for i := 0 to Length(data)-1 do begin
DoubleToBlock(block, 0, 0); //pad to blocksize
DoubleToBlock(block, 8, data[i]);
BlockWrite(handle, block, 1);
end;
end;
procedure WriteString(const handle: File; data: string);
var
k, l, size, chunks: Integer;
raw : THibRawString;
block: TBlock;
begin
size := Length(data);
SetLength(raw, size);
CopyMemory(@raw[0], @data[1], size);
chunks := size div HIB_BLOCKSIZE;
if size mod HIB_BLOCKSIZE > 0 then begin
size := (1 + size div HIB_BLOCKSIZE) * HIB_BLOCKSIZE;
chunks := chunks + 1;
end;
for k := 0 to chunks - 1 do begin
for l := 0 to HIB_MAXOFFSET do
if (k * HIB_BLOCKSIZE + l) < size then
block[l] := raw[k * HIB_BLOCKSIZE + l]
else block[l] := 0;
BlockWrite(handle, block, 1);
end;
end;
function CalcBinaryFlameSize(cp: TControlPoint): integer;
var
(*str: string;
i, nvariations, nvariables, nchaos: Integer;*)
handle: File;
begin
// I'm a bit ashamed but this hack has do to it for now...
AssignFile(handle, GetEnvironmentVariable('TEMP') + '\CalcBinaryFlameSizeTemp.bin');
ReWrite(handle, HIB_BLOCKSIZE);
cp.SaveToBinary(handle);
Result := FileSize(handle) * HIB_BLOCKSIZE;
CloseFile(handle);
DeleteFile(GetEnvironmentVariable('TEMP') + '\CalcBinaryFlameSizeTemp.bin');
(*// CP data
Result := 224;
// Var list
str := '';
for i := 0 to NRVAR-1 do
str := str + VarNames(i) + #13#10;
for i:= 0 to GetNrVariableNames-1 do
str := str + GetVariableNameAt(i)+ #13#10;
str := trim(str);
if Length(str) mod HIB_BLOCKSIZE > 0 then
Result := Result + (1 + Length(str) div HIB_BLOCKSIZE) * HIB_BLOCKSIZE
else
Result := Result + Length(str);
// XForm data
nchaos := Min(cp.NumXForms+1, NXFORMS);
nvariations := NRVAR;
nvariables := GetNrVariableNames;
if nvariations mod 2 > 0 then
nvariations := nvariations + 1;
if nvariables mod 2 > 0 then
nvariables := nvariables + 1;
if nchaos mod 2 > 0 then
nchaos := nchaos + 1;
Result := Result + (144 + (nvariations + nvariables + nchaos) * 8) *
Min(cp.NumXForms+1, NXFORMS); *)
end;
procedure TControlPoint.SaveToBinary(const handle: File);
var
i, j, nvariations, nvariables, nchaos: Integer;
v: double;
str: string;
dbl: array of double;
block: TBlock;
begin
DoubleToBlock(block, 0, time);
DoubleToBlock(block, 8, zoom);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, FAngle);
DoubleToBlock(block, 8, pixels_per_unit);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, center[0]);
DoubleToBlock(block, 8, center[1]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, cameraPitch);
DoubleToBlock(block, 8, cameraYaw);
BlockWrite(handle, block, 1);
// AV TODO: cam_roll, contrast and var_order
DoubleToBlock(block, 0, cameraPersp);
DoubleToBlock(block, 8, cameraZpos);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, cameraDOF);
DoubleToBlock(block, 8, spatial_filter_radius);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, sample_density);
DoubleToBlock(block, 8, gamma_threshold);
BlockWrite(handle, block, 1);
Int32ToBlock(block, 0, cmapindex);
Int32ToBlock(block, 4, spatial_oversample);
Int32ToBlock(block, 8, Width);
Int32ToBlock(block, 12, Height);
BlockWrite(handle, block, 1);
Int32ToBlock(block, 0, nbatches);
Int32ToBlock(block, 4, cmap_inter);
Int32ToBlock(block, 8, ifthen(finalxformenabled, 1, 0));
Int32ToBlock(block, 12, soloXform);
BlockWrite(handle, block, 1);
Int32ToBlock(block, 0, white_level);
Int32ToBlock(block, 4, background[0]);
Int32ToBlock(block, 8, background[1]);
Int32ToBlock(block, 12, background[2]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, Fbrightness * BRIGHT_ADJUST);
DoubleToBlock(block, 8, gamma);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, vibrancy);
DoubleToBlock(block, 8, hue_rotation);
BlockWrite(handle, block, 1);
nchaos := Min(NumXForms+1, NXFORMS);
nvariations := NRVAR;
nvariables := GetNrVariableNames;
Int32ToBlock(block, 0, nvariations);
Int32ToBlock(block, 4, nvariables);
Int32ToBlock(block, 8, nchaos);
str := '';
for i := 0 to nvariations-1 do
str := str + VarNames(i) + #0;
for i:= 0 to nvariables-1 do
str := str + GetVariableNameAt(i)+ #0;
str := trim(str);
if Length(str) mod HIB_BLOCKSIZE > 0 then
Int32ToBlock(block, 12, (1 + Length(str) div HIB_BLOCKSIZE) * HIB_BLOCKSIZE)
else
Int32ToBlock(block, 12, Length(str));
BlockWrite(handle, block, 1);
WriteString(handle, str);
for i := 0 to nchaos - 1 do
with xform[i] do begin
DoubleToBlock(block, 0, density);
DoubleToBlock(block, 8, color);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, symmetry);
DoubleToBlock(block, 8, transOpacity);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, pluginColor);
Int32ToBlock(block, 8, IfThen(postXswap, 1, 0));
Int32ToBlock(block, 12, IfThen(autozscale, 1, 0));
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, c[0][0]);
DoubleToBlock(block, 8, c[0][1]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, c[1][0]);
DoubleToBlock(block, 8, c[1][1]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, c[2][0]);
DoubleToBlock(block, 8, c[2][1]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, p[0][0]);
DoubleToBlock(block, 8, p[0][1]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, p[1][0]);
DoubleToBlock(block, 8, p[1][1]);
BlockWrite(handle, block, 1);
DoubleToBlock(block, 0, p[2][0]);
DoubleToBlock(block, 8, p[2][1]);
BlockWrite(handle, block, 1);
SetLength(dbl, nvariations);
for j := 0 to nvariations-1 do
dbl[j] := GetVariation(j);
WriteDoubles(handle, dbl);
SetLength(dbl, nvariables);
for j := 0 to nvariables-1 do
GetVariable(GetVariableNameAt(j), dbl[j]);
WriteDoubles(handle, dbl);
SetLength(dbl, nchaos);
for j := 0 to nchaos-1 do
dbl[j] := xform[i].modWeights[j];
WriteDoubles(handle, dbl);
end;
end;
function TControlPoint.Clone: TControlPoint;
var
i, j: integer;
sl: TStringList;
begin
sl := TStringList.Create;
SaveToStringlist(sl);
Result := TControlPoint.Create;
Result.ParseStringlist(sl);
Result.Fangle := FAngle;
Result.cmap := cmap;
Result.name := name;
//Result.nick := nick;
//Result.url := url;
Result.hue_rotation := hue_rotation; // AV
Result.Transparency := Transparency;
Result.gamma_threshold := gamma_threshold;
Result.estimator := estimator;
Result.estimator_min := estimator_min;
Result.estimator_curve := estimator_curve;
Result.enable_de := enable_de;
Result.xdata := xdata;
Result.Background[0] := background[0];
Result.Background[1] := background[1];
Result.Background[2] := background[2];
for i := 0 to 3 do
for j := 0 to 3 do begin
Result.CurveWeights[i,j] := curveWeights[i,j];
Result.curvePoints[i,j].x := curvePoints[i,j].x;
Result.curvePoints[i,j].y := curvePoints[i,j].y;
end;
Result.used_plugins.Clear;
Result.used_plugins.AddStrings(used_plugins); // AV
{ for i := 0 to used_plugins.Count-1 do
Result.used_plugins.Add(used_plugins[i]); }
for i := 0 to NXFORMS - 1 do
Result.xform[i].assign(xform[i]);
sl.Free;
end;
procedure TControlPoint.Copy(cp1: TControlPoint; KeepSizes: boolean = false; nt: byte = NXFORMS);
var
i, j: integer;
sl: TStringList;
w, h: integer;
begin
w := Width;
h := Height;
Clear;
sl := TStringList.Create;
// --Z-- this is quite a weird and unoptimal way to copy things:
cp1.SaveToStringlist(sl);
ParseStringlist(sl);
Fangle := cp1.FAngle;
center[0]:= cp1.center[0];
center[1]:= cp1.center[1];
pixels_per_unit := cp1.pixels_per_unit;
cmap := cp1.cmap;
name := cp1.name;
//nick := cp1.nick;
//url := cp1.url;
hue_rotation := cp1.hue_rotation; // AV
gamma_threshold := cp1.gamma_threshold;
estimator := cp1.estimator;
estimator_min := cp1.estimator_min;
estimator_curve := cp1.estimator_curve;
enable_de := cp1.enable_de;
// used_plugins := cp1.used_plugins; // <<--- fixed memory leak // AV
xdata := cp1.xdata;
background[0] := cp1.background[0];
background[1] := cp1.background[1];
background[2] := cp1.background[2];
for i := 0 to 3 do
for j := 0 to 3 do begin
CurveWeights[i,j] := cp1.curveWeights[i,j];
curvePoints[i,j].x := cp1.curvePoints[i,j].x;
curvePoints[i,j].y := cp1.curvePoints[i,j].y;
end;
if KeepSizes then
AdjustScale(w, h);
used_plugins.Clear;
// AV: that's how we must copy strings:
used_plugins.AddStrings(cp1.used_plugins);
{ for i := 0 to cp1.used_plugins.Count-1 do
used_plugins.Add(cp1.used_plugins[i]); }
// AV: to speed up the interpolation
for i := 0 to nt {NXFORMS} do // was: NXFORMS-1
xform[i].assign(cp1.xform[i]);
finalXformEnabled := cp1.finalXformEnabled;
sl.Free;
end;
procedure TControlPoint.ParseStringList(sl: TStringlist);
var
s: string;
i: integer;
begin
finalXformEnabled := false;
for i := 0 to sl.Count - 1 do begin
s := s + sl[i] + ' ';
end;
ParseString(s);
end;
procedure TControlPoint.Clear;
var
i, j: Integer;
begin
symmetry := 0;
cmapindex := -1;
hue_rotation := 1; // AV
zoom := 0;
xdata := '';
for i := 0 to NXFORMS do xform[i].Clear;
FinalXformEnabled := false;
soloxform := -1;
for i := 0 to 3 do
begin
curvePoints[i][0].x := 0.00; curvePoints[i][0].y := 0.00; curveWeights[i][0] := 1;
curvePoints[i][1].x := 0.00; curvePoints[i][1].y := 0.00; curveWeights[i][1] := 1;
curvePoints[i][2].x := 1.00; curvePoints[i][2].y := 1.00; curveWeights[i][2] := 1;
curvePoints[i][3].x := 1.00; curvePoints[i][3].y := 1.00; curveWeights[i][3] := 1;
end;
try
if (used_plugins <> nil) then
used_plugins.Clear;
// else used_plugins := TStringlist.Create; // AV: now it's not needed
except
// hack
// used_plugins := TStringList.Create; // AV: now it's not needed
end;
end;
function TControlPoint.HasFinalXForm: boolean;
var
i: integer;
begin
with xform[NumXForms] do
begin
Result := (c[0,0]<>1) or (c[0,1]<>0) or (c[1,0]<>0) or (c[1,1]<>1) or (c[2,0]<>0) or (c[2,1]<>0) or
(p[0,0]<>1) or (p[0,1]<>0) or (p[1,0]<>0) or (p[1,1]<>1) or (p[2,0]<>0) or (p[2,1]<>0) or
(symmetry <> 1) or (GetVariation(0) <> 1);
if Result = false then
for i := 1 to NRVAR-1 do Result := Result or (GetVariation(i) <> 0);
end;
end;
function add_symmetry_to_control_point(var cp: TControlPoint; sym: integer): integer;
const
sym_distrib: array[0..14] of integer = (
-4, -3,
-2, -2, -2,
-1, -1, -1,
2, 2, 2,
3, 3,
4, 4
);
var
i, j, k: integer;
a: double;
begin
result := 0;
if (0 = sym) then
if (random(1) <> 0) then
sym := sym_distrib[random(14)]
else if (random(32) <> 0) then // not correct
sym := random(13) - 6
else
sym := random(51) - 25;
if (1 = sym) or (0 = sym) then
begin
result := 0;
exit;
end;
for i := 0 to NXFORMS - 1 do
if (cp.xform[i].density = 0.0) then break;
if (i = NXFORMS) then
begin
result := 0;
exit;
end;
cp.symmetry := sym;
if (sym < 0) then
begin
cp.xform[i].density := 1.0;
cp.xform[i].symmetry := 1;
cp.xform[i].SetVariation(0, 1.0);
for j := 1 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0.0);
cp.xform[i].color := 1.0;
cp.xform[i].c[0][0] := -1.0;
cp.xform[i].c[0][1] := 0.0;
cp.xform[i].c[1][0] := 0.0;
cp.xform[i].c[1][1] := 1.0;
cp.xform[i].c[2][0] := 0.0;
cp.xform[i].c[2][1] := 0.0;
inc(i);
inc(result);
sym := -sym;
end;
a := 2 * PI / sym;
// for (k = 1; (k < sym)&&(i < NXFORMS); k + + ) {
k := 1;
// while (k < sym) and (i < NXFORMS) do
while (k < sym) and (i < SymmetryNVars) do
begin
cp.xform[i].density := 1.0;
cp.xform[i].SetVariation(0, 1);
cp.xform[i].symmetry := 1;
for j := 1 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0);
if sym < 3 then
cp.xform[i].color := 0
else
cp.xform[i].color := (k - 1) / (sym - 2);
if cp.xform[i].color > 1 then
begin
// ShowMessage('Color value larger than 1');
repeat
cp.xform[i].color := cp.xform[i].color - 1
until cp.xform[i].color <= 1;
end;
cp.xform[i].c[0][0] := cos(k * a);
cp.xform[i].c[0][1] := sin(k * a);
cp.xform[i].c[1][0] := -cp.xform[i].c[0][1];
cp.xform[i].c[1][1] := cp.xform[i].c[0][0];
cp.xform[i].c[2][0] := 0.0;
cp.xform[i].c[2][1] := 0.0;
inc(i);
inc(result);
inc(k);
end;
end;
procedure tile_control_point(var cp: TControlPoint; sym: integer);
var k, i, j: integer;
t, cost, sint: double;
begin
for k := 0 to NXFORMS - 1 do
if (cp.xform[k].density = 0.0) then break;
if (k = NXFORMS) then exit;
case sym of
1:
for i := k to (k + 3) do
begin
cp.xform[i].density := 1.0;
cp.xform[i].symmetry := 1;
cp.xform[i].SetVariation(0, 1.0);
for j := 1 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0.0);
cp.xform[i].c[0][0] := 1.0;
cp.xform[i].c[0][1] := 0.0;
cp.xform[i].c[1][0] := 0.0;
cp.xform[i].c[1][1] := 1.0;
t := (i - k) * pi * 0.5;
SinCos(t, sint, cost);
cp.xform[i].c[2][0] := RhombTR * cost;
cp.xform[i].c[2][1] := RhombTR * sint;
end;
2:
for i := k to (k + 3) do
begin
cp.xform[i].density := 1.0;
cp.xform[i].symmetry := 1;
cp.xform[i].SetVariation(0, 1.0);
for j := 1 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0.0);
cp.xform[i].c[0][0] := 1.0;
cp.xform[i].c[0][1] := 0.0;
cp.xform[i].c[1][0] := 0.0;
cp.xform[i].c[1][1] := 1.0;
t := pi * ((i - k) * 0.5 + 0.25);
SinCos(t, sint, cost);
cp.xform[i].c[2][0] := SquareTR * cost;
cp.xform[i].c[2][1] := SquareTR * sint;
end;
3:
for i := k to (k + 5) do
begin
cp.xform[i].density := 1.0;
cp.xform[i].symmetry := 1;
cp.xform[i].SetVariation(0, 1.0);
for j := 1 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0.0);
cp.xform[i].c[0][0] := 1.0;
cp.xform[i].c[0][1] := 0.0;
cp.xform[i].c[1][0] := 0.0;
cp.xform[i].c[1][1] := 1.0;
t := (i - k) * pi / 3;
SinCos(t, sint, cost);
cp.xform[i].c[2][0] := HexTR * cost;
cp.xform[i].c[2][1] := HexTR * sint;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.ZoomtoRect(R: TSRect);
var
scale, ppu: double;
dx,dy: double;
begin
scale := power(2, zoom);
ppu := pixels_per_unit * scale;
dx := ((r.Left + r.Right)/2 - Width/2) / ppu;
dy := ((r.Top + r.Bottom)/2 - Height/2) / ppu;
center[0] := center[0] + cos(FAngle) * dx - sin(FAngle) * dy;
center[1] := center[1] + sin(FAngle) * dx + cos(FAngle) * dy;
if PreserveQuality then
zoom := Log2(scale * ( Width/(abs(r.Right - r.Left) + 1)))
else
pixels_per_unit := pixels_per_unit * Width / abs(r.Right - r.Left);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.ZoomOuttoRect(R: TSRect);
var
ppu: double;
dx, dy: double;
begin
if PreserveQuality then
zoom := Log2(power(2, zoom) / ( Width/(abs(r.Right - r.Left) + 1)))
else
pixels_per_unit := pixels_per_unit / Width * abs(r.Right - r.Left);
ppu := pixels_per_unit * power(2, zoom);
dx := ((r.Left + r.Right)/2 - Width/2) / ppu;
dy := ((r.Top + r.Bottom)/2 - Height/2) / ppu;
center[0] := center[0] - cos(FAngle) * dx + sin(FAngle) * dy;
center[1] := center[1] - sin(FAngle) * dx - cos(FAngle) * dy;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.ZoomIn(Factor: double);
var
scale: double;
begin
scale := power(2, zoom);
Scale := Scale / Factor;
Zoom := Log2(Scale);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.MoveRect(R: TSRect);
var
scale: double;
ppux, ppuy: double;
dx,dy: double;
begin
scale := power(2, zoom);
ppux := pixels_per_unit * scale;
ppuy := pixels_per_unit * scale;
dx := (r.Left - r.Right)/ppux;
dy := (r.Top - r.Bottom)/ppuy;
center[0] := center[0] + cos(FAngle) * dx - sin(FAngle) * dy;
center[1] := center[1] + sin(FAngle) * dx + cos(FAngle) * dy ;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.Rotate(Angle: double);
begin
FAngle := FAngle + Angle;
end;
///////////////////////////////////////////////////////////////////////////////
function TControlPoint.getppux: double;
begin
result := pixels_per_unit * power(2, zoom)
end;
function TControlPoint.getppuy: double;
begin
result := pixels_per_unit * power(2, zoom)
end;
///////////////////////////////////////////////////////////////////////////////
function TControlPoint.GetBrightness: double;
begin
Result := Fbrightness;
end;
procedure TControlPoint.SetBrightness(br: double);
begin
if br > 0 then begin
if Fbrightness <> 0 then gamma_threshold := (gamma_threshold / Fbrightness) * br;
Fbrightness := br;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TControlPoint.GetRelativeGammaThreshold: double;
begin
if Fbrightness <> 0 then
Result := gamma_threshold / Fbrightness
else
Result := gamma_threshold;
end;
procedure TControlPoint.SetRelativeGammaThreshold(gtr: double);
begin
gamma_threshold := gtr * Fbrightness;
end;
///////////////////////////////////////////////////////////////////////////////
var
vdfilled: boolean = False;
procedure FillVarDisturb;
const
startvar_distrib: array[0..26] of integer = (-1, -1, -1, -1, -1, -1, -1, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7);
startmixed_var_distrib: array[0..16] of integer = (0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 6, 6, 7);
var
i: integer;
begin
if vdfilled then
Exit;
setlength(var_distrib, NRVAR + 19);
setlength(mixed_var_distrib, NRVAR + 9);
for i := 0 to High(startvar_distrib) do
var_distrib[i] := startvar_distrib[i];
for i := High(startvar_distrib) + 1 to high(var_distrib) do
var_distrib[i] := 8 + i - High(startvar_distrib) - 1;
for i := 0 to High(startmixed_var_distrib) do
mixed_var_distrib[i] := startmixed_var_distrib[i];
for i := High(startmixed_var_distrib) + 1 to high(mixed_var_distrib) do
mixed_var_distrib[i] := 8 + i - High(startmixed_var_distrib) - 1;
vdfilled := true;
end;
///////////////////////////////////////////////////////////////////////////////
//
// --Z-- cp-specific functions moved here from MainForm
//
function TControlPoint.NumXForms: integer;
var
i: integer;
begin
//...
Result := NXFORMS;
for i := 0 to NXFORMS - 1 do
begin
if xform[i].density = 0 then
begin
Result := i;
Break;
end;
end;
end;
function TControlPoint.TrianglesFromCP(var Triangles: TTriangles): integer;
{ Sets up the triangles from the IFS code }
var
i, j: integer;
temp_x, temp_y, xset, yset: double;
left, top, bottom, right: double;
begin
top := 0; bottom := 0; right := 0; left := 0;
Result := NumXForms;
{
if ReferenceMode > 0 then
begin
for i := 0 to Result-1 do
begin
xset := 1.0;
yset := 1.0;
for j := 0 to 5 do
with xform[i] do begin
temp_x := xset * c[0][0] + yset * c[1][0] + c[2][0];
temp_y := xset * c[0][1] + yset * c[1][1] + c[2][1];
xset := temp_x;
yset := temp_y;
end;
if (i = 0) then
begin
left := xset;
right := xset;
top := yset;
bottom := yset;
end
else
begin
if (xset < left) then left := xset;
if (xset > right) then right := xset;
if (yset > top) then top := yset;
if (yset < bottom) then bottom := yset;
end;
end;
if ReferenceMode = 1 then
begin
Triangles[-1].x[0] := right-left;
Triangles[-1].y[0] := 0;
Triangles[-1].x[1] := 0;
Triangles[-1].y[1] := 0;
Triangles[-1].x[2] := 0;
Triangles[-1].y[2] := -(top-bottom);
end
else begin
Triangles[-1].x[0] := right;
Triangles[-1].y[0] := -bottom;
Triangles[-1].x[1] := left;
Triangles[-1].y[1] := -bottom;
Triangles[-1].x[2] := left;
Triangles[-1].y[2] := -top;
end;
end
else
}
begin
Triangles[-1].x[0] := 1; Triangles[-1].y[0] := 0; // "x"
Triangles[-1].x[1] := 0; Triangles[-1].y[1] := 0; // "0"
Triangles[-1].x[2] := 0; Triangles[-1].y[2] := -1; // "y"
end;
for j := 0 to Result do
begin
for i := 0 to 2 do
with xform[j] do begin
if postXswap then begin
Triangles[j].x[i] := Triangles[-1].x[i] * p[0][0] + Triangles[-1].y[i] * p[1][0] + p[2][0];
Triangles[j].y[i] := Triangles[-1].x[i] * p[0][1] + Triangles[-1].y[i] * p[1][1] + p[2][1];
end
else begin
Triangles[j].x[i] := Triangles[-1].x[i] * c[0][0] + Triangles[-1].y[i] * c[1][0] + c[2][0];
Triangles[j].y[i] := Triangles[-1].x[i] * c[0][1] + Triangles[-1].y[i] * c[1][1] + c[2][1];
end;
end;
end;
EnableFinalXform := FinalXformEnabled;
// I don't like this... :-/
for j := -1 to Result do // was: Result-1
for i := 0 to 2 do
Triangles[j].y[i] := -Triangles[j].y[i];
end;
procedure TControlPoint.EqualizeWeights;
var
t, i: integer;
begin
t := NumXForms;
for i := 0 to t - 1 do
xform[i].density := 0.5;
end;
procedure TControlPoint.NormalizeWeights;
var
i: integer;
td: double;
begin
td := 0.0;
for i := 0 to NumXForms - 1 do
td := td + xform[i].Density;
if (td < 0.001) then
EqualizeWeights
else
for i := 0 to NumXForms - 1 do
xform[i].Density := xform[i].Density / td;
end;
procedure TControlPoint.RandomizeWeights;
var
i: integer;
begin
for i := 0 to Transforms - 1 do
xform[i].Density := Random;
end;
procedure TControlPoint.ComputeWeights(Triangles: TTriangles; t: integer);
// Caclulate transform weight from triangle areas
var
i: integer;
total_area: double;
begin
total_area := 0;
for i := 0 to t - 1 do
begin
xform[i].Density := triangle_area(Triangles[i]);
total_area := total_area + xform[i].Density;
end;
for i := 0 to t - 1 do
begin
xform[i].Density := xform[i].Density / total_area;
end;
//? cp1.NormalizeWeights;
end;
procedure TControlPoint.NormalizeProbabilities;
// AV: useful for matematicians, useless for other people :)
var
i: integer;
sum, p: double;
begin
sum := 0.0;
for i := 0 to NumXForms - 1 do
sum := sum + xform[i].Density;
if sum = 1.0 then Exit;
for i := 0 to NumXForms - 1 do
begin
p := xform[i].Density / sum;
if (p < 1E-6) then p := 1E-6;
xform[i].Density := p;
end;
end;
procedure TControlPoint.CalculateWeights;
// AV: Calculate transform weight from its affine determinants
var
i: integer;
deta, detp: double;
begin
for i := 0 to NumXForms - 1 do
begin
with xform[i] do
begin
deta := c[0][0] * c[1][1] - c[0][1] * c[1][0];
detp := p[0][0] * p[1][1] - p[0][1] * p[1][0];
end;
deta := abs(deta * detp);
if (deta < 1E-6) then deta := 1E-6;
xform[i].Density := deta;
end;
end;
procedure TControlPoint.CalculateColorSpeed;
var
i: integer;
maxw, sumw, w0, d: double;
eqw: boolean;
begin
if Transforms = 1 then exit; // single xform
eqw := True;
w0 := xform[0].density;
maxw := w0; sumw := 0;
for i := 0 to Transforms - 1 do
begin
sumw := sumw + xform[i].density;
if (xform[i].density > maxw) then maxw := xform[i].density;
if eqw then if (xform[i].density <> w0) then eqw := False;
end;
if (not eqw) then
for i := 0 to Transforms - 1 do
begin
with xform[i] do
begin
if (GetVariation(0) = 1) then // if affine
begin
d := abs(c[0,0]*c[1,1] - c[0,1]*c[1,0]); // contraction factor
symmetry := min(d, 1);
end
else if (density > 0.01) then
symmetry := 0.85 * density / maxw
else
symmetry := -1;
end;
end
else // equal weights
for i := 0 to Transforms - 1 do
xform[i].symmetry := 0;
end;
procedure TControlPoint.GetFromTriangles(const Triangles: TTriangles; const t: integer);
var
i: integer;
v: double;
begin
for i := 0 to t do
if xform[i].postXswap then
begin
solve3(Triangles[-1].x[0], -Triangles[-1].y[0], Triangles[i].x[0],
Triangles[-1].x[1], -Triangles[-1].y[1], Triangles[i].x[1],
Triangles[-1].x[2], -Triangles[-1].y[2], Triangles[i].x[2],
xform[i].p[0][0], xform[i].p[1][0], xform[i].p[2][0]);
solve3(Triangles[-1].x[0], -Triangles[-1].y[0], -Triangles[i].y[0],
Triangles[-1].x[1], -Triangles[-1].y[1], -Triangles[i].y[1],
Triangles[-1].x[2], -Triangles[-1].y[2], -Triangles[i].y[2],
xform[i].p[0][1], xform[i].p[1][1], xform[i].p[2][1]);
end
else begin
solve3(Triangles[-1].x[0], -Triangles[-1].y[0], Triangles[i].x[0],
Triangles[-1].x[1], -Triangles[-1].y[1], Triangles[i].x[1],
Triangles[-1].x[2], -Triangles[-1].y[2], Triangles[i].x[2],
xform[i].c[0][0], xform[i].c[1][0], xform[i].c[2][0]);
solve3(Triangles[-1].x[0], -Triangles[-1].y[0], -Triangles[i].y[0],
Triangles[-1].x[1], -Triangles[-1].y[1], -Triangles[i].y[1],
Triangles[-1].x[2], -Triangles[-1].y[2], -Triangles[i].y[2],
xform[i].c[0][1], xform[i].c[1][1], xform[i].c[2][1]);
if xform[i].autoZscale then with xform[i] do begin
v := c[0][0]*c[1][1] - c[0][1]*c[1][0];
//n := GetVariationIndex('pre_zscale');
if v = 1 then
SetVariation(20, 0.0) // pre_zscale not needed
else
SetVariation(20, sign(v) * sqrt(abs(v)));
end;
end;
FinalXformEnabled := EnableFinalXform;
end;
procedure TControlPoint.GetTriangle(var Triangle: TTriangle; const n: integer);
var
i, j: integer;
begin
for i := 0 to 2 do
with xform[n] do begin
Triangle.x[i] := MainTriangles[-1].x[i] * c[0][0] - MainTriangles[-1].y[i] * c[1][0] + c[2][0];
Triangle.y[i] := -MainTriangles[-1].x[i] * c[0][1] + MainTriangles[-1].y[i] * c[1][1] - c[2][1];
end;
end;
procedure TControlPoint.GetPostTriangle(var Triangle: TTriangle; const n: integer);
var
i, j: integer;
begin
for i := 0 to 2 do
with xform[n] do begin
Triangle.x[i] := MainTriangles[-1].x[i] * p[0][0] - MainTriangles[-1].y[i] * p[1][0] + p[2][0];
Triangle.y[i] := -MainTriangles[-1].x[i] * p[0][1] + MainTriangles[-1].y[i] * p[1][1] - p[2][1];
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.AdjustScale(w, h: integer);
begin
// if width >= height then
pixels_per_unit := pixels_per_unit * w/width;
// else
// pixels_per_unit := pixels_per_unit * h/height;
width := w;
height := h;
end;
end.
Reference in New Issue Copy Permalink