Moved the making of random flames to a seperate unit

Number of variant dependant code change so all changes can be done only in xform
Test mode for new variant added
This commit is contained in:
ronaldhordijk 2005-04-02 10:53:22 +00:00
parent 265d667f49
commit 6b8c455c52
12 changed files with 296 additions and 556 deletions

View File

@ -21,7 +21,7 @@ unit ControlPoint;
interface
uses
Classes, jpeg, ComCtrls, Windows, Graphics, Cmap, Dialogs, Xform;
Classes, Windows, Cmap, Xform;
const
EPS = 1E-10;
@ -39,8 +39,8 @@ type
vHandkerchief, vHeart, vDisc, vSpiral, vHyperbolic, vSquare, vEx, vJulia,
vBent, vWaves, vFisheye, vPopcorn, vExponential, vPower, vCosine,
vRings, vFan, vRandom);
type
type
TPointsArray = array of TCPpoint;
TPointsXYArray = array of TXYpoint;
@ -84,7 +84,6 @@ type
wiggle: array[0..1, 0..1] of double; // frequency is /minute, assuming 30 frames/s */
PropTable: array of Integer;
jpeg: TJPegImage;
FAngle: Double;
FTwoColorDimensions: Boolean;
private
@ -111,6 +110,8 @@ type
procedure IterateXYC(NrPoints: integer; var Points: TPointsArray);
procedure IterateXYCC(NrPoints: integer; var Points: T2CPointsArray);
procedure Testiterate(NrPoints: integer; var Points: TPointsArray);
function Clone: TControlPoint;
procedure Copy(cp1: TControlPoint);
@ -127,12 +128,18 @@ type
function add_symmetry_to_control_point(var cp: TControlPoint; sym: integer): integer;
function CalcUPRMagn(const cp: TControlPoint): double;
implementation
uses
SysUtils, math, global;
var
var_distrib: array[0..NVARS + 18] of integer;
mixed_var_distrib: array[0..NVARS + 8] of integer;
{ TControlPoint }
function sign(n: double): double;
@ -194,9 +201,8 @@ destructor TControlPoint.Destroy;
var
i: Integer;
begin
for i := 0 to NXFORMS - 1 do begin
for i := 0 to NXFORMS - 1 do
xform[i].Free;
end;
inherited;
end;
@ -525,6 +531,53 @@ begin
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.Testiterate(NrPoints: integer; var Points: TPointsArray);
var
i: Integer;
px, py, pc, pt: double;
CurrentPoint: PCPPoint;
begin
PreparePropTable;
for i := 0 to NXFORMS - 1 do
xform[i].prepare;
for i := 0 to NrPoints - 1 do begin
px := 4 * (-1 + 2 * random);
py := 4 * (-1 + 2 * random);
pc := 0.1 + 0.5 * sqrt(sqr(px/4)+ sqr(py/4)) ;
if abs(px)< 0.02 then
pc := 1 ;
if abs(py)< 0.02 then
pc := 1 ;
if abs(frac(px))< 0.01 then
pc := 1 ;
if abs(frac(py))< 0.01 then
pc := 1 ;
if abs(sqrt(sqr(px/4)+ sqr(py/4)) - 0.9) < 0.02 then
pc := 0;
try
xform[PropTable[Random(1024)]].NextPoint(px,py,pt);
except
on EMathError do begin
exit;
end;
end;
// store points
if i >= 0 then begin
CurrentPoint := @Points[i];
CurrentPoint.X := px;
CurrentPoint.Y := py;
CurrentPoint.C := pc;
end
end;
end;
procedure TControlPoint.IterateXYCC(NrPoints: integer; var Points: T2CPointsArray);
var
i: Integer;
@ -799,10 +852,6 @@ end;
procedure TControlPoint.SetVariation(vari: TVariation);
const
xform_distrib: array[0..12] of integer = (2, 2, 2, 3, 3, 3, 4, 4, 5, 5, 6, 7, 8);
var_distrib: array[0..41] 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, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22);
mixed_var_distrib: array[0..31] of integer = (0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 6, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22);
var
i, j, v: integer;
rv: integer;
@ -834,10 +883,6 @@ begin
end;
procedure TControlPoint.RandomCP(min: integer = 2; max: integer = NXFORMS; calc: boolean = true);
const
xform_distrib: array[0..12] of integer = (2, 2, 2, 3, 3, 3, 4, 4, 5, 5, 6, 7, 8);
var_distrib: array[0..41] 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, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22);
mixed_var_distrib: array[0..31] of integer = (0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 6, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22);
var
nrXforms: integer;
i, j: integer;
@ -916,6 +961,13 @@ var
cntminy, cntmaxy: integer;
LimitOutSidePoints: integer;
begin
{$IFDEF TESTVARIANT}
center[0] := 0;
center[1] := 0;
pixels_per_unit := 0.7 * Min(width / (6), Height / (6));
Exit;
{$ENDIF}
// RandSeed := 1234567;
try
SetLength(Points, SUB_BATCH_SIZE);
@ -1611,5 +1663,28 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
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
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;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
FillVarDisturb
end.

