mirror-github-bspeice/apophysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Parameterized variations

Browse Source
This commit is contained in:
ronaldhordijk 2005-09-11 10:30:54 +00:00
parent 41a160f51c
commit ab49c4053a
19 changed files with 1007 additions and 302 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
2.10/Source/BaseVariation.pas Normal file
View File

@ -0,0 +1,64 @@
unit BaseVariation;
interface
type
TBaseVariation = class
protected
public
vvar: double; // normalized interp coefs between variations
FTx, FTy: ^double;
FPx, FPy: ^double;
class function GetName: string; virtual; abstract;
class function GetInstance: TBaseVariation; virtual; abstract;
class function GetNrVariables: integer; virtual;
class function GetVariableNameAt(const Index: integer): string; virtual;
function SetVariable(const Name: string; var value: double): boolean; virtual;
function GetVariable(const Name: string; var value: double): boolean; virtual;
procedure Prepare; virtual;
procedure CalcFunction; virtual; abstract;
end;
TBaseVariationClass = class of TBaseVariation;
implementation
{ TBaseVariation }
///////////////////////////////////////////////////////////////////////////////
class function TBaseVariation.GetNrVariables: integer;
begin
Result := 0;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseVariation.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseVariation.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
end;
///////////////////////////////////////////////////////////////////////////////
class function TBaseVariation.GetVariableNameAt(const Index: integer): string;
begin
Result := ''
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseVariation.prepare;
begin
end;
///////////////////////////////////////////////////////////////////////////////
end.

40
2.10/Source/Editor.dfm
View File

@ -53,7 +53,7 @@ object EditForm: TEditForm
TextHeight = 13
object StatusBar: TStatusBar
Left = 0
Top = 547
Top = 541
Width = 578
Height = 15
Panels = <
@ -325,14 +325,14 @@ object EditForm: TEditForm
Left = 0
Top = 24
Width = 578
Height = 523
Height = 517
Align = alClient
TabOrder = 1
object Splitter1: TSplitter
Left = 396
Top = 1
Width = 9
Height = 521
Height = 515
Align = alRight
AutoSnap = False
Beveled = True
@ -343,7 +343,7 @@ object EditForm: TEditForm
Left = 1
Top = 1
Width = 395
Height = 521
Height = 515
Align = alClient
BevelOuter = bvNone
Color = clBlack
@ -353,7 +353,7 @@ object EditForm: TEditForm
Left = 0
Top = 0
Width = 395
Height = 521
Height = 515
Align = alClient
PopupMenu = EditPopup
OnDblClick = GraphImageDblClick
@ -366,7 +366,7 @@ object EditForm: TEditForm
Left = 405
Top = 1
Width = 172
Height = 521
Height = 515
Align = alRight
Alignment = taLeftJustify
BevelOuter = bvNone
@ -406,7 +406,7 @@ object EditForm: TEditForm
Left = 0
Top = 136
Width = 172
Height = 385
Height = 379
Align = alClient
TabOrder = 0
object lblTransform: TLabel
@ -439,10 +439,10 @@ object EditForm: TEditForm
end
object PageControl: TPageControl
Left = 1
Top = 26
Top = 20
Width = 170
Height = 358
ActivePage = TriangleTab
ActivePage = TabSheet4
Align = alBottom
Anchors = [akLeft, akTop, akRight, akBottom]
MultiLine = True
@ -1319,6 +1319,28 @@ object EditForm: TEditForm
63)
end
end
object TabSheet4: TTabSheet
Caption = 'Variables'
ImageIndex = 4
object vleVariables: TValueListEditor
Left = 0
Top = 0
Width = 162
Height = 312
Align = alClient
ScrollBars = ssVertical
TabOrder = 0
TitleCaptions.Strings = (
'Variation'
'Value')
OnExit = vleVariablesExit
OnKeyPress = vleVariablesKeyPress
OnValidate = vleVariablesValidate
ColWidths = (
93
63)
end
end
object tabColors: TTabSheet
Caption = 'Colors'
ImageIndex = 3

192
2.10/Source/Editor.pas
View File

@ -154,6 +154,11 @@ type
ToolButton9: TToolButton;
Panel1: TPanel;
ColorImage: TImage;
TabSheet4: TTabSheet;
vleVariables: TValueListEditor;
procedure vleVariablesValidate(Sender: TObject; ACol, ARow: Integer; const KeyName, KeyValue: string);
procedure vleVariablesKeyPress(Sender: TObject; var Key: Char);
procedure vleVariablesExit(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GraphImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: integer);
@ -284,7 +289,7 @@ type
GraphZoom: double;
CornerCaught: boolean;
TriangleCaught: boolean;
// SelectedTriangle: integer; // outside only for scripting (??)
// SelectedTriangle: integer; // outside only for scripting (??)
SelectedCorner: integer;
SelectMode: boolean;
// Drawing: boolean;
@ -294,7 +299,7 @@ type
// --Z--
olddist: double;
Pivot: TSPoint;
VarsCache: array[0..32] of double; // hack
VarsCache: array[0..64] of double; // hack
colorDrag, colorChanged: boolean;
colorDragX, colorOldX: integer;
@ -357,7 +362,7 @@ procedure ScaleAll;
implementation
uses
Main, Global, Adjust, Mutate, Xform;
Main, Global, Adjust, Mutate, XformMan;
const
SUB_BATCH_SIZE = 1000;
@ -625,6 +630,7 @@ var
i: integer;
a, b, c, d, e, f: double;
v: double;
val: double;
begin
t := SelectedTriangle; // why 't' ?
@ -674,15 +680,19 @@ begin
EditForm.txtXFormColor.Text := Format('%1.3f', [cp.xform[t].color]);//FloatToStr(EditForm.cp.xform[t].color);
EditForm.scrlXFormcolor.Position := Trunc(EditForm.cp.xform[t].color * scrlXFormColor.Max);
for i := 0 to NRVISVAR-1 do begin
for i := 0 to NRVAR-1 do begin
v:=EditForm.cp.xform[SelectedTriangle].vars[i];
if v <> VarsCache[i] then
begin
VarsCache[i]:=v;
EditForm.VEVars.Values[VarNames[i]] := Format('%.6g', [v]);
EditForm.VEVars.Values[VarNames(i)] := Format('%.6g', [v]);
end;
end;
for i:= 0 to GetNrVariableNames - 1 do begin
EditForm.cp.xform[SelectedTriangle].GetVariable(GetVariableNameAt(i), val);
EditForm.vleVariables.Values[GetVariableNameAt(i)] := Format('%.6g', [val]);
end;
end;
procedure TEditForm.Scale(var fx, fy: double; x, y, Width, Height: integer);
@ -1154,8 +1164,23 @@ procedure TEditForm.FormCreate(Sender: TObject);
var
i: integer;
begin
for i:= 0 to NRVISVAR - 1 do begin
VEVars.InsertRow(Varnames[i], '0', True);
(*
Drawcntrl := TDrawingControl.Create(self);
Drawcntrl.TabStop := True;
Drawcntrl.Parent := GrphPnl;
Drawcntrl.Align := alClient;
Drawcntrl.Visible := True;
Drawcntrl.OnDblClick := GraphImageDblClick;
Drawcntrl.Onpaint := viewPaint;
*)
for i:= 0 to NRVAR - 1 do begin
VEVars.InsertRow(Varnames(i), '0', True);
end;
for i:= 0 to GetNrVariableNames - 1 do begin
vleVariables.InsertRow(GetVariableNameAt(i), '0', True);
end;
bm := TBitmap.Create;
@ -1183,7 +1208,8 @@ begin
mouseOverTriangle := -1;
mouseOverCorner := -1;
for i := 0 to NRVISVAR-1 do VarsCache[i] := MinDouble;
for i := 0 to NRVAR-1 do
VarsCache[i] := MinDouble;
end;
procedure TEditForm.GraphImageMouseMove(Sender: TObject; Shift: TShiftState;
@ -2458,17 +2484,17 @@ begin
OldVal := Round6(cp.xform[SelectedTriangle].vars[i]);
{ Test that it's a valid floating point number }
try
StrToFloat(VEVars.Values[VarNames[i]]);
StrToFloat(VEVars.Values[VarNames(i)]);
except on Exception do
begin
{ It's not, so we restore the old value }
VEVars.Values[VarNames[i]] := Format('%.6g', [OldVal]);
VEVars.Values[VarNames(i)] := Format('%.6g', [OldVal]);
Allow := False;
end;
end;
NewVal := Round6(StrToFloat(VEVars.Values[VarNames[i]]));
NewVal := Round6(StrToFloat(VEVars.Values[VarNames(i)]));
// if NewVal < 0 then NewVal := 0;
VEVars.Values[VarNames[i]] := Format('%.6g', [NewVal]);
VEVars.Values[VarNames(i)] := Format('%.6g', [NewVal]);
{ If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) and Allow then
@ -2477,7 +2503,7 @@ begin
// EditedVariation := i;
cp.xform[SelectedTriangle].vars[i] := NewVal;
// VarNormalize(cp);
VEVars.Values[VarNames[i]] := Format('%.6g', [cp.xform[SelectedTriangle].vars[i]]);
VEVars.Values[VarNames(i)] := Format('%.6g', [cp.xform[SelectedTriangle].vars[i]]);
ShowSelectedInfo;
UpdateFlame(True);
end;
@ -2497,17 +2523,17 @@ begin
OldVal := Round6(cp.xform[SelectedTriangle].vars[i]);
{ Test that it's a valid floating point number }
try
StrToFloat(VEVars.Values[VarNames[i]]);
StrToFloat(VEVars.Values[VarNames(i)]);
except on Exception do
begin
{ It's not, so we restore the old value }
VEVars.Values[VarNames[i]] := Format('%.6g', [OldVal]);
VEVars.Values[VarNames(i)] := Format('%.6g', [OldVal]);
Allow := False;
end;
end;
NewVal := Round6(StrToFloat(VEVars.Values[VarNames[i]]));
NewVal := Round6(StrToFloat(VEVars.Values[VarNames(i)]));
// if NewVal < 0 then NewVal := 0;
VEVars.Values[VarNames[i]] := Format('%.6g', [NewVal]);
VEVars.Values[VarNames(i)] := Format('%.6g', [NewVal]);
{ If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) and Allow then
@ -2516,7 +2542,7 @@ begin
// EditedVariation := i;
cp.xform[SelectedTriangle].vars[i] := NewVal;
// VarNormalize(cp);
VEVars.Values[VarNames[i]] := Format('%.6g', [cp.xform[SelectedTriangle].vars[i]]);
VEVars.Values[VarNames(i)] := Format('%.6g', [cp.xform[SelectedTriangle].vars[i]]);
ShowSelectedInfo;
UpdateFlame(True);
end;
@ -2535,17 +2561,17 @@ begin
OldVal := Round6(cp.xform[SelectedTriangle].vars[i]);
{ Test that it's a valid floating point number }
try
StrToFloat(VEVars.Values[VarNames[i]]);
StrToFloat(VEVars.Values[VarNames(i)]);
except on Exception do
begin
{ It's not, so we restore the old value }
VEVars.Values[VarNames[i]] := Format('%.6g', [OldVal]);
VEVars.Values[VarNames(i)] := Format('%.6g', [OldVal]);
Allow := False;
end;
end;
NewVal := Round6(StrToFloat(VEVars.Values[VarNames[i]]));
NewVal := Round6(StrToFloat(VEVars.Values[VarNames(i)]));
// if NewVal < 0 then NewVal := 0;
VEVars.Values[VarNames[i]] := Format('%.6g', [NewVal]);
VEVars.Values[VarNames(i)] := Format('%.6g', [NewVal]);
{ If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) and Allow then
@ -2554,7 +2580,7 @@ begin
// EditedVariation := i;
cp.xform[SelectedTriangle].vars[i] := NewVal;
// VarNormalize(cp);
VEVars.Values[VarNames[i]] := Format('%.6g', [cp.xform[SelectedTriangle].vars[i]]);
VEVars.Values[VarNames(i)] := Format('%.6g', [cp.xform[SelectedTriangle].vars[i]]);
ShowSelectedInfo;
UpdateFlame(True);
end;
@ -2762,7 +2788,8 @@ begin
// if (key in [VK_LEFT,VK_RIGHT,VK_UP,VK_DOWN,VK_PRIOR,VK_NEXT,VK_HOME,VK_END]) and
// if VEVars.Focused = false then
// if FocusedControl = VEVars then
if PageControl.TabIndex <> 2 then
if (PageControl.TabIndex <> 2) or // variations
(PageControl.TabIndex <> 3) then // variables
begin
// MainForm.UpdateUndo;
case key of
@ -2953,7 +2980,7 @@ begin
varMM:=true;
cp.xform[SelectedTriangle].vars[varDragIndex] := v;
VEVars.Values[VarNames[varDragIndex]] := Format('%.6g', [v]);
VEVars.Values[VarNames(varDragIndex)] := Format('%.6g', [v]);
HasChanged := True;
UpdateFlameX;
@ -2986,7 +3013,7 @@ begin
// i := EditForm.VEVars.Row - 1;
cp.xform[SelectedTriangle].vars[varDragIndex] := 0;
VEVars.Values[VarNames[varDragIndex]] := '0';
VEVars.Values[VarNames(varDragIndex)] := '0';
HasChanged := True;
UpdateFlameX;
end;
@ -3072,5 +3099,118 @@ begin
end;
end;
procedure TEditForm.vleVariablesExit(Sender: TObject);
var
Allow: boolean;
i: integer;
NewVal, OldVal: double;
begin
Allow := True;
i := vleVariables.Row;
cp.xform[SelectedTriangle].GetVariable(vleVariables.Keys[i], OldVal);
{ Test that it's a valid floating point number }
try
StrToFloat(vleVariables.Values[vleVariables.Keys[i]]);
except on Exception do
begin
{ It's not, so we restore the old value }
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [OldVal]);
Allow := False;
end;
end;
NewVal := Round6(StrToFloat(vleVariables.Values[vleVariables.Keys[i]]));
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
{ If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) and Allow then
begin
MainForm.UpdateUndo;
cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[i], NewVal);
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
ShowSelectedInfo;
UpdateFlame(True);
end;
end;
procedure TEditForm.vleVariablesKeyPress(Sender: TObject; var Key: Char);
var
Allow: boolean;
i: integer;
NewVal, OldVal: double;
begin
if key <> #13 then
Exit;
key := #0;
Allow := True;
i := vleVariables.Row;
cp.xform[SelectedTriangle].GetVariable(vleVariables.Keys[i], OldVal);
{ Test that it's a valid floating point number }
try
StrToFloat(vleVariables.Values[vleVariables.Keys[i]]);
except on Exception do
begin
{ It's not, so we restore the old value }
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [OldVal]);
Allow := False;
end;
end;
NewVal := Round6(StrToFloat(vleVariables.Values[vleVariables.Keys[i]]));
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
{ If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) and Allow then
begin
MainForm.UpdateUndo;
cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[i], NewVal);
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
ShowSelectedInfo;
UpdateFlame(True);
end;
end;
procedure TEditForm.vleVariablesValidate(Sender: TObject; ACol, ARow: Integer; const KeyName, KeyValue: string);
var
Allow: boolean;
i: integer;
NewVal, OldVal: double;
begin
Allow := True;
i := vleVariables.Row;
cp.xform[SelectedTriangle].GetVariable(vleVariables.Keys[i], OldVal);
{ Test that it's a valid floating point number }
try
StrToFloat(vleVariables.Values[vleVariables.Keys[i]]);
except on Exception do
begin
{ It's not, so we restore the old value }
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [OldVal]);
Allow := False;
end;
end;
NewVal := Round6(StrToFloat(vleVariables.Values[vleVariables.Keys[i]]));
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
{ If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) and Allow then
begin
MainForm.UpdateUndo;
cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[i], NewVal);
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
ShowSelectedInfo;
UpdateFlame(True);
end;
end;
end.

29
2.10/Source/FormRender.dfm
View File

@ -49,6 +49,13 @@ object RenderForm: TRenderForm
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Label6: TLabel
Left = 204
Top = 340
Width = 118
Height = 13
Caption = 'TestValue Nr Of Threads'
end
object ProgressBar: TProgressBar
Left = 0
Top = 392
@ -181,8 +188,10 @@ object RenderForm: TRenderForm
Top = 20
Width = 73
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
@ -199,8 +208,10 @@ object RenderForm: TRenderForm
Top = 44
Width = 73
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
@ -247,7 +258,9 @@ object RenderForm: TRenderForm
Top = 68
Width = 57
Height = 21
BiDiMode = bdRightToLeft
Enabled = False
ParentBiDiMode = False
ReadOnly = True
TabOrder = 2
Text = '2'
@ -258,6 +271,8 @@ object RenderForm: TRenderForm
Top = 44
Width = 57
Height = 21
BiDiMode = bdRightToLeft
ParentBiDiMode = False
TabOrder = 1
OnChange = txtFilterRadiusChange
end
@ -266,6 +281,8 @@ object RenderForm: TRenderForm
Top = 20
Width = 57
Height = 21
BiDiMode = bdRightToLeft
ParentBiDiMode = False
TabOrder = 0
OnChange = txtDensityChange
end
@ -314,8 +331,10 @@ object RenderForm: TRenderForm
Top = 44
Width = 57
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 1
Items.Strings = (
'32'
@ -439,6 +458,16 @@ object RenderForm: TRenderForm
Caption = 'Post render'
TabOrder = 9
end
object edtNrThreads: TEdit
Left = 336
Top = 336
Width = 73
Height = 21
BiDiMode = bdRightToLeft
ParentBiDiMode = False
TabOrder = 13
Text = '1'
end
object SaveDialog: TSaveDialog
Left = 368
Top = 256

4
2.10/Source/Global.pas
View File

@ -108,8 +108,8 @@ var
defFlameFile: string;
SymmetryType: integer;
SymmetryOrder: integer;
Variations: array[0..NRVAR - 1] of boolean;
VariationOptions: integer;
Variations: array[0..63] of boolean;
VariationOptions: int64;
{ For random gradients }
MinNodes, MaxNodes, MinHue, MaxHue, MinSat, MaxSat, MinLum, MaxLum: integer;
FixedReference: boolean;

2
2.10/Source/Gradient.pas
View File

@ -700,7 +700,7 @@ begin
Clipboard.SetTextBuf(PChar(gradstr.text));
btnPaste.enabled := true;
mnuPaste.enabled := true;
MainForm.btnPaste.enabled := False;
// MainForm.btnPaste.enabled := False;
MainForm.mnuPaste.enabled := False;
finally
gradstr.free

42
2.10/Source/ImageMaker.pas
View File

@ -60,9 +60,9 @@ uses
type
TRGB = packed Record
red: byte;
green: byte;
blue: byte;
green: byte;
red: byte;
end;
PByteArray = ^TByteArray;
@ -146,8 +146,8 @@ end;
///////////////////////////////////////////////////////////////////////////////
function TImageMaker.GetImage: TBitmap;
begin
Result := GetTransparentImage;
// Result := FBitmap;
// Result := GetTransparentImage;
Result := FBitmap;
end;
///////////////////////////////////////////////////////////////////////////////
@ -384,6 +384,9 @@ var
area: double;
MaxA: int64;
ACount: double;
RCount: double;
GCount: double;
BCount: double;
offsetLow: double;
offsetHigh: double;
densLow: double;
@ -463,6 +466,9 @@ begin
fp[2] := fp[2] + filterValue * ls * FBuckets[filterpos].Blue;
fp[3] := fp[3] + filterValue * ls * FBuckets[filterpos].Count;
ACount := ACount + filterValue * FBuckets[filterpos].Count;
// RCount := RCount + filterValue * FBuckets[bucketpos].Red;
// GCount := GCount + filterValue * FBuckets[bucketpos].Green;
// BCount := BCount + filterValue * FBuckets[bucketpos].Blue;
end;
end;
@ -478,7 +484,9 @@ begin
fp[2] := ls * FBuckets[bucketpos].Blue;
fp[3] := ls * FBuckets[bucketpos].Count * fcp.white_level;
ACount := FBuckets[bucketpos].Count;
RCount := FBuckets[bucketpos].Red;
GCount := FBuckets[bucketpos].Green;
BCount := FBuckets[bucketpos].Blue;
end;
Inc(bucketpos, FOversample);
@ -533,7 +541,26 @@ begin
bi := 0
else if (bi > 255) then
bi := 255;
(*
ri := Round(RCount/ACount) + (ai * bgi[0]) shr 8;
if (ri < 0) then
ri := 0
else if (ri > 255) then
ri := 255;
gi := Round(GCount/ACount) + (ai * bgi[1]) shr 8;
if (gi < 0) then
gi := 0
else if (gi > 255) then
gi := 255;
bi := Round(BCount/ACount) + (ai * bgi[2]) shr 8;
if (bi < 0) then
bi := 0
else if (bi > 255) then
bi := 255;
*)
Row[j].red := ri;
Row[j].green := gi;
Row[j].blue := bi;
@ -545,8 +572,6 @@ begin
Inc(bucketpos, (FOversample - 1) * FBucketWidth);
end;
FBitmap.PixelFormat := pf24bit;
Progress(1);
end;
@ -611,8 +636,7 @@ begin
if assigned(FTransparentImage) then
FTransparentImage.Free;
FTransparentImage := tBitmap.Create;
// FTransparentImage.PixelFormat := pf24bit;
FTransparentImage := TBitmap.Create;
FTransparentImage.Width := Fcp.Width;
FTransparentImage.Height := Fcp.Height;

8
2.10/Source/Mutate.pas
View File

@ -110,7 +110,7 @@ var
implementation
uses
Main, Global, Registry, Editor, Adjust, XForm;
Main, Global, Registry, Editor, Adjust, XFormMan;
{$R *.DFM}
@ -300,7 +300,7 @@ begin
mutants[i].xform[j].c[1][1] := cps[0].xform[j].c[1][1];
mutants[i].xform[j].c[2][0] := cps[0].xform[j].c[2][0];
mutants[i].xform[j].c[2][1] := cps[0].xform[j].c[2][1];
for k := 0 to NRVISVAR - 1 do
for k := 0 to NRVAR - 1 do
mutants[i].xform[j].vars[k] := cps[0].xform[j].vars[k];
end;
end;
@ -354,8 +354,8 @@ var
begin
cmbTrend.Items.clear;
cmbTrend.AddItem('Random', Tobject(vRandom));
for i:= 0 to NRVISVAR -1 do begin
cmbTrend.AddItem(varnames[i], Tobject(i));
for i:= 0 to NRVAR -1 do begin
cmbTrend.AddItem(varnames(i), Tobject(i));
end;
bm := TBitMap.Create;

17
2.10/Source/Options.pas
View File

@ -209,10 +209,11 @@ var
implementation
uses
Main, Global, Editor, ControlPoint, XForm;
{$R *.DFM}
uses
Main, Global, Editor, ControlPoint, XFormMan;
procedure TOptionsForm.btnCancelClick(Sender: TObject);
begin
Close;
@ -274,7 +275,7 @@ begin
{ Variations tab }
UnpackVariations(VariationOptions);
for i := 0 to NRVISVAR -1 do
for i := 0 to NRVAR -1 do
clbVarEnabled.Checked[i] := Variations[i];
{ Gradient tab }
@ -318,7 +319,7 @@ begin
{ Variations tab }
{ Get option values from controls. Disallow bad values }
for i := 0 to NRVISVAR -1 do
for i := 0 to NRVAR -1 do
Variations[i] := clbVarEnabled.Checked[i];
v := PackVariations;
@ -471,7 +472,7 @@ procedure TOptionsForm.btnSetAllClick(Sender: TObject);
var
i: integer;
begin
for i := 0 to NRVISVAR - 1 do
for i := 0 to NRVAR - 1 do
clbVarEnabled.Checked[i] := True;
end;
@ -479,7 +480,7 @@ procedure TOptionsForm.btnClearAllClick(Sender: TObject);
var
i: integer;
begin
for i := 0 to NRVISVAR - 1 do
for i := 0 to NRVAR - 1 do
clbVarEnabled.Checked[i] := False;
end;
@ -582,8 +583,8 @@ procedure TOptionsForm.FormCreate(Sender: TObject);
var
i: integer;
begin
for i:= 0 to NRVISVAR - 1 do begin
clbVarEnabled.AddItem(varnames[i],nil);
for i:= 0 to NRVAR - 1 do begin
clbVarEnabled.AddItem(varnames(i),nil);
end;
end;

2
2.10/Source/Regstry.pas
View File

@ -26,7 +26,7 @@ procedure SaveSettings;
implementation
uses Windows, SysUtils, Forms, Registry, Global, Dialogs, XForm;
uses Windows, SysUtils, Forms, Registry, Global, Dialogs, XFormMan;
procedure UnpackVariations(v: integer);
{ Unpacks the variation options form an integer }

8
2.10/Source/RndFlame.pas
View File

@ -28,7 +28,7 @@ function RandomFlame(SourceCP: TControlPoint= nil; algorithm: integer = 0): TCon
implementation
uses
SysUtils, Global, cmap, MyTypes, GradientHlpr, XForm;
SysUtils, Global, cmap, MyTypes, GradientHlpr, XFormMan;
///////////////////////////////////////////////////////////////////////////////
procedure RandomGradient(SourceCP, DestCP: TControlPoint);
@ -86,7 +86,7 @@ begin
RandSeed := MainSeed;
VarPossible := false;
for j := 0 to NRVISVAR - 1 do begin
for j := 0 to NRVAR - 1 do begin
VarPossible := VarPossible or Variations[j];
end;
@ -96,11 +96,11 @@ begin
if VarPossible then begin
repeat
a := random(NRVISVAR);
a := random(NRVAR);
until Variations[a];
repeat
b := random(NRVISVAR);
b := random(NRVAR);
until Variations[b];
end else begin
a := 0;

15
2.10/Source/ScriptForm.pas
View File

@ -21,8 +21,9 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ControlPoint, cmap, Buttons, ComCtrls, ToolWin,
Menus, atScript, atPascal, AdvMemo, Advmps, XForm, GradientHlpr;
ExtCtrls, StdCtrls, ControlPoint, Buttons, ComCtrls, ToolWin,
Menus, atScript, atPascal, AdvMemo, Advmps, XFormMan, XForm, GradientHlpr,
cmap, Gradient;
const NCPS = 10;
type
@ -324,7 +325,7 @@ implementation
}
uses Main, Editor, Adjust, Global, Mutate, Registry, Preview,
ScriptRender, {Gradient,} ap_math, ap_classes, ap_sysutils, MyTypes,
ScriptRender, ap_math, ap_classes, ap_sysutils, MyTypes,
SavePreset, ap_windows, ap_FileCtrl, bmdll32;
{$R *.DFM}
@ -1683,7 +1684,7 @@ begin
with AMachine do
begin
i := integer(Variation);
if (i >= NRVISVAR) or (i < 0) then
if (i >= NRVAR) or (i < 0) then
i := -1;
ReturnOutputArg(i);
end
@ -1696,10 +1697,10 @@ begin
with AMachine do
begin
i := GetInputArgAsInteger(0);
if (i < 0) or (i >= NRVISVAR) then
i := NRVISVAR ;
if (i < 0) or (i >= NRVAR) then
i := NRVAR ;
Variation := TVariation(i);
if i = NRVISVAR then
if i = NRVAR then
MainForm.mnuVRandom.checked := True
else
MainForm.VarMenus[i].Checked := True;

2
2.10/Source/ScriptRender.dfm
View File

@ -30,8 +30,6 @@ object ScriptRenderForm: TScriptRenderForm
Top = 8
Width = 249
Height = 13
Min = 0
Max = 100
TabOrder = 1
end
end

66
2.10/Source/VarTest.pas Normal file
View File

@ -0,0 +1,66 @@
unit VarTest;
interface
uses
BaseVariation, XFormMan;
type
TVariationTest = class(TBaseVariation)
public
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
procedure CalcFunction; override;
end;
implementation
uses
math;
{ TVariationTest }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationTest.CalcFunction;
const
EPS = 1E-10;
var
r : double;
// dx, dy, dx2: double;
Angle: double;
begin
r := sqrt(FTx^ * FTx^ + FTy^ * FTy^);
if (FTx^ < -EPS) or (FTx^ > EPS) or (FTy^ < -EPS) or (FTy^ > EPS) then
Angle := arctan2(FTx^, FTy^)
else
Angle := 0.0;
Angle := Angle + Max(0, (3 - r)) * sin(2 * r);
// r:= R - 0.04 * sin(6.2 * R - 1) - 0.008 * R;
FPx^ := FPx^ + vvar * r * cos(Angle);
FPy^ := FPy^ + vvar * r * sin(Angle);
// FPx^ := FPx^ + vvar * FTx^;
// FPy^ := FPy^ + vvar * FTy^;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationTest.GetInstance: TBaseVariation;
begin
Result := TVariationTest.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationTest.GetName: string;
begin
Result := 'test';
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationTest);
end.

445
2.10/Source/XForm.pas
View File

@ -3,44 +3,7 @@ unit XForm;
interface
uses
atPascal;
const
NRVISVAR = 29;
NRVAR = 29;
varnames: array[0..NRVAR - 1] of PChar = (
'linear',
'sinusoidal',
'spherical',
'swirl',
'horseshoe',
'polar',
'handkerchief',
'heart',
'disc',
'spiral',
'hyperbolic',
'diamond',
'ex',
'julia',
'bent',
'waves',
'fisheye',
'popcorn',
'exponential',
'power',
'cosine',
'rings',
'fan',
'triblob',
'daisy',
'checkers',
'crot',
'testscript',
'test'
);
XFormMan, baseVariation;
type
TCalcMethod = procedure of object;
@ -62,7 +25,8 @@ type
TXForm = class
private
FNrFunctions: Integer;
FFunctionList: array[0..NRVAR-1] of TCalcMethod;
FFunctionList: array of TCalcMethod;
FCalcFunctionList: array[0..64] of TCalcMethod;
FTx, FTy: double;
FPx, FPy: double;
@ -74,6 +38,8 @@ type
CalculateLength: boolean;
CalculateSinCos: boolean;
FRegVariations: array of TBaseVariation;
procedure Linear; // var[0]
procedure Sinusoidal; // var[1]
procedure Spherical; // var[2]
@ -101,25 +67,25 @@ type
procedure Daisy; // var[24]
procedure Checkers; // var[25]
procedure CRot; // var[26]
procedure TestScript; // var[27]
procedure TestVar; // var[NVARS - 1]
function Mul33(const M1, M2: TMatrix): TMatrix;
function Identity: TMatrix;
procedure BuildFunctionlist;
procedure AddRegVariations;
public
vars: array[0..NRVAR - 1] of double; // normalized interp coefs between variations
vars: array of double; // normalized interp coefs between variations
c: array[0..2, 0..1] of double; // the coefs to the affine part of the function
p: array[0..2, 0..1] of double; // the coefs to the affine part of the function
density: double; // prob is this function is chosen. 0 - 1
color: double; // color coord for this function. 0 - 1
color2: double; // Second color coord for this function. 0 - 1
symmetry: double;
c00, c01, c10, c11, c20, c21: double;
varType: integer;
nx,ny,x,y: double;
script: TatPascalScripter;
// nx,ny,x,y: double;
// script: TatPascalScripter;
Orientationtype: integer;
@ -127,6 +93,8 @@ type
destructor Destroy; override;
procedure Prepare;
procedure Assign(Xform: TXForm);
procedure NextPoint(var px, py, pc: double); overload;
procedure NextPoint(var CPpoint: TCPpoint); overload;
procedure NextPoint(var px, py, pz, pc: double); overload;
@ -137,6 +105,11 @@ type
procedure Translate(const x, y: double);
procedure Multiply(const a, b, c, d: double);
procedure Scale(const s: double);
procedure SetVariable(const name: string; var Value: double);
procedure GetVariable(const name: string; var Value: double);
function ToXMLString: string;
end;
implementation
@ -156,10 +129,6 @@ var
begin
density := 0;
Color := 0;
Vars[0] := 1;
for i := 1 to NRVAR - 1 do begin
Vars[i] := 0;
end;
c[0, 0] := 1;
c[0, 1] := 0;
c[1, 0] := 0;
@ -168,11 +137,19 @@ begin
c[2, 1] := 0;
Symmetry := 0;
end;
AddRegVariations;
BuildFunctionlist;
SetLength(vars, NRLOCVAR + Length(FRegVariations));
Vars[0] := 1;
for i := 1 to High(vars) do
Vars[i] := 0;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.Prepare;
var
i: integer;
begin
c00 := c[0][0];
c01 := c[0][1];
@ -183,141 +160,23 @@ begin
FNrFunctions := 0;
if (vars[0] <> 0.0) then begin
FFunctionList[FNrFunctions] := Linear;
Inc(FNrFunctions);
for i := 0 to High(FRegVariations) do begin
FRegVariations[i].FPX := @FPX;
FRegVariations[i].FPY := @FPY;
FRegVariations[i].FTX := @FTX;
FRegVariations[i].FTY := @FTY;
FRegVariations[i].vvar := vars[i + NRLOCVAR];
FRegVariations[i].prepare;
end;
if (vars[1] <> 0.0) then begin
FFunctionList[FNrFunctions] := Sinusoidal;
Inc(FNrFunctions);
for i := 0 to NrVar - 1 do begin
if (vars[i] <> 0.0) then begin
FCalcFunctionList[FNrFunctions] := FFunctionList[i];
Inc(FNrFunctions);
end;
end;
if (vars[2] <> 0.0) then begin
FFunctionList[FNrFunctions] := Spherical;
Inc(FNrFunctions);
end;
if (vars[3] <> 0.0) then begin
FFunctionList[FNrFunctions] := Swirl;
Inc(FNrFunctions);
end;
if (vars[4] <> 0.0) then begin
FFunctionList[FNrFunctions] := Horseshoe;
Inc(FNrFunctions);
end;
if (vars[5] <> 0.0) then begin
FFunctionList[FNrFunctions] := Polar;
Inc(FNrFunctions);
end;
if (vars[6] <> 0.0) then begin
FFunctionList[FNrFunctions] := FoldedHandkerchief;
Inc(FNrFunctions);
end;
if (vars[7] <> 0.0) then begin
FFunctionList[FNrFunctions] := Heart;
Inc(FNrFunctions);
end;
if (vars[8] <> 0.0) then begin
FFunctionList[FNrFunctions] := Disc;
Inc(FNrFunctions);
end;
if (vars[9] <> 0.0) then begin
FFunctionList[FNrFunctions] := Spiral;
Inc(FNrFunctions);
end;
if (vars[10] <> 0.0) then begin
FFunctionList[FNrFunctions] := Hyperbolic;
Inc(FNrFunctions);
end;
if (vars[11] <> 0.0) then begin
FFunctionList[FNrFunctions] := Square;
Inc(FNrFunctions);
end;
if (vars[12] <> 0.0) then begin
FFunctionList[FNrFunctions] := Ex;
Inc(FNrFunctions);
end;
if (vars[13] <> 0.0) then begin
FFunctionList[FNrFunctions] := Julia;
Inc(FNrFunctions);
end;
if (vars[14] <> 0.0) then begin
FFunctionList[FNrFunctions] := Bent;
Inc(FNrFunctions);
end;
if (vars[15] <> 0.0) then begin
FFunctionList[FNrFunctions] := Waves;
Inc(FNrFunctions);
end;
if (vars[16] <> 0.0) then begin
FFunctionList[FNrFunctions] := Fisheye;
Inc(FNrFunctions);
end;
if (vars[17] <> 0.0) then begin
FFunctionList[FNrFunctions] := Popcorn;
Inc(FNrFunctions);
end;
if (vars[18] <> 0.0) then begin
FFunctionList[FNrFunctions] := Exponential;
Inc(FNrFunctions);
end;
if (vars[19] <> 0.0) then begin
FFunctionList[FNrFunctions] := Power;
Inc(FNrFunctions);
end;
if (vars[20] <> 0.0) then begin
FFunctionList[FNrFunctions] := Cosine;
Inc(FNrFunctions);
end;
if (vars[21] <> 0.0) then begin
FFunctionList[FNrFunctions] := Rings;
Inc(FNrFunctions);
end;
if (vars[22] <> 0.0) then begin
FFunctionList[FNrFunctions] := Fan;
Inc(FNrFunctions);
end;
if (vars[23] <> 0.0) then begin
FFunctionList[FNrFunctions] := Triblob;
Inc(FNrFunctions);
end;
if (vars[24] <> 0.0) then begin
FFunctionList[FNrFunctions] := Daisy;
Inc(FNrFunctions);
end;
if (vars[25] <> 0.0) then begin
FFunctionList[FNrFunctions] := Checkers;
Inc(FNrFunctions);
end;
if (vars[26] <> 0.0) then begin
FFunctionList[FNrFunctions] := CRot;
Inc(FNrFunctions);
end;
(*
if (vars[27] <> 0.0) then begin
FFunctionList[FNrFunctions] := TestScript;
Inc(FNrFunctions);
@ -333,7 +192,9 @@ begin
'begin' + #10#13 +
'nx := x;' + #10#13 +
'ny := y;' + #10#13 +
'end;' + #10#13;
'end;' + #10#13 +
'nx := x;' + #10#13 +
'ny := y;' + #10#13;
Script.AddVariable('x',x);
Script.AddVariable('y',y);
Script.AddVariable('nx',nx);
@ -341,10 +202,11 @@ begin
Script.Compile;
end;
if (vars[NRVAR -1] <> 0.0) then begin
if (vars[NRLOCVAR -1] <> 0.0) then begin
FFunctionList[FNrFunctions] := TestVar;
Inc(FNrFunctions);
end;
*)
CalculateAngle := (vars[5] <> 0.0) or (vars[6] <> 0.0) or (vars[7] <> 0.0) or (vars[8] <> 0.0) or
(vars[12] <> 0.0) or (vars[13] <> 0.0) or (vars[21] <> 0.0) or (vars[22] <> 0.0);
@ -715,41 +577,6 @@ begin
FPy := FPy + vars[26] * r * sin(Angle);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.TestScript;
begin
// Script.ExecuteSubroutine('test', [FTX, FTY, nvx,nvy]);
x := FTX;
y := FTY;
Script.ExecuteSubroutine('test2');
FPx := FPx + vars[27] * nx;
FPy := FPy + vars[27] * ny;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.TestVar;
var
r : double;
// dx, dy, dx2: double;
Angle: double;
begin
r := sqrt(FTx * FTx + FTy * FTy);
if (FTx < -EPS) or (FTx > EPS) or (FTy < -EPS) or (FTy > EPS) then
Angle := arctan2(FTx, FTy)
else
Angle := 0.0;
Angle := Angle + Max(0, (3 - r)) * sin(2 * r);
// r:= R - 0.04 * sin(6.2 * R - 1) - 0.008 * R;
FPx := FPx + vars[NRVAR - 1] * r * cos(Angle);
FPy := FPy + vars[NRVAR - 1] * r * sin(Angle);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.NextPoint(var px,py,pc: double);
var
@ -787,10 +614,13 @@ begin
Fpy := 0;
for i := 0 to FNrFunctions - 1 do
FFunctionList[i];
FCalcFunctionList[i];
px := FPx;
py := FPy;
// px := p[0,0] * FPx + p[1,0] * FPy + p[2,0];
// py := p[0,1] * FPx + p[1,1] * FPy + p[2,1];
end;
///////////////////////////////////////////////////////////////////////////////
@ -834,6 +664,8 @@ begin
CPpoint.x := FPx;
CPpoint.y := FPy;
// CPpoint.x := p[0,0] * FPx + p[1,0] * FPy + p[2,0];
// CPpoint.y := p[0,1] * FPx + p[1,1] * FPy + p[2,1];
end;
@ -871,10 +703,22 @@ begin
else
FAngle := 0.0;
end;
if CalculateLength then begin
FLength := sqrt(FTx * FTx + FTy * FTy);
if CalculateSinCos then begin
Flength := sqrt(FTx * FTx + FTy * FTy);
if FLength = 0 then begin
FSinA := 0;
FCosA := 1;
end else begin
FSinA := FTx/FLength;
FCosA := FTy/FLength;
end;
end;
// if CalculateLength then begin
// FLength := sqrt(FTx * FTx + FTy * FTy);
// end;
Fpx := 0;
Fpy := 0;
@ -916,6 +760,18 @@ begin
else
FAngle := 0.0;
end;
if CalculateSinCos then begin
Flength := sqrt(FTx * FTx + FTy * FTy);
if FLength = 0 then begin
FSinA := 0;
FCosA := 1;
end else begin
FSinA := FTx/FLength;
FCosA := FTy/FLength;
end;
end;
// if CalculateLength then begin
// FLength := sqrt(FTx * FTx + FTy * FTy);
// end;
@ -928,6 +784,8 @@ begin
px := FPx;
py := FPy;
// px := p[0,0] * FPx + p[1,0] * FPy + p[2,0];
// py := p[0,1] * FPx + p[1,1] * FPy + p[2,1];
end;
///////////////////////////////////////////////////////////////////////////////
@ -964,6 +822,8 @@ begin
px := FPx;
py := FPy;
// px := p[0,0] * FPx + p[1,0] * FPy + p[2,0];
// py := p[0,1] * FPx + p[1,1] * FPy + p[2,1];
end;
///////////////////////////////////////////////////////////////////////////////
@ -1097,14 +957,147 @@ begin
c[2, 1] := Matrix[1][2];
end;
///////////////////////////////////////////////////////////////////////////////
destructor TXForm.Destroy;
var
i: integer;
begin
if assigned(Script) then
Script.Free;
// if assigned(Script) then
// Script.Free;
for i := 0 to High(FRegVariations) do
FRegVariations[i].Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.BuildFunctionlist;
var
i: integer;
begin
SetLength(FFunctionList, NrVar + Length(FRegVariations));
//fixed
FFunctionList[0] := Linear;
FFunctionList[1] := Sinusoidal;
FFunctionList[2] := Spherical;
FFunctionList[3] := Swirl;
FFunctionList[4] := Horseshoe;
FFunctionList[5] := Polar;
FFunctionList[6] := FoldedHandkerchief;
FFunctionList[7] := Heart;
FFunctionList[8] := Disc;
FFunctionList[9] := Spiral;
FFunctionList[10] := Hyperbolic;
FFunctionList[11] := Square;
FFunctionList[12] := Ex;
FFunctionList[13] := Julia;
FFunctionList[14] := Bent;
FFunctionList[15] := Waves;
FFunctionList[16] := Fisheye;
FFunctionList[17] := Popcorn;
FFunctionList[18] := Exponential;
FFunctionList[19] := Power;
FFunctionList[20] := Cosine;
FFunctionList[21] := Fan;
FFunctionList[22] := Rings;
FFunctionList[23] := Triblob;
FFunctionList[24] := Daisy;
FFunctionList[25] := Checkers;
FFunctionList[26] := CRot;
//registered
for i := 0 to High(FRegVariations) do
FFunctionList[27 + i] := FRegVariations[i].CalcFunction;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.AddRegVariations;
var
i: integer;
begin
SetLength(FRegVariations, GetNrRegisteredVariations);
for i := 0 to GetNrRegisteredVariations - 1 do begin
FRegVariations[i] := GetRegisteredVariation(i).GetInstance;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.Assign(XForm: TXForm);
var
i,j: integer;
Name: string;
Value: double;
begin
if Not assigned(XForm) then
Exit;
for i := 0 to High(vars) do
vars[i] := XForm.vars[i];
c := Xform.c;
density := XForm.density;
color := XForm.color;
color2 := XForm.color2;
symmetry := XForm.symmetry;
Orientationtype := XForm.Orientationtype;
for i := 0 to High(FRegVariations) do begin
for j:= 0 to FRegVariations[i].GetNrVariables -1 do begin
Name := FRegVariations[i].GetVariableNameAt(j);
XForm.FRegVariations[i].GetVariable(Name,Value);
FRegVariations[i].SetVariable(Name,Value);
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TXForm.ToXMLString: string;
var
i, j: integer;
Name: string;
Value: double;
begin
result := Format(' <xform weight="%g" color="%g" symmetry="%g" ', [density, color, symmetry]);
for i := 0 to nrvar - 1 do begin
if vars[i] <> 0 then
Result := Result + varnames(i) + format('="%f" ', [vars[i]]);
end;
Result := Result + Format('coefs="%g %g %g %g %g %g" ', [c[0,0], c[0,1], c[1,0], c[1,1], c[2,0], c[2,1]]);
// Result := Result + Format('post="%g %g %g %g %g %g" ', [p[0,0], p[0,1], p[1,0], p[1,1], p[2,0], p[2,1]]);
for i := 0 to High(FRegVariations) do begin
if vars[i+NRLOCVAR] <> 0 then
for j:= 0 to FRegVariations[i].GetNrVariables -1 do begin
Name := FRegVariations[i].GetVariableNameAt(j);
FRegVariations[i].GetVariable(Name,Value);
Result := Result + Format('%s="%g" ', [name, value]);
end;
end;
Result := Result + '/>';
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.SetVariable(const name: string; var Value: double);
var
i: integer;
begin
for i := 0 to High(FRegVariations) do
if FRegVariations[i].SetVariable(name, value) then
break;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.GetVariable(const name: string; var Value: double);
var
i: integer;
begin
for i := 0 to High(FRegVariations) do
if FRegVariations[i].GetVariable(name, value) then
break;
end;
///////////////////////////////////////////////////////////////////////////////
end.

115
2.10/Source/XFormMan.pas Normal file
View File

@ -0,0 +1,115 @@
unit XFormMan;
interface
uses
BaseVariation;
const
NRLOCVAR = 27;
function NrVar: integer;
function Varnames(const index: integer): String;
procedure RegisterVariation(Variation: TBaseVariationClass);
function GetNrRegisteredVariations: integer;
function GetRegisteredVariation(const Index: integer): TBaseVariationClass;
function GetNrVariableNames: integer;
function GetVariableNameAt(const Index: integer): string;
implementation
uses
Classes;
var
VariationList: TList;
VariableNames: TStringlist;
///////////////////////////////////////////////////////////////////////////////
function NrVar: integer;
begin
Result := NRLOCVAR + VariationList.Count;
end;
///////////////////////////////////////////////////////////////////////////////
function Varnames(const index: integer): String;
const
cvarnames: array[0..NRLOCVAR-1] of string = (
'linear',
'sinusoidal',
'spherical',
'swirl',
'horseshoe',
'polar',
'handkerchief',
'heart',
'disc',
'spiral',
'hyperbolic',
'diamond',
'ex',
'julia',
'bent',
'waves',
'fisheye',
'popcorn',
'exponential',
'power',
'cosine',
'rings',
'fan',
'triblob',
'daisy',
'checkers',
'crot'
);
begin
if Index < NRLOCVAR then
Result := cvarnames[Index]
else
Result := TBaseVariationClass(VariationList[Index - NRLOCVAR]).GetName;
end;
///////////////////////////////////////////////////////////////////////////////
procedure RegisterVariation(Variation: TBaseVariationClass);
var
i: integer;
begin
VariationList.Add(Variation);
for i := 0 to Variation.GetNrVariables - 1 do
VariableNames.Add(Variation.GetVariableNameAt(i))
end;
///////////////////////////////////////////////////////////////////////////////
function GetNrRegisteredVariations: integer;
begin
Result := VariationList.count;
end;
///////////////////////////////////////////////////////////////////////////////
function GetRegisteredVariation(const Index: integer): TBaseVariationClass;
begin
Result := TBaseVariationClass(VariationList[Index]);
end;
///////////////////////////////////////////////////////////////////////////////
function GetNrVariableNames: integer;
begin
Result := VariableNames.Count;
end;
///////////////////////////////////////////////////////////////////////////////
function GetVariableNameAt(const Index: integer): string;
begin
Result := VariableNames[Index];
end;
///////////////////////////////////////////////////////////////////////////////
initialization
VariationList := TList.Create;
VariableNames := TStringlist.create;
finalization
VariableNames.Free;
VariationList.Free;
end.

3
2.10/Source/formPostProcess.dfm
View File

@ -94,8 +94,6 @@ object frmPostProcess: TfrmPostProcess
Width = 424
Height = 12
Align = alBottom
Min = 0
Max = 100
TabOrder = 1
end
object btnApply: TButton
@ -161,7 +159,6 @@ object frmPostProcess: TfrmPostProcess
end
end
object ColorDialog: TColorDialog
Ctl3D = True
Left = 284
Top = 4
end

132
2.10/Source/varblob.pas Normal file
View File

@ -0,0 +1,132 @@
unit varblob;
interface
uses
BaseVariation, XFormMan;
type
TVariationBlob = class(TBaseVariation)
private
FWaves: double;
FLow: double;
FHigh: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
class function GetNrVariables: integer; override;
class 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;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationTest }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBlob.CalcFunction;
const
EPS = 1E-10;
var
r : double;
Angle: double;
begin
r := sqrt(FTx^ * FTx^ + FTy^ * FTy^);
if (FTx^ < -EPS) or (FTx^ > EPS) or (FTy^ < -EPS) or (FTy^ > EPS) then
Angle := arctan2(FTx^, FTy^)
else
Angle := 0.0;
r := r * (FLow + (FHigh - FLow) * (0.5 + 0.5 * sin(FWaves * Angle)));
FPx^ := FPx^ + vvar * r * cos(Angle);
FPy^ := FPy^ + vvar * r * sin(Angle);
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlob.GetName: string;
begin
Result := 'blob';
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlob.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'blob_low';
1: Result := 'blob_high';
2: Result := 'blob_waves';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlob.GetNrVariables: integer;
begin
Result := 3;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlob.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blob_low' then begin
FLow := Value;
Result := True;
end else if Name = 'blob_high' then begin
FHigh := Value;
Result := True;
end else if Name = 'blob_waves' then begin
Value := Round(Value);
FWaves := Value;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlob.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blob_low' then begin
Value := FLow;
Result := True;
end else if Name = 'blob_high' then begin
Value := FHigh;
Result := True;
end else if Name = 'blob_waves' then begin
Value := FWaves;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBlob.Create;
begin
inherited Create;
FWaves := Round(2 + 5 * Random);
FLow := 0.2 + 0.5 * random;
FHigh := 0.8 + 0.4 * random;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlob.GetInstance: TBaseVariation;
begin
Result := TVariationBlob.Create;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationBlob);
end.

123
2.10/Source/varpdj.pas Normal file
View File

@ -0,0 +1,123 @@
unit varpdj;
interface
uses
BaseVariation, XFormMan;
type
TVariationPDJ = class(TBaseVariation)
private
FA,FB,FC,FD: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
class function GetNrVariables: integer; override;
class 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;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationTest }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationPDJ.CalcFunction;
begin
FPx^ := FPx^ + vvar * (sin(FA * FTy^) - cos(FB * FTx^));
FPy^ := FPy^ + vvar * (sin(FC * FTx^) - cos(FD * FTy^));
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationPDJ.Create;
begin
FA := 6 * Random - 3;
FB := 6 * Random - 3;
FC := 6 * Random - 3;
FD := 6 * Random - 3;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPDJ.GetInstance: TBaseVariation;
begin
Result := TVariationPDJ.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPDJ.GetName: string;
begin
Result := 'pdj';
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPDJ.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'pdj_a';
1: Result := 'pdj_b';
2: Result := 'pdj_c';
3: Result := 'pdj_d';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPDJ.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'pdj_a' then begin
FA := Value;
Result := True;
end else if Name = 'pdj_b' then begin
FB := Value;
Result := True;
end else if Name = 'pdj_c' then begin
FC := Value;
Result := True;
end else if Name = 'pdj_d' then begin
FD := Value;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationPDJ.GetNrVariables: integer;
begin
Result := 4
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationPDJ.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'pdj_a' then begin
Value := FA;
Result := True;
end else if Name = 'pdj_b' then begin
Value := FB;
Result := True;
end else if Name = 'pdj_c' then begin
Value := FC;
Result := True;
end else if Name = 'pdj_d' then begin
Value := FD;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationPDJ);
end.