View File

@ -41,7 +41,6 @@ object EditForm: TEditForm
0000800100008001000080010000800100008001000080010000FFFF0000}
KeyPreview = True
OldCreateOrder = True
Position = poDefaultPosOnly
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
@ -86,7 +85,6 @@ object EditForm: TEditForm
item
Width = 150
end>
SimplePanel = False
end
object ControlPanel: TPanel
Left = 394
@ -138,7 +136,7 @@ object EditForm: TEditForm
Width = 57
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemHeight = 0
TabOrder = 1
OnChange = cbTransformsChange
end
@ -150,7 +148,6 @@ object EditForm: TEditForm
ActivePage = TabSheet2
Anchors = [akLeft, akTop, akRight, akBottom]
MultiLine = True
TabIndex = 3
TabOrder = 2
TabStop = False
object TabSheet1: TTabSheet

View File

@ -213,7 +213,8 @@ procedure ScaleAll;
implementation
uses Main, Global, Adjust, Mutate;
uses
Main, Global, Adjust, Mutate, Xform;
const
SUB_BATCH_SIZE = 1000;

View File

@ -129,9 +129,9 @@ var
DefaultPalette: TColorMap;
implementation
function Round6(x: double): double;
uses dialogs, Main;
implementation
{ IFS }
@ -140,6 +140,13 @@ begin
Result := (a * d - b * c);
end;
function Round6(x: double): double;
// Really ugly, but it works
begin
Result := StrToFloat(Format('%.6f', [x]));
end;
function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double;
var a, b, e: double): double;
var

View File

@ -2,7 +2,7 @@ object MainForm: TMainForm
Left = 316
Top = 424
Width = 574
Height = 535
Height = 575
Caption = 'Apophysis'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
@ -27,7 +27,7 @@ object MainForm: TMainForm
Left = 160
Top = 28
Width = 4
Height = 454
Height = 494
end
object ToolBar: TToolBar
Left = 0
@ -251,7 +251,7 @@ object MainForm: TMainForm
Left = 0
Top = 28
Width = 160
Height = 454
Height = 494
Align = alLeft
Columns = <
item
@ -270,7 +270,7 @@ object MainForm: TMainForm
Left = 164
Top = 28
Width = 402
Height = 454
Height = 494
Align = alClient
BevelInner = bvLowered
BevelOuter = bvNone
@ -281,7 +281,7 @@ object MainForm: TMainForm
Left = 1
Top = 1
Width = 400
Height = 432
Height = 472
Align = alClient
AutoSize = True
PopupMenu = DisplayPopup
@ -293,7 +293,7 @@ object MainForm: TMainForm
end
object StatusBar: TStatusBar
Left = 0
Top = 482
Top = 522
Width = 566
Height = 19
Panels = <
@ -2706,148 +2706,6 @@ object MainForm: TMainForm
Caption = '-'
GroupIndex = 1
end
object mnuVLinear: TMenuItem
Caption = 'Linear'
GroupIndex = 1
RadioItem = True
OnClick = mnuVLinearClick
end
object mnuSinusoidal: TMenuItem
AutoLineReduction = maManual
Caption = 'Sinusoidal'
GroupIndex = 1
RadioItem = True
OnClick = mnuSinusoidalClick
end
object mnuSpherical: TMenuItem
Caption = 'Spherical'
GroupIndex = 1
RadioItem = True
OnClick = mnuSphericalClick
end
object mnuSwirl: TMenuItem
Caption = 'Swirl'
GroupIndex = 1
RadioItem = True
OnClick = mnuSwirlClick
end
object mnuHorseshoe: TMenuItem
Caption = 'Horseshoe'
GroupIndex = 1
RadioItem = True
OnClick = mnuHorseshoeClick
end
object mnuPolar: TMenuItem
Caption = 'Polar'
GroupIndex = 1
RadioItem = True
OnClick = mnuPolarClick
end
object mnuVar14: TMenuItem
Caption = 'Bent'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar14Click
end
object N17: TMenuItem
Caption = '-'
GroupIndex = 1
end
object mnuVar6: TMenuItem
Caption = 'Handkerchief'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar6Click
end
object mnuVar7: TMenuItem
Caption = 'Heart'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar7Click
end
object mnuVar8: TMenuItem
Caption = 'Disc'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar8Click
end
object mnuVar9: TMenuItem
Caption = 'Spiral'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar9Click
end
object mnuVar10: TMenuItem
Caption = 'Hyperbolic'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar10Click
end
object mnuVar11: TMenuItem
Caption = 'Diamond'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar11Click
end
object mnuVar12: TMenuItem
Caption = 'Ex'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar12Click
end
object mnuVar13: TMenuItem
Caption = 'Julia'
GroupIndex = 1
RadioItem = True
OnClick = mnuVar13Click
end
object mnuWaves: TMenuItem
Caption = 'Waves'
GroupIndex = 1
RadioItem = True
OnClick = mnuWavesClick
end
object mnuFisheye: TMenuItem
Caption = 'Fisheye'
GroupIndex = 1
RadioItem = True
OnClick = mnuFisheyeClick
end
object mnuPopcorn: TMenuItem
Caption = 'Popcorn'
GroupIndex = 1
RadioItem = True
OnClick = mnuPopcornClick
end
object MnuExponential: TMenuItem
Caption = 'Exponential'
GroupIndex = 1
RadioItem = True
OnClick = MnuExponentialClick
end
object mnuPower: TMenuItem
Caption = 'Power'
GroupIndex = 1
RadioItem = True
OnClick = mnuPowerClick
end
object mnuCosine: TMenuItem
Caption = 'Cosine'
GroupIndex = 1
RadioItem = True
OnClick = mnuCosineClick
end
object mnuRings: TMenuItem
Caption = 'Rings'
GroupIndex = 1
RadioItem = True
OnClick = mnuRingsClick
end
object mnuFan: TMenuItem
Caption = 'Fan'
GroupIndex = 1
OnClick = mnuFanClick
end
end
object mnuScript: TMenuItem
Caption = 'Script'

View File

@ -37,31 +37,6 @@ const
RS_DR = 1;
RS_XO = 2;
RS_VO = 3;
varnames: array[0..NVARS -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'
);
type
TMouseMoveState = (msUsual, msZoomWindow, msZoomWindowMove, msDrag, msDragMove, msRotate, msRotateMove);
@ -104,13 +79,6 @@ type
RedrawTimer: TTimer;
mnuVar: TMenuItem;
mnuVRandom: TMenuItem;
mnuVLinear: TMenuItem;
mnuSinusoidal: TMenuItem;
mnuSpherical: TMenuItem;
mnuHorseshoe: TMenuItem;
mnuSwirl: TMenuItem;
mnuPolar: TMenuItem;
mnuVar6: TMenuItem;
N3: TMenuItem;
mnuOpen: TMenuItem;
mnuSaveAs: TMenuItem;
@ -169,14 +137,6 @@ type
mnuCalculateColors: TMenuItem;
mnuRandomizeColorValues: TMenuItem;
N7: TMenuItem;
N17: TMenuItem;
mnuVar7: TMenuItem;
mnuVar8: TMenuItem;
mnuVar9: TMenuItem;
mnuVar10: TMenuItem;
mnuVar11: TMenuItem;
mnuVar12: TMenuItem;
mnuVar13: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
btnDefine: TToolButton;
@ -194,7 +154,6 @@ type
N10: TMenuItem;
mnuManageFavorites: TMenuItem;
mnuShowFull: TMenuItem;
mnuVar14: TMenuItem;
mnuImageSize: TMenuItem;
N13: TMenuItem;
ApplicationEvents: TApplicationEvents;
@ -209,22 +168,13 @@ type
HTTP: TIdHTTP;
ListXmlScanner: TEasyXmlScanner;
N21: TMenuItem;
mnuWaves: TMenuItem;
mnuFisheye: TMenuItem;
mnuPopcorn: TMenuItem;
XmlScanner: TXmlScanner;
mnuFlamepdf: TMenuItem;
MnuExponential: TMenuItem;
mnuPower: TMenuItem;
mnuCosine: TMenuItem;
mnuRings: TMenuItem;
ToolButton4: TToolButton;
tbzoomwindow: TToolButton;
tbDrag: TToolButton;
tbRotate: TToolButton;
mnuimage: TMenuItem;
mnuFan: TMenuItem;
procedure mnuFanClick(Sender: TObject);
procedure mnuimageClick(Sender: TObject);
procedure mnuExitClick(Sender: TObject);
procedure mnuSaveUPRClick(Sender: TObject);
@ -258,13 +208,6 @@ type
procedure MainViewClick(Sender: TObject);
procedure MainToolsClick(Sender: TObject);
procedure MainHelpClick(Sender: TObject);
procedure mnuVLinearClick(Sender: TObject);
procedure mnuSinusoidalClick(Sender: TObject);
procedure mnuSphericalClick(Sender: TObject);
procedure mnuSwirlClick(Sender: TObject);
procedure mnuHorseshoeClick(Sender: TObject);
procedure mnuPolarClick(Sender: TObject);
procedure mnuVar6Click(Sender: TObject);
procedure mnuVRandomClick(Sender: TObject);
procedure mnuSaveAsClick(Sender: TObject);
procedure mnuOpenClick(Sender: TObject);
@ -292,13 +235,6 @@ type
procedure FormDeactivate(Sender: TObject);
procedure mnuCalculateColorsClick(Sender: TObject);
procedure mnuRandomizeColorValuesClick(Sender: TObject);
procedure mnuVar7Click(Sender: TObject);
procedure mnuVar8Click(Sender: TObject);
procedure mnuVar9Click(Sender: TObject);
procedure mnuVar10Click(Sender: TObject);
procedure mnuVar11Click(Sender: TObject);
procedure mnuVar12Click(Sender: TObject);
procedure mnuVar13Click(Sender: TObject);
procedure mnuEditScriptClick(Sender: TObject);
procedure btnRunClick(Sender: TObject);
procedure mnuRunClick(Sender: TObject);
@ -307,7 +243,6 @@ type
procedure mnuImportGimpClick(Sender: TObject);
procedure mnuManageFavoritesClick(Sender: TObject);
procedure mnuShowFullClick(Sender: TObject);
procedure mnuVar14Click(Sender: TObject);
procedure mnuImageSizeClick(Sender: TObject);
procedure ApplicationEventsActivate(Sender: TObject);
procedure mnuPasteClick(Sender: TObject);
@ -325,14 +260,7 @@ type
Attributes: TAttrList);
procedure XMLScannerEmptyTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
procedure mnuWavesClick(Sender: TObject);
procedure mnuFisheyeClick(Sender: TObject);
procedure mnuPopcornClick(Sender: TObject);
procedure mnuFlamepdfClick(Sender: TObject);
procedure MnuExponentialClick(Sender: TObject);
procedure mnuPowerClick(Sender: TObject);
procedure mnuCosineClick(Sender: TObject);
procedure mnuRingsClick(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
@ -353,6 +281,9 @@ type
procedure DrawZoomWindow(ARect: TRect);
procedure DrawRotatelines(Angle: double);
procedure FillVariantMenu;
procedure VariantMenuClick(Sender: TObject);
procedure FavoriteClick(Sender: TObject);
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
@ -366,6 +297,9 @@ type
StartTime: TDateTime;
Remainder: TDateTime;
AnimPal: TColorMap;
VarMenus: array[0..NVARS] of TMenuItem;
procedure LoadXMLFlame(filename, name: string);
procedure DisableFavorites;
procedure EnableFavorites;
@ -406,7 +340,6 @@ function NumXForms(const cp: TControlPoint): integer;
procedure NormalizeWeights(var cp: TControlPoint);
procedure EqualizeWeights(var cp: TControlPoint);
procedure MultMatrix(var s: TMatrix; const m: TMatrix);
function Round6(x: double): double;
procedure ListFlames(FileName: string; sel: integer);
procedure ListIFS(FileName: string; sel: integer);
procedure AdjustScale(var cp1: TControlPoint; width, height: integer);
@ -425,7 +358,7 @@ implementation
uses Editor, Options, Regstry, Gradient, Render,
FullScreen, FormRender, Mutate, Adjust, Browser, Save, About, CmapData,
HtmlHlp, ScriptForm, FormFavorites, Size, FormExport, msMultiPartFormData,
Sheep, ImageColoring, RndFlame;
Sheep, ImageColoring, RndFlame, XForm;
{$R *.DFM}
@ -480,13 +413,6 @@ begin
cp1.height := height;
end;
function Round6(x: double): double;
// Really ugly, but it works
begin
Result := StrToFloat(Format('%.6f', [x]));
end;
procedure MultMatrix(var s: TMatrix; const m: TMatrix);
var
a, b, c, d, e, f, g, h: double;
@ -703,12 +629,14 @@ begin
end;
procedure TMainForm.RandomizeCP(var cp1: TControlPoint; alg: integer = 0);
(*
var
vrnd, Min, Max, i, j, rnd: integer;
Triangles: TTriangles;
cmap: TColorMap;
r, s, theta, phi: double;
skip: boolean;
*)
begin
cp1.Free;
cp1 := RandomFlame(MainCP, alg);
@ -2088,7 +2016,7 @@ begin
begin
OpenFileType := ftIfs;
Variation := vLinear;
mnuvLinear.Checked := True;
VarMenus[0].Checked := True;
end;
if (UpperCase(ExtractFileExt(OpenDialog.FileName)) = '.FLA') or
(UpperCase(ExtractFileExt(OpenDialog.FileName)) = '.APO') then
@ -2512,6 +2440,7 @@ begin
mnuExit.ShortCut := TextToShortCut('Alt+F4');
if VariationOptions = 0 then VariationOptions := 16383; // it shouldn't hapen but just in case;
UnpackVariations(VariationOptions);
FillVariantMenu;
end;
procedure TMainForm.FormShow(Sender: TObject);
@ -2845,7 +2774,7 @@ begin
begin
{ Open *.ifs File }
Variation := vLinear;
mnuVLinear.Checked := True;
VarMenus[0].Checked := True;
StringToIFS(IFSStrings.Text);
SetVariation(maincp);
maincp.CalcBoundBox;
@ -3007,83 +2936,6 @@ begin
DrawFlame;
end;
procedure TMainForm.mnuVLinearClick(Sender: TObject);
begin
mnuVLinear.Checked := True;
UpdateUndo;
Variation := vLinear;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuSinusoidalClick(Sender: TObject);
begin
mnuSinusoidal.Checked := True;
UpdateUndo;
Variation := vSinusoidal;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuSphericalClick(Sender: TObject);
begin
mnuSpherical.Checked := True;
UpdateUndo;
Variation := vSpherical;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuSwirlClick(Sender: TObject);
begin
mnuSwirl.Checked := True;
UpdateUndo;
Variation := vSwirl;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuHorseshoeClick(Sender: TObject);
begin
mnuHorseshoe.Checked := True;
UpdateUndo;
Variation := vHorseshoe;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuPolarClick(Sender: TObject);
begin
mnuPolar.Checked := True;
UpdateUndo;
Variation := vPolar;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar6Click(Sender: TObject);
begin
mnuVar6.Checked := True;
UpdateUndo;
Variation := vHandkerchief;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVRandomClick(Sender: TObject);
begin
mnuVRandom.Checked := True;
@ -3146,15 +2998,14 @@ end;
procedure TMainForm.SmoothPalette;
{ From Draves' Smooth palette Gimp plug-in }
var
r, g, b: byte;
Bitmap: TBitMap;
JPEG: TJPEGImage;
pal: TColorMap;
strings: TStringlist;
ident, gradient, FileName: string;
len, len_best, color, as_is, swapd: cardinal;
ident, FileName: string;
len, len_best, as_is, swapd: cardinal;
cmap_best, original, clist: array[0..255] of cardinal;
c, p, total, j, rand, tryit, i0, i1, t, x, y, i, iw, ih: integer;
p, total, j, rand, tryit, i0, i1, x, y, i, iw, ih: integer;
begin
Total := Trunc(NumTries * TryLength / 100);
p := 0;
@ -3530,82 +3381,6 @@ begin
UpdateWindows;
end;
procedure TMainForm.mnuVar7Click(Sender: TObject);
begin
mnuVar7.Checked := True;
UpdateUndo;
Variation := vHeart;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar8Click(Sender: TObject);
begin
mnuVar8.Checked := True;
UpdateUndo;
Variation := vDisc;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar9Click(Sender: TObject);
begin
mnuVar9.Checked := True;
UpdateUndo;
Variation := vSpiral;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar10Click(Sender: TObject);
begin
mnuVar10.Checked := True;
UpdateUndo;
Variation := vHyperbolic;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar11Click(Sender: TObject);
begin
mnuVar11.Checked := True;
UpdateUndo;
Variation := vSquare;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar12Click(Sender: TObject);
begin
mnuVar12.Checked := True;
UpdateUndo;
Variation := vEx;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuVar13Click(Sender: TObject);
begin
mnuVar13.Checked := True;
UpdateUndo;
Variation := vJulia;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuEditScriptClick(Sender: TObject);
begin
@ -3722,17 +3497,6 @@ begin
FullScreenForm.Show;
end;
procedure TMainForm.mnuVar14Click(Sender: TObject);
begin
mnuVar14.Checked := True;
UpdateUndo;
Variation := vBent;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuImageSizeClick(Sender: TObject);
begin
SizeTool.Show;
@ -4199,101 +3963,12 @@ begin
end;
end;
procedure TMainForm.mnuWavesClick(Sender: TObject);
begin
mnuWaves.Checked := True;
UpdateUndo;
Variation := vWaves;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuFisheyeClick(Sender: TObject);
begin
mnuFisheye.Checked := True;
UpdateUndo;
Variation := vFisheye;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuPopcornClick(Sender: TObject);
begin
mnuPopcorn.Checked := True;
UpdateUndo;
Variation := vPopcorn;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuFlamepdfClick(Sender: TObject);
begin
WinShellOpen('flame.pdf');
end;
procedure TMainForm.MnuExponentialClick(Sender: TObject);
begin
mnuExponential.Checked := True;
UpdateUndo;
Variation := vExponential;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuPowerClick(Sender: TObject);
begin
mnuPower.Checked := True;
UpdateUndo;
Variation := vPower;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuCosineClick(Sender: TObject);
begin
mnuCosine.Checked := True;
UpdateUndo;
Variation := vCosine;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuRingsClick(Sender: TObject);
begin
mnuRings.Checked := True;
UpdateUndo;
Variation := vRings;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.mnuFanClick(Sender: TObject);
begin
mnuFan.Checked := True;
UpdateUndo;
Variation := vFan;
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
@ -4348,6 +4023,7 @@ begin
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
@ -4391,6 +4067,7 @@ begin
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
@ -4525,6 +4202,37 @@ begin
FMouseMoveState := msRotate;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FillVariantMenu;
var
i: integer;
NewMenuItem : TMenuItem;
begin
for i := 0 to NVARS - 1 do begin
NewMenuItem := TMenuItem.Create(self);
NewMenuItem.Caption := uppercase(varnames[i][0]) + copy(varnames[i], 2, length(varnames[i])-1);
NewMenuItem.OnClick := VariantMenuClick;
NewMenuItem.Enabled := True;
NewMenuItem.Name := 'var' + intTostr(i);
NewMenuItem.Tag := i;
NewMenuItem.GroupIndex := 2;
NewMenuItem.RadioItem := True;
VarMenus[i] := NewMenuItem;
mnuvar.Add(NewMenuItem);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.VariantMenuClick(Sender: TObject);
begin
TMenuItem(Sender).Checked := True;
UpdateUndo;
Variation := TVariation(TMenuItem(Sender).Tag);
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
///////////////////////////////////////////////////////////////////////////////
end.

View File

@ -109,7 +109,8 @@ var
implementation
uses Main, Global, Registry, Editor, Adjust;
uses
Main, Global, Registry, Editor, Adjust, XForm;
{$R *.DFM}

View File

@ -45,7 +45,6 @@ object OptionsForm: TOptionsForm
Width = 449
Height = 249
ActivePage = GeneralPage
TabIndex = 0
TabOrder = 0
TabStop = False
object GeneralPage: TTabSheet
@ -152,7 +151,6 @@ object OptionsForm: TOptionsForm
Position = 100
TabOrder = 1
Thousands = False
Wrap = False
end
end
object chkResize: TCheckBox
@ -374,7 +372,6 @@ object OptionsForm: TOptionsForm
Max = 12
Position = 2
TabOrder = 2
Wrap = False
end
object udMaxXForms: TUpDown
Left = 157
@ -386,7 +383,6 @@ object OptionsForm: TOptionsForm
Max = 12
Position = 6
TabOrder = 3
Wrap = False
end
end
object chkKeepBackground: TCheckBox
@ -466,7 +462,6 @@ object OptionsForm: TOptionsForm
Max = 12
Position = 2
TabOrder = 2
Wrap = False
end
object udMaxMutate: TUpDown
Left = 157
@ -478,7 +473,6 @@ object OptionsForm: TOptionsForm
Max = 12
Position = 6
TabOrder = 3
Wrap = False
end
end
object gpForcedSymmetry: TGroupBox
@ -542,7 +536,6 @@ object OptionsForm: TOptionsForm
Position = 4
TabOrder = 2
Thousands = False
Wrap = False
end
end
end
@ -759,7 +752,6 @@ object OptionsForm: TOptionsForm
Max = 64
Position = 2
TabOrder = 8
Wrap = False
end
object udMaxNodes: TUpDown
Left = 209
@ -772,7 +764,6 @@ object OptionsForm: TOptionsForm
Max = 64
Position = 2
TabOrder = 9
Wrap = False
end
object udMinHue: TUpDown
Left = 161
@ -781,11 +772,8 @@ object OptionsForm: TOptionsForm
Height = 21
HelpContext = 1032
Associate = txtMinHue
Min = 0
Max = 600
Position = 0
TabOrder = 10
Wrap = False
end
object udMaxHue: TUpDown
Left = 257
@ -794,11 +782,9 @@ object OptionsForm: TOptionsForm
Height = 21
HelpContext = 1033
Associate = txtMaxHue
Min = 0
Max = 600
Position = 600
TabOrder = 11
Wrap = False
end
object udMinSat: TUpDown
Left = 161
@ -807,10 +793,7 @@ object OptionsForm: TOptionsForm
Height = 21
HelpContext = 1034
Associate = txtMinSat
Min = 0
Position = 0
TabOrder = 12
Wrap = False
end
object udmaxSat: TUpDown
Left = 257
@ -819,10 +802,8 @@ object OptionsForm: TOptionsForm
Height = 21
HelpContext = 1035
Associate = txtMaxSat
Min = 0
Position = 100
TabOrder = 13
Wrap = False
end
object udMinLum: TUpDown
Left = 161
@ -831,10 +812,7 @@ object OptionsForm: TOptionsForm
Height = 21
HelpContext = 1036
Associate = txtMinLum
Min = 0
Position = 0
TabOrder = 14
Wrap = False
end
object udMaxLum: TUpDown
Left = 257
@ -843,10 +821,8 @@ object OptionsForm: TOptionsForm
Height = 21
HelpContext = 1037
Associate = txtMaxLum
Min = 0
Position = 100
TabOrder = 15
Wrap = False
end
end
end

View File

@ -15,7 +15,7 @@
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
{$D-,L-,O+,Q-,R-,Y-,S-}
//{$D-,L-,O+,Q-,R-,Y-,S-}
unit Options;
interface
@ -209,7 +209,8 @@ var
implementation
uses Main, Global, Editor, ControlPoint;
uses
Main, Global, Editor, ControlPoint, XForm;
{$R *.DFM}
procedure TOptionsForm.btnCancelClick(Sender: TObject);
@ -582,7 +583,7 @@ var
i: integer;
begin
for i:= 0 to NVARS - 1 do begin
clbVarEnabled.AddItem(Main.varnames[i],nil);
clbVarEnabled.AddItem(varnames[i],nil);
end;
end;

View File

@ -166,12 +166,21 @@ procedure TRenderer64.CreateColorMap;
var
i: integer;
begin
{$IFDEF TESTVARIANT}
for i := 0 to 255 do begin
ColorMap[i].Red := i;
ColorMap[i].Green := i;
ColorMap[i].Blue := i;
// cmap[i][3] := fcp.white_level;
end;
{$ELSE}
for i := 0 to 255 do begin
ColorMap[i].Red := (fcp.CMap[i][0] * fcp.white_level) div 256;
ColorMap[i].Green := (fcp.CMap[i][1] * fcp.white_level) div 256;
ColorMap[i].Blue := (fcp.CMap[i][2] * fcp.white_level) div 256;
// cmap[i][3] := fcp.white_level;
end;
{$ENDIF}
end;
///////////////////////////////////////////////////////////////////////////////
@ -396,10 +405,16 @@ begin
Progress(i / nrbatches);
// generate points
{$IFDEF TESTVARIANT}
// if i > 10 then
// break;
fcp.Testiterate(SUB_BATCH_SIZE, points);
{$ELSE}
case Compatibility of
0: fcp.iterate_Old(SUB_BATCH_SIZE, points);
1: fcp.iterateXYC(SUB_BATCH_SIZE, points);
end;
{$ENDIF}
// for j := SUB_BATCH_SIZE - 1 downto 0 do
// Writeln(f, FloatTostr(points[j].x) + #9 + FloatTostr(points[j].y) + #9 + FloatTostr(points[j].c));

View File

@ -1665,24 +1665,10 @@ begin
if (i < 0) or (i >= NVARS) then
i := NVARS;
Variation := TVariation(i);
case i of
0: MainForm.mnuVLinear.checked := True;
1: MainForm.mnuSinusoidal.checked := True;
2: MainForm.mnuSpherical.checked := True;
3: MainForm.mnuSwirl.checked := True;
4: MainForm.mnuHorseshoe.checked := True;
5: MainForm.mnuPolar.checked := True;
6: MainForm.mnuVar6.checked := True;
7: MainForm.mnuVar7.checked := True;
8: MainForm.mnuVar8.checked := True;
9: MainForm.mnuVar9.checked := True;
10: MainForm.mnuVar10.checked := True;
11: MainForm.mnuVar11.checked := True;
12: MainForm.mnuVar12.checked := True;
13: MainForm.mnuVar13.checked := True;
if i = -1 then
MainForm.mnuVRandom.checked := True
else
MainForm.mnuVRandom.checked := True;
end;
MainForm.VarMenus[i].Checked := True;
end
end;

View File

@ -3,8 +3,42 @@ unit XForm;
interface
const
NVARS = 23;
EPS = 1E-10;
{$IFDEF TESTVARIANT}
NVARS = 26;
{$ELSE}
NVARS = 25;
{$ENDIF}
varnames: array[0..NVARS -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'
{$IFDEF TESTVARIANT}
,'test'
{$ENDIF}
);
type
TCalcMethod = procedure of object;
@ -61,7 +95,9 @@ type
procedure Cosine; // var[20]
procedure Rings; // var[21]
procedure Fan; // var[22]
procedure Triblob; // var[23]
procedure Daisy; // var[24]
procedure TestVar; // var[NVARS - 1]
function Mul33(const M1, M2: TMatrix): TMatrix;
function Identity: TMatrix;
@ -99,6 +135,9 @@ implementation
uses
SysUtils, Math;
const
EPS = 1E-10;
{ TXForm }
///////////////////////////////////////////////////////////////////////////////
@ -249,6 +288,23 @@ begin
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;
{$IFDEF TESTVARIANT}
if (vars[NVARS -1] <> 0.0) then begin
FFunctionList[FNrFunctions] := TestVar;
Inc(FNrFunctions);
end;
{$ENDIF}
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);
CalculateLength := False;
@ -545,6 +601,64 @@ begin
FPy := FPy + vars[22] * r * sin(a);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.Triblob;
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 * (0.6 + 0.4 * sin(3 * Angle));
FPx := FPx + vars[23] * r * cos(Angle);
FPy := FPy + vars[23] * r * sin(Angle);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.Daisy;
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 * (0.6 + 0.4 * sin(3 * Angle));
r := r * sin(5 * Angle);
FPx := FPx + vars[24] * r * cos(Angle);
FPy := FPy + vars[24] * r * sin(Angle);
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;
// r := r * (0.6 + 0.4 * sin(3 * Angle));
r := r * sin(5 * Angle);
FPx := FPx + vars[NVARS-1] * r * cos(Angle);
FPy := FPy + vars[NVARS-1] * r * sin(Angle);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.NextPoint(var px,py,pc: double);
var
@ -892,5 +1006,6 @@ begin
c[2, 1] := Matrix[1][2];
end;
///////////////////////////////////////////////////////////////////////////////
end.