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

Initial commit

Browse Source
This commit is contained in:
Alice Vital
2022-03-08 20:25:51 +03:00
commit 25a72c3c86
187 changed files with 154390 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Apophysis.res
BIN
View File
Binary file not shown.
ApophysisAV.dpr
+238
View File
@@ -0,0 +1,238 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
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.
}
program ApophysisAV;
{$SetPEFlags $20}
uses
Forms,
Dialogs,
SysUtils,
Vcl.Themes,
Vcl.Styles,
Binary in 'IO\Binary.pas',
Base64 in 'IO\Base64.pas',
sdStringTable in 'System\sdStringTable.pas',
CustomDrawControl in 'System\CustomDrawControl.pas',
LibXmlComps in 'System\LibXmlComps.pas',
LibXmlParser in 'System\LibXmlParser.pas',
RegexHelper in 'System\RegexHelper.pas',
CurvesControl in 'System\CurvesControl.pas',
{$ifndef Apo7X64}
AsmRandom in 'System\AsmRandom.pas',
{$endif }
Global in 'Core\Global.pas',
CommandLine in 'IO\CommandLine.pas',
MissingPlugin in 'IO\MissingPlugin.pas',
Settings in 'IO\Settings.pas',
Translation in 'Core\Translation.pas',
Chaotica in 'Core\Chaotica.pas',
Bezier in 'Core\Bezier.pas',
RndFlame in 'Flame\RndFlame.pas',
ControlPoint in 'Flame\ControlPoint.pas',
cmapdata in 'ColorMap\cmapdata.pas',
cmap in 'ColorMap\cmap.pas',
GradientHlpr in 'ColorMap\GradientHlpr.pas',
XFormMan in 'Core\XFormMan.pas',
XForm in 'Flame\XForm.pas',
BaseVariation in 'Core\BaseVariation.pas',
RenderingCommon in 'Rendering\RenderingCommon.pas',
RenderingInterface in 'Rendering\RenderingInterface.pas',
RenderingImplementation in 'Rendering\RenderingImplementation.pas',
BucketFillerThread in 'Rendering\BucketFillerThread.pas',
RenderThread in 'Rendering\RenderThread.pas',
ImageMaker in 'Rendering\ImageMaker.pas',
varSinusoidal in 'Variations\varSinusoidal.pas',
varLog in 'Variations\varLog.pas',
varModulus in 'Variations\varModulus.pas',
varSphyp3D in 'Variations\varSphyp3D.pas',
varInversion3D in 'Variations\varInversion3D.pas',
varRings2 in 'Variations\varRings2.pas',
varFan2 in 'Variations\varFan2.pas',
varWedge in 'Variations\varWedge.pas',
varEpispiral in 'Variations\varEpispiral.pas',
varBwraps in 'Variations\varBwraps.pas',
varPDJ in 'Variations\varPDJ.pas',
varJuliaN in 'Variations\varJuliaN.pas',
varJuliaScope in 'Variations\varJuliaScope.pas',
varJulia3Djf in 'Variations\varJulia3Djf.pas',
varJulia3Dz in 'Variations\varJulia3Dz.pas',
varJuliaN3Dx in 'Variations\varJuliaN3Dx.pas',
varJulian2DC in 'Variations\varJulian2DC.pas',
varCurl in 'Variations\varCurl.pas',
varCurl3D in 'Variations\varCurl3D.pas',
varRadialBlur in 'Variations\varRadialBlur.pas',
varSuperShape in 'Variations\varSuperShape.pas',
varNBlur in 'Variations\varNBlur.pas',
varBlurCircle in 'Variations\varBlurCircle.pas',
varBlurZoom in 'Variations\varBlurZoom.pas',
varBlurPixelize in 'Variations\varBlurPixelize.pas',
varFalloff2 in 'Variations\varFalloff2.pas',
varRectangles in 'Variations\varRectangles.pas',
varSplits in 'Variations\varSplits.pas',
varSeparation in 'Variations\varSeparation.pas',
varBipolar in 'Variations\varBipolar.pas',
varLoonie in 'Variations\varLoonie.pas',
varEscher in 'Variations\varEscher.pas',
varScry in 'Variations\varScry.pas',
varNGon in 'Variations\varNGon.pas',
varFoci in 'Variations\varFoci.pas',
varUnpolar in 'Variations\varUnpolar.pas',
varLazysusan in 'Variations\varLazysusan.pas',
varDCBubble in 'Variations\varDCBubble.pas',
varMobius in 'Variations\varMobius.pas',
varButterfly in 'Variations\varButterfly.pas',
varBoarders2 in 'Variations\varBoarders2.pas',
varAffine3D in 'Variations\varAffine3D.pas',
varHyperboloid in 'Variations\varHyperboloid.pas',
varCirclize in 'Variations\varCirclize.pas',
varCircleCrop in 'Variations\varCircleCrop.pas',
varCrop in 'Variations\varCrop.pas',
varTriangleCrop in 'Variations\varTriangleCrop.pas',
varSphereCrop in 'Variations\varSphereCrop.pas',
varElliptic in 'Variations\varElliptic.pas',
varWaves2 in 'Variations\varWaves2.pas',
varAuger in 'Variations\varAuger.pas',
varFlux in 'Variations\varFlux.pas',
varCpow3 in 'Variations\varCpow3.pas',
varGlynnSim1 in 'Variations\varGlynnSim1.pas',
varGlynnSim2 in 'Variations\varGlynnSim2.pas',
varGlynnSim3 in 'Variations\varGlynnSim3.pas',
varHypertile in 'Variations\varHypertile.pas',
varHypertile1 in 'Variations\varHypertile1.pas',
varHypertile2 in 'Variations\varHypertile2.pas',
varHypertile3D in 'Variations\varHypertile3D.pas',
varHypertile3D1 in 'Variations\varHypertile3D1.pas',
varHypertile3D2 in 'Variations\varHypertile3D2.pas',
varTaurus in 'Variations\varTaurus.pas',
varPreSpherical in 'Variations\varPreSpherical.pas',
varPreSinusoidal in 'Variations\varPreSinusoidal.pas',
varPreDisc in 'Variations\varPreDisc.pas',
varPreBoarders2 in 'Variations\varPreBoarders2.pas',
varPreBwraps in 'Variations\varPreBwraps.pas',
varPreCircleCrop in 'Variations\varPreCircleCrop.pas',
varPreCrop in 'Variations\varPreCrop.pas',
varPreFalloff2 in 'Variations\varPreFalloff2.pas',
varPostBoarders2 in 'Variations\varPostBoarders2.pas',
varPostBwraps in 'Variations\varPostBwraps.pas',
varPostCurl in 'Variations\varPostCurl.pas',
varPostCurl3D in 'Variations\varPostCurl3D.pas',
varPostCircleCrop in 'Variations\varPostCircleCrop.pas',
varPostCrop in 'Variations\varPostCrop.pas',
varPostFalloff2 in 'Variations\varPostFalloff2.pas',
varPostSpherical in 'Variations\varPostSpherical.pas',
varPostSinusoidal in 'Variations\varPostSinusoidal.pas',
varProjective in 'Variations\varProjective.pas',
varHandkerchief in 'Variations\varHandkerchief.pas',
varJulia in 'Variations\varJulia.pas',
varEx in 'Variations\varEx.pas',
varExponential in 'Variations\varExponential.pas',
varBlob in 'Variations\varBlob.pas',
varHeart in 'Variations\varHeart.pas',
varPower in 'Variations\varPower.pas',
varTwinTrian in 'Variations\varTwinTrian.pas',
varBlade in 'Variations\varBlade.pas',
varTangent in 'Variations\varTangent.pas',
varCosine in 'Variations\varCosine.pas',
varBent2 in 'Variations\varBent2.pas',
varPopcorn2 in 'Variations\varPopcorn2.pas',
varDisc2 in 'Variations\varDisc2.pas',
varSecant in 'Variations\varSecant.pas',
varZVortex in 'Variations\varZVortex.pas',
varArch in 'Variations\varArch.pas',
varTanhSpiral in 'Variations\varTanhSpiral.pas',
varCothSpiral in 'Variations\varCothSpiral.pas',
varGenericPlugin in 'Variations\varGenericPlugin.pas',
Main in 'Forms\Main.pas' {MainForm},
Tracer in 'Forms\Tracer.pas' {TraceForm},
About in 'Forms\About.pas' {AboutForm},
Adjust in 'Forms\Adjust.pas' {AdjustForm},
Browser in 'Forms\Browser.pas' {GradientBrowser},
Editor in 'Forms\Editor.pas' {EditForm},
FormExport in 'Forms\FormExport.pas' {ExportDialog},
formPostProcess in 'Forms\formPostProcess.pas' {frmPostProcess},
FormRender in 'Forms\FormRender.pas' {RenderForm},
Fullscreen in 'Forms\Fullscreen.pas' {FullscreenForm},
LoadTracker in 'Forms\LoadTracker.pas' {LoadForm},
Mutate in 'Forms\Mutate.pas' {MutateForm},
Options in 'Forms\Options.pas' {OptionsForm},
Save in 'Forms\Save.pas' {SaveForm},
SavePreset in 'Forms\SavePreset.pas' {SavePresetForm},
SplashForm in 'Forms\SplashForm.pas' {SplashWindow},
Template in 'Forms\Template.pas' {TemplateForm},
Curves in 'Forms\Curves.pas' {CurvesForm},
Preview in 'Forms\Preview.pas' {PreviewForm},
FormFavorites in 'Forms\FormFavorites.pas' {FavoritesForm},
ScriptForm in 'Forms\ScriptForm.pas' {ScriptEditor},
ScriptRender in 'Forms\ScriptRender.pas' {ScriptRenderForm},
ColorRangeForm in 'Forms\ColorRangeForm.pas' {ColorSelection},
Chaos in 'Forms\Chaos.pas' {ChaosForm},
VarOrderForm in 'Forms\VarOrderForm.pas' {VarOrder};
{$R *.res}
{$R Apophysis.res}
begin
ReportMemoryLeaksOnShutdown := true;
InitializePlugins;
SplashWindow := TSplashWindow.Create(Application);
SplashWindow.Show;
Application.Initialize;
SplashWindow.Update;
{$ifdef Apo7X64}
Application.Title := 'Apophysis AV (64 bit)';
{$else}
Application.Title := 'Apophysis AV (32 bit)';
{$endif}
Application.HelpFile := 'ApophysisAV.chm';
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TTraceForm, TraceForm);
Application.CreateForm(TAboutForm, AboutForm);
Application.CreateForm(TAdjustForm, AdjustForm);
Application.CreateForm(TGradientBrowser, GradientBrowser);
Application.CreateForm(TEditForm, EditForm);
Application.CreateForm(TfrmPostProcess, frmPostProcess);
Application.CreateForm(TRenderForm, RenderForm);
Application.CreateForm(TFullscreenForm, FullscreenForm);
Application.CreateForm(TLoadForm, LoadForm);
Application.CreateForm(TMutateForm, MutateForm);
Application.CreateForm(TOptionsForm, OptionsForm);
Application.CreateForm(TSaveForm, SaveForm);
Application.CreateForm(TSavePresetForm, SavePresetForm);
Application.CreateForm(TTemplateForm, TemplateForm);
Application.CreateForm(TCurvesForm, CurvesForm);
Application.CreateForm(TPreviewForm, PreviewForm);
Application.CreateForm(TFavoritesForm, FavoritesForm);
Application.CreateForm(TScriptEditor, ScriptEditor);
Application.CreateForm(TScriptRenderForm, ScriptRenderForm);
Application.CreateForm(TColorSelection, ColorSelection);
Application.CreateForm(TChaosForm, ChaosForm);
Application.CreateForm(TVarOrder, VarOrder);
Application.UpdateFormatSettings := False;
FormatSettings.DecimalSeparator := '.';
Application.Run;
end.
ApophysisAV.dproj
+1277
View File
File diff suppressed because it is too large Load Diff
ApophysisAV.res
BIN
View File
Binary file not shown.
ApophysisAV_Icon.ico
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 13 KiB

ColorMap/GradientHlpr.pas
+190
View File
@@ -0,0 +1,190 @@
{
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 GradientHlpr;
interface
uses
windows, Graphics, Cmap;
const
PixelCountMax = 32768;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
type
TGradientHelper = class
private
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
public
function GetGradientBitmap(Index: integer; const hue_rotation: double): TBitmap;
function RandomGradient: TColorMap;
end;
var
GradientHelper: TGradientHelper;
implementation
uses
Global;
{ TGradientHelper }
function TGradientHelper.GetGradientBitmap(Index: integer; const hue_rotation: double): TBitmap;
var
BitMap: TBitMap;
i, j: integer;
Row: pRGBTripleArray;
pal: TColorMap;
begin
GetCMap(index, hue_rotation, pal);
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 2;
for j := 0 to Bitmap.Height - 1 do begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do begin
Row[i].rgbtRed := Pal[i][0];
Row[i].rgbtGreen := Pal[i][1];
Row[i].rgbtBlue := Pal[i][2];
end
end;
Result := BitMap;
end;
///////////////////////////////////////////////////////////////////////////////
function TGradientHelper.RandomGradient: TColorMap;
var
a, b, i, n, nodes: integer;
c: byte;
rgb: array[0..2] of double;
hsv: array[0..2] of double;
pal: TColorMap;
begin
rgb[0] := 0;
rgb[1] := 0;
rgb[2] := 0;
inc(MainSeed);
RandSeed := Mainseed;
nodes := random((MaxNodes - 1) - (MinNodes - 2)) + (MinNodes - 1);
n := 256 div nodes;
b := 0;
hsv[0] := 0.01 * (random(MaxHue - (MinHue - 1)) + MinHue);
hsv[1] := 0.01 * (random(MaxSat - (MinSat - 1)) + MinSat);
hsv[2] := 0.01 * (random(MaxLum - (MinLum - 1)) + MinLum);
hsv2rgb(hsv, rgb);
Pal[0][0] := Round(rgb[0] * 255);
Pal[0][1] := Round(rgb[1] * 255);
Pal[0][2] := Round(rgb[2] * 255);
c := 0;
repeat
a := b;
if EqualStripes then
b := b + n
else begin
inc(c);
if c = nodes then
b := 255
else begin
i := Random(256 - b);
b := b + i;
end;
end;
hsv[0] := 0.01 * (random(MaxHue - (MinHue - 1)) + MinHue);
hsv[1] := 0.01 * (random(MaxSat - (MinSat - 1)) + MinSat);
hsv[2] := 0.01 * (random(MaxLum - (MinLum - 1)) + MinLum);
hsv2rgb(hsv, rgb);
if b > 255 then b := 255;
Pal[b][0] := Round(rgb[0] * 255);
Pal[b][1] := Round(rgb[1] * 255);
Pal[b][2] := Round(rgb[2] * 255);
case randColorBlend of
0: RGBBlend(a, b, pal);
1: HSVBlend(a, b, pal);
else
for i := a + 1 to b - 1 do
begin
Pal[i][0] := Round(rgb[0] * 255);
Pal[i][1] := Round(rgb[1] * 255);
Pal[i][2] := Round(rgb[2] * 255);
end;
end;
until b = 255;
Result := Pal;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TGradientHelper.RGBBlend(a, b: integer; var Palette: TColorMap);
{ Linear blend between to indices of a palette }
var
c, v: real;
vrange, range: real;
i: integer;
begin
if a = b then
begin
Exit;
end;
range := b - a;
vrange := Palette[b mod 256][0] - Palette[a mod 256][0];
c := Palette[a mod 256][0];
v := vrange / range;
for i := (a + 1) to (b - 1) do
begin
c := c + v;
Palette[i mod 256][0] := Round(c);
end;
vrange := Palette[b mod 256][1] - Palette[a mod 256][1];
c := Palette[a mod 256][1];
v := vrange / range;
for i := a + 1 to b - 1 do
begin
c := c + v;
Palette[i mod 256][1] := Round(c);
end;
vrange := Palette[b mod 256][2] - Palette[a mod 256][2];
c := Palette[a mod 256][2];
v := vrange / range;
for i := a + 1 to b - 1 do
begin
c := c + v;
Palette[i mod 256][2] := Round(c);
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
GradientHelper := TGradientHelper.create;
finalization
GradientHelper.Free;
end.
ColorMap/cmap.pas
+426
View File
@@ -0,0 +1,426 @@
{
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 Cmap;
interface
uses sysutils, classes;
type
TColorMap = array[0..255, 0..3] of integer;
type
EFormatInvalid = class(Exception);
const
RANDOMCMAP = -1;
NRCMAPS = 704;
procedure GetCmap(var Index: integer; const hue_rotation: double; out cmap: TColorMap);
procedure GetCmapName(var Index: integer; out Name: string);
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
procedure hsv2rgb(const hsv: array of double; out rgb: array of double);
function GetGradient(FileName, Entry: string): string;
function GetPalette(strng: string; var Palette: TColorMap): boolean;
procedure GetTokens(s: string; var mlist: TStringList);
procedure HSVBlend(a, b: integer; var Palette: TColorMap); // AV
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
procedure Brighten(const n: byte; var r, g, b: byte); // AV
implementation
uses
cmapdata, Math;
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
var
maxval, minval: double;
del: double;
begin
Maxval := Max(rgb[0], Max(rgb[1], rgb[2]));
Minval := Min(rgb[0], Min(rgb[1], rgb[2]));
hsv[2] := maxval; // v
if (Maxval > 0) and (maxval <> minval) then begin
del := maxval - minval;
hsv[1] := del / Maxval; //s
hsv[0] := 0;
if (rgb[0] > rgb[1]) and (rgb[0] > rgb[2]) then begin
hsv[0] := (rgb[1] - rgb[2]) / del;
end else if (rgb[1] > rgb[2]) then begin
hsv[0] := 2 + (rgb[2] - rgb[0]) / del;
end else begin
hsv[0] := 4 + (rgb[0] - rgb[1]) / del;
end;
if hsv[0] < 0 then
hsv[0] := hsv[0] + 6;
end else begin
hsv[0] := 0;
hsv[1] := 0;
end;
end;
procedure hsv2rgb(const hsv: array of double; out rgb: array of double);
var
j: integer;
f, p, q, t, v: double;
begin
try
// rgb[0] := 0;
// rgb[1] := 0;
// rgb[2] := 0;
j := floor(hsv[0]);
f := hsv[0] - j;
v := hsv[2];
p := hsv[2] * (1 - hsv[1]);
q := hsv[2] * (1 - hsv[1] * f);
t := hsv[2] * (1 - hsv[1] * (1 - f));
case j of
0: begin rgb[0] := v; rgb[1] := t; rgb[2] := p; end;
1: begin rgb[0] := q; rgb[1] := v; rgb[2] := p; end;
2: begin rgb[0] := p; rgb[1] := v; rgb[2] := t; end;
3: begin rgb[0] := p; rgb[1] := q; rgb[2] := v; end;
4: begin rgb[0] := t; rgb[1] := p; rgb[2] := v; end;
5: begin rgb[0] := v; rgb[1] := p; rgb[2] := q; end;
end;
except on EMathError do
end;
end;
procedure GetCmap(var Index: integer; const hue_rotation: double; out cmap: TColorMap);
var
i: Integer;
rgb: array[0..2] of double;
hsv: array[0..2] of double;
begin
if Index = RANDOMCMAP then
Index := Random(NRCMAPS);
if (Index < 0) or (Index >= NRCMAPS) then
Index := 0;
for i := 0 to 255 do begin
rgb[0] := cmaps[Index][i][0] / 255.0;
rgb[1] := cmaps[Index][i][1] / 255.0;
rgb[2] := cmaps[Index][i][2] / 255.0;
rgb2hsv(rgb, hsv);
hsv[0] := hsv[0] + hue_rotation * 6;
hsv2rgb(hsv, rgb);
cmap[i][0] := Round(rgb[0] * 255);
cmap[i][1] := Round(rgb[1] * 255);
cmap[i][2] := Round(rgb[2] * 255);
end;
end;
procedure GetCmapName(var Index: integer; out Name: string);
begin
if Index = RANDOMCMAP then
Index := Random(NRCMAPS);
if (Index < 0) or (Index >= NRCMAPS) then
Index := 0;
Name := CMapNames[Index];
end;
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
{ Linear blend between to indices of a palette }
var
c, v: real;
vrange, range: real;
i: integer;
begin
if a = b then
begin
Exit;
end;
range := b - a;
vrange := Palette[b mod 256][0] - Palette[a mod 256][0];
c := Palette[a mod 256][0];
v := vrange / range;
for i := (a + 1) to (b - 1) do
begin
c := c + v;
Palette[i mod 256][0] := Round(c);
end;
vrange := Palette[b mod 256][1] - Palette[a mod 256][1];
c := Palette[a mod 256][1];
v := vrange / range;
for i := a + 1 to b - 1 do
begin
c := c + v;
Palette[i mod 256][1] := Round(c);
end;
vrange := Palette[b mod 256][2] - Palette[a mod 256][2];
c := Palette[a mod 256][2];
v := vrange / range;
for i := a + 1 to b - 1 do
begin
c := c + v;
Palette[i mod 256][2] := Round(c);
end;
end;
procedure HSVBlend(a, b: integer; var Palette: TColorMap);
{ AV: Linear HSV interpolation}
var i, range: integer;
rgb, hsv, rgb1, hsv1, rgb2, hsv2: array [0..2] of double;
function lerp(range, b, i: integer; p1, p2: double): double;
var k: double;
begin
k := (b - i)/range;
Result := k * p1 + (1 - k) * p2;
end;
begin
if a = b then Exit;
range := b - a;
for i := 0 to 2 do begin
rgb1[i] := double(Palette[a][i]);
rgb2[i] := double(Palette[b][i]);
end;
rgb2hsv(rgb1, hsv1);
rgb2hsv(rgb2, hsv2);
for i := (a + 1) to (b - 1) do
begin
hsv[0] := lerp(range, b, i, hsv1[0], hsv2[0]);
hsv[1] := lerp(range, b, i, hsv1[1], hsv2[1]);
hsv[2] := lerp(range, b, i, hsv1[2], hsv2[2]);
hsv2rgb(hsv, rgb);
Palette[i][0] := Round(rgb[0]);
Palette[i][1] := Round(rgb[1]);
Palette[i][2] := Round(rgb[2]);
end;
end;
procedure Brighten(const n: byte; var r, g, b: byte);
var rgb, hsv: array [0..2] of double;
begin
rgb[0] := double(r);
rgb[1] := double(g);
rgb[2] := double(b);
rgb2hsv(rgb, hsv);
hsv[2] := hsv[2] + n;
// if (hsv[2] < 0) then hsv[2] := 0
// else if (hsv[2] > 255) then hsv[2] := 255;
hsv2rgb(hsv, rgb);
r := Round(rgb[0]);
g := Round(rgb[1]);
b := Round(rgb[2]);
end;
function GetVal(token: string): string;
var
p: integer;
begin
p := Pos('=', token);
Delete(Token, 1, p);
Result := Token;
end;
function ReplaceTabs(str: string): string;
{Changes tab characters in a string to spaces}
var
i: integer;
begin
for i := 1 to Length(str) do
begin
if str[i] = #9 then
begin
Delete(str, i, 1);
Insert(#32, str, i);
end;
end;
Result := str;
end;
procedure GetTokens(s: string; var mlist: TStringList);
var
test, token: string;
begin
mlist.clear;
test := s;
while (Length(Test) > 0) do
begin
while (Length(Test) > 0) and CharInSet(test[1],[#32]) do
Delete(test, 1, 1);
if (Length(Test) = 0) then
exit;
token := '';
while (Length(Test) > 0) and (not CharInSet(test[1],[#32])) do
begin
token := token + test[1];
Delete(test, 1, 1);
end;
mlist.add(token);
end;
end;
function GetPalette(strng: string; var Palette: TColorMap): boolean;
{ Loads a palette from a gradient string }
var
Strings: TStringList;
index, i: integer;
Tokens: TStringList;
Indices, Colors: TStringList;
a, b: integer;
begin
GetPalette := True;
Strings := TStringList.Create;
Tokens := TStringList.Create;
Indices := TStringList.Create;
Colors := TStringList.Create;
try
try
Strings.Text := strng;
if Pos('}', Strings.Text) = 0 then raise EFormatInvalid.Create('No closing brace');
if Pos('{', Strings[0]) = 0 then raise EFormatInvalid.Create('No opening brace.');
GetTokens(ReplaceTabs(Strings.Text), Tokens);
i := 0;
while (Pos('}', Tokens[i]) = 0) and (Pos('opacity:', Lowercase(Tokens[i])) = 0) do
begin
if Pos('index=', LowerCase(Tokens[i])) <> 0 then
Indices.Add(GetVal(Tokens[i]))
else if Pos('color=', LowerCase(Tokens[i])) <> 0 then
Colors.Add(GetVal(Tokens[i]));
inc(i)
end;
for i := 0 to 255 do
begin
Palette[i][0] := 0;
Palette[i][1] := 0;
Palette[i][2] := 0;
end;
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
Palette[index][0] := StrToInt(Colors[i]) mod 256;
Palette[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
Palette[index][2] := trunc(StrToInt(Colors[i]) / 65536);
except
end;
end;
i := 1;
repeat
a := StrToInt(Indices[i - 1]);
b := StrToInt(Indices[i]);
RGBBlend(a, b, Palette);
inc(i);
until i = Indices.Count;
if (Indices[0] <> '0') or (Indices[Indices.Count - 1] <> '255') then
begin
a := StrToInt(Indices[Indices.Count - 1]);
b := StrToInt(Indices[0]) + 256;
RGBBlend(a, b, Palette);
end;
except on EFormatInvalid do
begin
Result := False;
end;
end;
finally
Tokens.Free;
Strings.Free;
Indices.Free;
Colors.Free;
end;
end;
function GetGradient(FileName, Entry: string): string;
var
FileStrings: TStringList;
GradStrings: TStringList;
i: integer;
begin
FileStrings := TStringList.Create;
GradStrings := TStringList.Create;
try
try
FileStrings.LoadFromFile(FileName);
for i := 0 to FileStrings.count - 1 do
if Pos(Entry + ' ', Trim(FileStrings[i])) = 1 then break;
GradStrings.Add(FileStrings[i]);
repeat
inc(i);
GradStrings.Add(FileStrings[i]);
until Pos('}', FileStrings[i]) <> 0;
GetGradient := GradStrings.Text;
except on exception do
Result := '';
end;
finally
GradStrings.Free;
FileStrings.Free;
end;
end;
function LoadGradient(FileName, Entry: string; var gString: string; var Pal: TColorMap): boolean;
var
FileStrings: TStringList;
GradStrings: TStringList;
i: integer;
begin
FileStrings := TStringList.Create;
GradStrings := TStringList.Create;
try
try
FileStrings.LoadFromFile(FileName);
for i := 0 to FileStrings.count - 1 do
if Pos(Entry + ' ', Trim(FileStrings[i])) = 1 then break;
GradStrings.Add(FileStrings[i]);
repeat
inc(i);
GradStrings.Add(FileStrings[i]);
until Pos('}', FileStrings[i]) <> 0;
gString := GradStrings.Text;
Result := GetPalette(GradStrings.Text, Pal);
except on exception do
Result := False;
end;
finally
GradStrings.Free;
FileStrings.Free;
end;
end;
end.
ColorMap/cmapdata.pas
+47946
View File
File diff suppressed because it is too large Load Diff
Core/BaseVariation.pas
+226
View File
@@ -0,0 +1,226 @@
{
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 BaseVariation;
interface
type
TCalcFunction = procedure of object;
type
TBaseVariation = class
protected
procedure CalcFunction; virtual; abstract;
public
vvar: double;
FTx, FTy: ^double;
FPx, FPy: ^double;
FTz, FPz: ^double;
// more params :)
color : ^double;
a, b, c, d, e, f : double;
class function GetName: string; virtual; abstract;
class function GetInstance: TBaseVariation; virtual; abstract;
function GetNrVariables: integer; virtual;
function GetVariableNameAt(const Index: integer): string; virtual;
function GetVariable(const Name: string; var Value: double): boolean; virtual;
function SetVariable(const Name: string; var Value: double): boolean; virtual;
function ResetVariable(const Name: string): boolean; virtual;
function GetVariableStr(const Name: string): string; virtual;
function SetVariableStr(const Name: string; var strValue: string): boolean; virtual;
procedure Prepare; virtual;
procedure GetCalcFunction(var Delphi_Suxx: TCalcFunction); virtual;
end;
TBaseVariationClass = class of TBaseVariation;
type
TVariationLoader = class
public
Supports3D, SupportsDC : boolean;
function GetName: string; virtual; abstract;
function GetInstance: TBaseVariation; virtual; abstract;
function GetNrVariables: integer; virtual; abstract;
function GetVariableNameAt(const Index: integer): string; virtual; abstract;
end;
type
TVariationClassLoader = class (TVariationLoader)
public
constructor Create(varClass : TBaseVariationClass);
function GetName: string; override;
function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
private
VariationClass : TBaseVariationClass;
end;
const
PI2 = 6.283185307179586476925286766559; // AV
PI_2 = 1.5707963267948966192313216916398; // AV
function fmod(x, y: double) : double;
procedure SinhCosh(const v: double; var sh, ch: double); // AV
implementation
uses SysUtils;
function fmod(x, y: double) : double;
begin
Result := frac(x / y) * y;
end;
procedure SinhCosh(const v: double; var sh, ch: double);
// AV: calcs both hyperbolic sine and cosine
var ep, en: double;
begin
ep := 0.5 * exp(v);
en := 0.25 / ep; // 0.5 * exp(-v);
sh := ep - en;
ch := ep + en;
end;
{ TBaseVariation }
///////////////////////////////////////////////////////////////////////////////
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;
function TBaseVariation.ResetVariable(const Name: string): boolean;
var
zero: double;
begin
zero := 0;
Result := SetVariable(Name, zero);
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseVariation.GetVariableStr(const Name: string): string;
var
value: double;
begin
if GetVariable(Name, value) then
Result := Format('%.6g', [value])
else
Result := '';
end;
function TBaseVariation.SetVariableStr(const Name: string; var strValue: string): boolean;
var
v, oldv: double;
begin
if GetVariable(Name, oldv) then begin
try
v := StrToFloat(strValue);
SetVariable(Name, v);
except
v := oldv;
end;
strValue := Format('%.6g', [v]);
Result := true;
end
else Result := false;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseVariation.GetVariableNameAt(const Index: integer): string;
begin
Result := ''
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseVariation.Prepare;
begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseVariation.GetCalcFunction(var Delphi_Suxx: TCalcFunction);
begin
Delphi_Suxx := CalcFunction; // -X- lol
end;
///////////////////////////////////////////////////////////////////////////////
{ TVariationClassLoader }
constructor TVariationClassLoader.Create(varClass : TBaseVariationClass);
begin
VariationClass := varClass;
end;
function TVariationClassLoader.GetName: string;
begin
Result := VariationClass.GetName();
end;
function TVariationClassLoader.GetInstance: TBaseVariation;
begin
Result := VariationClass.GetInstance();
end;
function TVariationClassLoader.GetNrVariables: integer;
var
hack : TBaseVariation;
begin
hack := GetInstance();
Result := hack.GetNrVariables();
hack.Free();
end;
function TVariationClassLoader.GetVariableNameAt(const Index: integer): string;
var
hack : TBaseVariation;
begin
hack := GetInstance();
Result := hack.GetVariableNameAt(Index);
hack.Free();
end;
end.
Core/Bezier.pas
+94
View File
@@ -0,0 +1,94 @@
unit Bezier;
interface
uses Math;
type
BezierPoint = record
x, y: double;
end;
BezierRect = record
x0, y0, x1, y1: double;
end;
BezierPoints = array [0..3] of BezierPoint;
BezierWeights = array [0..3] of double;
procedure BezierCopy(src: BezierPoints; var tgt: BezierPoints);
procedure BezierSetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
procedure BezierUnsetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
procedure BezierSolve(t: double; src: BezierPoints; w: BezierWeights; var solution: BezierPoint);
function BezierFunc(t: double; src: BezierPoints; w: BezierWeights): double;
implementation
procedure BezierCopy(src: BezierPoints; var tgt: BezierPoints);
var
i, n: integer;
begin
n := Length(src);
for i := 0 to n - 1 do
tgt[i] := src[i];
end;
procedure BezierSetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
var
i, n: integer;
f: double;
begin
n := Length(points);
for i := 0 to n - 1 do
begin
if (flip) then f := 1 - points[i].y
else f := points[i].y;
points[i].x := points[i].x * (rect.x1 - rect.x0) + rect.x0;
points[i].y := f * (rect.y1 - rect.y0) + rect.y0;
end;
end;
procedure BezierUnsetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
var
i, n: integer;
f: double;
begin
if ((rect.x1 - rect.x0) = 0) or ((rect.y1 - rect.y0) = 0) then Exit;
n := Length(points);
for i := 0 to n - 1 do
begin
points[i].x := (points[i].x - rect.x0) / (rect.x1 - rect.x0);
points[i].y := (points[i].y - rect.y0) / (rect.y1 - rect.y0);
if (flip) then points[i].y := 1 - points[i].y;
end;
end;
procedure BezierSolve(t: double; src: BezierPoints; w: BezierWeights; var solution: BezierPoint);
var
s, s2, s3, t2, t3, nom_x, nom_y, denom: double;
begin
s := 1 - t;
s2 := s * s; s3 := s * s * s;
t2 := t * t; t3 := t * t * t;
nom_x := w[0] * s3 * src[0].x + w[1] * s2 * 3 * t * src[1].x +
w[2] * s * 3 * t2 * src[2].x + w[3] * t3 * src[3].x;
nom_y := w[0] * s3 * src[0].y + w[1] * s2 * 3 * t * src[1].y +
w[2] * s * 3 * t2 * src[2].y + w[3] * t3 * src[3].y;
denom := w[0] * s3 + w[1] * s2 * 3 * t + w[2] * s * 3 * t2 + w[3] * t3;
if (IsNaN(nom_x)) or (IsNaN(nom_y)) or (IsNaN(denom)) then Exit;
if denom = 0 then Exit;
solution.x := nom_x / denom;
solution.y := nom_y / denom;
end;
function BezierFunc(t: double; src: BezierPoints; w: BezierWeights): double;
var
p: BezierPoint;
begin
BezierSolve(t, src, w, p);
Result := p.y;
end;
end.
Core/Chaotica.pas
+300
View File
@@ -0,0 +1,300 @@
unit Chaotica;
interface
uses Global, RegularExpressionsCore, RegexHelper, Classes, SysUtils, XFormMan, Windows,
ShellAPI, Forms, ControlPoint, Translation;
function C_GetPathOf(filename: string; usex64: boolean): string;
function C_SupportsDllPlugins(usex64: boolean): boolean;
function C_IsDllPluginBlacklisted(filename: string; usex64: boolean): boolean;
function C_IsVariationNative(name: string; usex64: boolean): boolean;
function C_IsDllPluginInstalled(filename: string): boolean;
procedure C_SyncDllPlugins;
procedure C_InstallVariation(name: string);
procedure C_ExecuteChaotica(flamexml: string; plugins: TStringList; usex64: boolean);
implementation
uses Main;
(* // AV: rewrote and moved to Global unit
function CheckX64: Boolean;
var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
ExecuteFile, ParamString, StartInString: string;
begin
{$ifdef Apo7X64}
Result := true;
exit;
{$endif}
ExecuteFile := ExtractFilePath(Application.ExeName) + 'chk64.exe';
FillChar(SEInfo, SizeOf(SEInfo), 0);
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
with SEInfo do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(ExecuteFile) ;
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(@SEInfo) then
begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
Result := (ExitCode = 0);
end else begin
Result := false;
end;
end;
*)
function C_GetPathOf(filename: string; usex64: boolean): string;
begin
Result := ChaoticaPath + '\' + filename;
end;
function C_SupportsDllPlugins(usex64: boolean): boolean;
const
re_root : string = '<variation_compatibility\s+(.*?)>.*?</variation_compatibility>';
re_attrib : string = 'supports_dll_plugins="(.*?)"';
var
xml_file : TStringList;
xml_text, attrib, value : string;
begin
if usex64 then begin
Result := false;
Exit;
end;
xml_file := TStringList.Create;
// AV: for compatibility with new Chaotica versions
if not FileExists(ChaoticaPath + '\variation_compatibility.xml') then
begin
xml_file.Add('<variation_compatibility >' + #13#10 + '</variation_compatibility>');
xml_file.SaveToFile(ChaoticaPath + '\variation_compatibility.xml');
xml_file.Clear;
end;
xml_file.LoadFromFile(C_GetPathOf('variation_compatibility.xml', false));
xml_text := xml_file.Text;
xml_file.Free;
attrib := GetStringPart(xml_text, re_root, 1, 'supports_dll_plugins="false"');
value := GetStringPart(attrib, re_attrib, 1, 'false');
Result := (value = 'true');
end;
function C_IsDllPluginBlacklisted(filename: string; usex64: boolean): boolean;
var
i: integer;
blacklist: TStringList;
begin
blacklist := TStringList.Create;
if not FileExists(ChaoticaPath + '\plugin_dll_blacklist.txt') then
begin
blacklist.Add('avMobius.dll');
blacklist.Add('Cross.dll');
blacklist.Add('Epispiral.dll');
blacklist.Add('EpispiralVariationPlugin.dll');
blacklist.Add('FlowerVariationPlugin.dll');
blacklist.Add('Lissajous.dll');
blacklist.Add('Mandelbrot.dll');
blacklist.Add('ShapeVariationPlugin.dll');
blacklist.Add('slinky.dll');
blacklist.Add('Spirograph.dll');
blacklist.Add('Square.dll');
blacklist.Add('Stretchy Pants.dll');
blacklist.Add('Waffle.dll');
blacklist.SaveToFile(ChaoticaPath + '\plugin_dll_blacklist.txt');
end;
blacklist.LoadFromFile(C_GetPathOf('plugin_dll_blacklist.txt', usex64));
for i := 0 to blacklist.Count - 1 do begin
if LowerCase(filename) = LowerCase(blacklist.Strings[i]) then begin
Result := true;
blacklist.Free;
Exit;
end;
end;
blacklist.Free;
Result := false;
end;
function C_IsVariationNative(name: string; usex64: boolean): boolean;
const
re_root : string = '<variation_compatibility.*?>(.*?)</variation_compatibility>';
re_var : string = '<variation name="(.*?)".*?/>';
var
xml, var_name : string;
xml_file : TStringList;
find_var : TPerlRegEx;
found_var : boolean;
begin
xml_file := TStringList.Create;
// AV: for compatibility with new Chaotica versions
if not FileExists(ChaoticaPath + '\variation_compatibility.xml') then
begin
xml_file.Add('<variation_compatibility >' + #13#10 + '</variation_compatibility>');
xml_file.SaveToFile(ChaoticaPath + '\variation_compatibility.xml');
xml_file.Clear;
end;
xml_file.LoadFromFile(C_GetPathOf('variation_compatibility.xml', false));
xml := xml_file.Text;
xml_file.Free;
find_var := TPerlRegEx.Create;
find_var.RegEx := re_var;
find_var.Options := [preSingleLine, preCaseless];
find_var.Subject := GetStringPart(xml, re_root, 1, '');
found_var := find_var.Match;
while found_var do begin
var_name := String(find_var.Groups[1]);
found_var := find_var.MatchAgain;
if LowerCase(name) = var_name then begin
find_var.Destroy;
Result := true;
Exit;
end;
end;
find_var.Destroy;
Result := false;
end;
function C_IsDllPluginInstalled(filename: string): boolean;
var
path : string;
begin
path := C_GetPathOf('plugins\' + filename, false);
Result := FileExists(path);
end;
////////////////////////////////////////////////////////////////////
procedure C_InstallVariation(name: string);
var
filename: string;
begin
filename := GetFileNameOfVariation(name);
if (filename = '') then Exit;
if C_IsDllPluginInstalled(filename) then Exit;
CopyFile(PCHAR(filename), PCHAR(C_GetPathOf('plugins\' +
ExtractFileName(filename), false)), false);
end;
procedure C_SyncDllPlugins;
var
src_dir: string;
tgt_dir: string;
searchResult: TSearchRec;
begin
src_dir := PluginPath;
tgt_dir := C_GetPathOf('Plugins', false);
if (not DirectoryExists(src_dir)) then Exit;
if (not DirectoryExists(tgt_dir)) then Exit;
//CreateDir(ChaoticaPath + '\Plugins');
// First clear all plugins on Chaotica side
if FindFirst(tgt_dir + '\*.dll', faAnyFile, searchResult) = 0 then
begin
repeat
DeleteFile(PCHAR(tgt_dir + '\' + searchResult.Name)) ;
until (FindNext(searchResult) <> 0);
SysUtils.FindClose(searchResult);
end;
// Then copy all plugins from Apophysis to Chaotica
if FindFirst(src_dir + '*.dll', faAnyFile, searchResult) = 0 then
begin
repeat
if not C_IsDllPluginBlacklisted(searchResult.Name, false)
then CopyFile(
PCHAR(src_dir + '\' + searchResult.Name),
PCHAR(tgt_dir + '\' + searchResult.Name),
false);
until (FindNext(searchResult) <> 0);
SysUtils.FindClose(searchResult);
end;
end;
procedure C_ExecuteChaotica(flamexml: string; plugins: TStringList; usex64: boolean);
var
i: integer;
name, fname: string;
fails: TStringList;
txt: TStringList;
fin_usex64: boolean;
begin
fails := TStringList.Create;
{$ifdef Apo7X64}
fin_usex64 := true;
{$else}
fin_usex64 := usex64 and CheckX64; // currently useless...
for i := 0 to plugins.Count - 1 do begin
name := GetFileNameOfVariation(plugins.Strings[i]);
if (name = '') then name := plugins.Strings[i];
fin_usex64 := fin_usex64 and C_IsVariationNative(name, usex64);
end;
for i := 0 to plugins.Count - 1 do begin
name := GetFileNameOfVariation(plugins.Strings[i]);
if (name = '') then name := plugins.Strings[i]; // assume built-in
if not C_IsVariationNative(name, fin_usex64) then begin // not native -> try install
if C_SupportsDllPlugins(fin_usex64) then // dll unsupported -> fail
fails.Add(plugins.Strings[i])
else if C_IsDllPluginBlacklisted(name, fin_usex64) then // dll supported and blacklisted -> fail
fails.Add(plugins.Strings[i]);
//else C_InstallVariation(plugins.Strings[i]); // dll supported and not blacklisted -> install
// ^^^ this is done on Apophysis startup now!
end;
end;
{$endif}
name := C_GetPathOf('chaotica.exe', fin_usex64);
if (not FileExists(name)) then begin
messagebox(0, PCHAR(TextByKey('main-status-nochaotica')),
PCHAR('Apophysis AV'), MB_ICONHAND);
Exit;
end;
if (fails.Count > 0) then begin
messagebox(0, PCHAR(TextByKey('main-status-oldchaotica')),
PCHAR('Apophysis AV'), MB_ICONHAND or MB_OK);
end;
// TODO: add directory cleaning
fname := GetEnvironmentVariable('TEMP') + '\chaotica_export.flame';
txt := TStringList.Create;
txt.Text := flamexml;
txt.SaveToFile(fname);
txt.Free;
fails.Free;
//if fin_usex64 then MessageBox(0, PCHAR('DBG:x64'), PCHAR(''), MB_OK)
//else MessageBox(0, PCHAR('DBG:x86'), PCHAR(''), MB_OK) ;
ShellExecute(application.handle, PChar('open'), pchar(name),
PChar('"' + fname + '"'), PChar(ExtractFilePath(name)), SW_SHOWNORMAL);
end;
end.
Core/Global.pas
+764
View File
@@ -0,0 +1,764 @@
{
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 Global;
interface
uses
Windows, SysUtils, Classes, SyncObjs, Controls, Graphics, Math,
cmap, ControlPoint, Xform, CommDlg;
type
EFormatInvalid = class(Exception);
// AV: chanded the name to avoid conflicts with XForm
TMatrix2 = array[0..1, 0..1] of double;
{ Weight manipulation }
{ Triangle transformations }
function triangle_area(t: TTriangle): double;
function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean;
function line_dist(x, y, x1, y1, x2, y2: double): double;
function dist(x1, y1, x2, y2: double): double;
procedure MultMatrix(var s: TMatrix2; const m: TMatrix2);
{ Parsing functions }
function GetVal(token: string): string;
function ReplaceTabs(str: string): string;
{ Palette and gradient functions }
//function GetGradient(FileName, Entry: string): string;
{ Misc }
function det(a, b, c, d: double): double;
function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double;
var a, b, e: double): double;
function OpenSaveFileDialog(Parent: TWinControl;
const DefExt,
Filter,
InitialDir,
Title: string;
var FileName: string;
MustExist,
OverwritePrompt,
NoChangeDir,
DoOpen: Boolean): Boolean;
procedure LoadThumbnailPlaceholder(ThumbnailSize : integer);
function GetEnvVarValue(const VarName: string): string;
function Round6(x: double): double;
function MiddleColor(const clOne, clTwo: TColor): TColor; // AV
function CheckX64: Boolean; // AV
const
APP_NAME: string = 'Apophysis AV';
APP_VERSION: string = 'Phoenix Edition';
{$ifdef Apo7X64}
APP_BUILD: string = ' - 64 bit';
{$else}
APP_BUILD: string = ' - 32 bit';
{$endif}
MAX_TRANSFORMS: integer = 100;
prefilter_white: integer = 1024;
eps: double = 1E-10;
White_level = 200;
FT_BMP = 1; FT_PNG = 2; FT_JPG = 3;
//clyellow1 = TColor($17FCFF);
//clplum2 = TColor($ECA9E6);
//clSlateGray = TColor($837365);
const
crEditArrow = 20;
crEditMove = 21;
crEditRotate = 22;
crEditScale = 23;
const
SingleBuffer : boolean =
{$ifdef Apo7X64}
false
{$else}
true
{$endif};
var
MainSeed: integer;
MainTriangles: TTriangles; // ControlPoint.TTriangles;
Transforms: integer; // Count of Tranforms
EnableFinalXform: boolean;
AppPath: string; // Path of application file
OpenFile: string; // Name of currently open file
CanDrawOnResize: boolean;
PreserveWeights: boolean;
AlwaysCreateBlankFlame : boolean;
// StartupCheckForUpdates : boolean;
TBWidth1 : integer;
TBWidth2 : integer;
TBWidth3 : integer;
TBWidth4 : integer;
TBWidth5 : integer;
ThumbnailPlaceholder : TBitmap;
WarnOnMissingPlugin : boolean;
EmbedThumbnails : boolean;
RandomizeTemplates: boolean;
LanguageFile : string;
AvailableLanguages : TStringList;
PluginPath : string;
// AV: GUI Theme Stuff
CurrentStyle: string;
// theme-aware system colors
WinColor, BrightColor, MidColor, TextColor: TColor;
IsDarkTheme, IsLightMenu: boolean;
{ UPR Options }
UPRSampleDensity: integer;
UPRFilterRadius: double;
UPROversample: integer;
UPRAdjustDensity: boolean;
UPRColoringIdent: string;
UPRColoringFile: string;
UPRFormulaIdent: string;
UPRFormulaFile: string;
UPRWidth: Integer;
UPRHeight: Integer;
ImageFolder: string;
UPRPath: string; // Name and folder of last UPR file
cmap_index: integer; // Index to current gradient
Variation: TVariation; // Current variation // ControlPoint.TVariation;
NumTries, TryLength: integer; // Settings for smooth palette
SmoothPaletteFile: string;
{ Editor }
UseFlameBackground, UseTransformColors: boolean;
HelpersEnabled: boolean;
EditorBkgColor, ReferenceTriangleColor: integer;
GridColor1, GridColor2, HelpersColor, FlipColor: integer;
ExtEditEnabled, TransformAxisLock, RebuildXaosLinks: boolean;
ShowAllXforms: boolean;
EditorPreviewTransparency: integer;
EnableEditorPreview: boolean;
AllowResetCoefs, AllowResetLinear: boolean; // AV
{ Display }
defSampleDensity, defPreviewDensity: Double;
defGamma, defBrightness, defVibrancy, defContrast, // AV
defFilterRadius, defGammaThreshold: Double;
defOversample: integer;
FUSE: byte; // AV: moved from ControlPoint and changed to variable
RhombTR, SquareTR, HexTR: single; // AV: tile radii
{ Render }
renderDensity, renderFilterRadius: double;
renderOversample, renderWidth, renderHeight: integer;
// renderBitsPerSample: integer;
renderPath: string;
JPEGQuality: integer;
renderFileFormat: integer;
InternalBitsPerSample: integer;
EmbedFlame, SaveInFlame: boolean; // AV
NrTreads: Integer;
UseNrThreads: byte; // AV: currently holds Nr CPU cores
PNGTransparency: integer;
ShowTransparency: boolean;
MainPreviewScale: double;
ExtendMainPreview: boolean;
(*
StoreEXIF : boolean;
StoreParamsEXIF : boolean;
ExifAuthor : string;
*)
{ Defaults }
LastOpenFile: string;
LastOpenFileEntry: integer;
RememberLastOpenFile: boolean;
UseSmallThumbnails: boolean;
ClassicListMode: boolean;
ConfirmDelete: boolean; // Flag confirmation of entry deletion
OldPaletteFormat: boolean;
ConfirmExit: boolean;
ConfirmStopRender: boolean;
ConfirmClearScript: boolean;
SavePath, SmoothPalettePath: string;
RandomPrefix, RandomDate: string;
RandomIndex: integer;
FlameFile, GradientFile, GradientEntry, FlameEntry: string;
ParamFolder: string;
prevLowQuality, prevMediumQuality, prevHighQuality: double;
defSmoothPaletteFile: string;
BrowserPath: string; // Stored path of browser open dialog
EditPrevQual, MutatePrevQual, AdjustPrevQual: byte; // Integer;
ThumbPrevQual: byte; // AV
randMinTransforms, randMaxTransforms: integer;
mutantMinTransforms, mutantMaxTransforms: integer;
KeepBackground: boolean;
RandBackColor: integer; // AV
randGradient: Integer;
randGradientFile: string;
randColorBlend: byte; // AV
EqualStripes: boolean;
defFlameFile: string;
defScriptFile: string; // AV
SetEngLayout: boolean; // AV
ScreenShotPath: string; // AV
AutoSaveXML, ApplyFlatten: boolean; // AV
PlaySoundOnRenderComplete: boolean;
RenderCompleteSoundFile: string;
SaveIncompleteRenders: boolean;
ShowRenderStats, ShowRenderImage: boolean;
LowerRenderPriority: boolean;
SymmetryType: integer;
SymmetryOrder: integer;
SymmetryNVars: integer;
Variations: array of boolean;
FavouriteVariations: array of boolean;
MainForm_RotationMode: byte; // integer;
PreserveQuality: boolean;
FlameEnumMode: byte; // AV
{ For random gradients }
MinNodes, MaxNodes, MinHue, MaxHue, MinSat, MaxSat, MinLum, MaxLum: integer;
//ReferenceMode: integer;
BatchSize: Integer;
// Compatibility: integer; //0 = original, 1 = Drave's
Favorites: TStringList;
Script: string;
ScriptPath: string;
// SheepServer, SheepNick, SheepURL, SheepPW,
flam3Path, helpPath: string;
ExportBatches, ExportOversample, ExportWidth, ExportHeight, ExportFileFormat: Integer;
ExportFilter, ExportDensity: Double;
ExportEstimator, ExportEstimatorMin, ExportEstimatorCurve: double;
ExportJitters: integer;
ExportGammaTreshold: double;
OpenFileType: TFileType;
// ResizeOnLoad: Boolean;
ShowProgress: Boolean;
defLibrary: string;
LimitVibrancy: Boolean;
DefaultPalette: TColorMap;
ChaoticaPath: string;
UseX64IfPossible: boolean;
AutoOpenLog: Boolean;
AutoSaveEnabled: Boolean;
AutoSaveFreq: integer;
AutoSavePath: string;
LineCenterColor : integer;
LineThirdsColor : integer;
LineGRColor : integer;
EnableGuides : boolean;
implementation
function GetEnvVarValue(const VarName: string): string;
var
BufSize: Integer; // buffer size required for value
begin
// Get required buffer size (inc. terminal #0)
BufSize := GetEnvironmentVariable(
PChar(VarName), nil, 0);
if BufSize > 0 then
begin
// Read env var value into result string
SetLength(Result, BufSize - 1);
GetEnvironmentVariable(PChar(VarName),
PChar(Result), BufSize);
end
else
// No such environment variable
Result := '';
end;
procedure LoadThumbnailPlaceholder(ThumbnailSize : integer);
var
placeholderIcon: TBitmap;
const
pi_width = 48;
pi_height = 48;
begin
placeholderIcon := TBitmap.Create;
placeholderIcon.Handle := LoadBitmap(hInstance, 'THUMB_PLACEHOLDER');
// AV: replaced a local variable by the global one
ThumbnailPlaceholder.PixelFormat := pf32bit;
ThumbnailPlaceholder.HandleType := bmDIB;
ThumbnailPlaceholder.Width := ThumbnailSize;
ThumbnailPlaceholder.Height := ThumbnailSize;
with ThumbnailPlaceholder.Canvas do begin
Brush.Color := $000000;
FillRect(Rect(0, 0, ThumbnailPlaceholder.Width, ThumbnailPlaceholder.Height));
Draw(round(ThumbnailSize / 2 - pi_width / 2), round(ThumbnailSize / 2 - pi_height / 2), placeholderIcon);
end;
placeholderIcon.Free;
end;
function MiddleColor(const clOne, clTwo: TColor): TColor; // AV
begin
Result := (((clOne and $ff) + (clTwo and $ff)) shr 1 ) +
((((clOne shr 8) and $ff) + ((clTwo shr 8) and $ff)) shr 1 ) shl 8 +
((((clOne shr 16) and $ff) + ((clTwo shr 16) and $ff)) shr 1 ) shl 16;
end;
{ IFS }
function det(a, b, c, d: double): double;
begin
Result := (a * d - b * c);
end;
function Round6(x: double): double;
// Really ugly, but it works
begin
// --Z-- this is ridiculous:
// Result := StrToFloat(Format('%.6f', [x]));
// and yes, this is REALLY ugly :-\
Result := RoundTo(x, -6);
end;
procedure MultMatrix(var s: TMatrix2; const m: TMatrix2); // AV: moved from Main
var
a, b, c, d, e, f, g, h: double;
begin
a := s[0, 0];
b := s[0, 1];
c := s[1, 0];
d := s[1, 1];
e := m[0, 0];
f := m[0, 1];
g := m[1, 0];
h := m[1, 1];
{
[a, b][e ,f] [a*e+b*g, a*f+b*h]
[ ][ ] = [ ]
[c, d][g, h] [c*e+d*g, c*f+d*h]
}
s[0, 0] := a * e + b * g;
s[0, 1] := a * f + b * h;
s[1, 0] := c * e + d * g;
s[1, 1] := c * f + d * h;
end;
function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double;
var a, b, e: double): double;
var
det1: double;
begin
det1 := x1 * det(y2, 1.0, z2, 1.0) - x2 * det(y1, 1.0, z1, 1.0)
+ 1 * det(y1, y2, z1, z2);
if (det1 = 0.0) then
begin
Result := det1;
EXIT;
end
else
begin
a := (x1h * det(y2, 1.0, z2, 1.0) - x2 * det(y1h, 1.0, z1h, 1.0)
+ 1 * det(y1h, y2, z1h, z2)) / det1;
b := (x1 * det(y1h, 1.0, z1h, 1.0) - x1h * det(y1, 1.0, z1, 1.0)
+ 1 * det(y1, y1h, z1, z1h)) / det1;
e := (x1 * det(y2, y1h, z2, z1h) - x2 * det(y1, y1h, z1, z1h)
+ x1h * det(y1, y2, z1, z2)) / det1;
a := Round6(a);
b := Round6(b);
e := Round6(e);
Result := det1;
end;
end;
function dist(x1, y1, x2, y2: double): double;
//var
// d2: double;
begin
(*
{ From FDesign source
{ float pt_pt_distance(float x1, float y1, float x2, float y2) }
d2 := (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2);
if (d2 = 0.0) then
begin
Result := 0.0;
exit;
end
else
Result := sqrt(d2);
*)
// --Z-- This is just amazing... :-\
// Someone needed an 'FDesign source' - to compute distance between two points??!?
Result := Hypot(x2-x1, y2-y1);
end;
function line_dist(x, y, x1, y1, x2, y2: double): double;
var
a, b, e, c: double;
begin
if ((x = x1) and (y = y1)) then
a := 0.0
else
a := sqrt((x - x1) * (x - x1) + (y - y1) * (y - y1));
if ((x = x2) and (y = y2)) then
b := 0.0
else
b := sqrt((x - x2) * (x - x2) + (y - y2) * (y - y2));
if ((x1 = x2) and (y1 = y2)) then
e := 0.0
else
e := sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2));
if ((a * a + e * e) < (b * b)) then
Result := a
else if ((b * b + e * e) < (a * a)) then
Result := b
else if (e <> 0.0) then
begin
c := (b * b - a * a - e * e) / (-2 * e);
if ((a * a - c * c) < 0.0) then
Result := 0.0
else
Result := sqrt(a * a - c * c);
end
else
Result := a;
end;
function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean;
var
ra, rb, rc, a, b, c: double;
begin
Result := True;
ra := dist(Triangles[-1].y[0], Triangles[-1].x[0],
Triangles[-1].y[1], Triangles[-1].x[1]);
rb := dist(Triangles[-1].y[1], Triangles[-1].x[1],
Triangles[-1].y[2], Triangles[-1].x[2]);
rc := dist(Triangles[-1].y[2], Triangles[-1].x[2],
Triangles[-1].y[0], Triangles[-1].x[0]);
a := dist(t.y[0], t.x[0], t.y[1], t.x[1]);
b := dist(t.y[1], t.x[1], t.y[2], t.x[2]);
c := dist(t.y[2], t.x[2], t.y[0], t.x[0]);
if (a > ra) then
Result := False
else if (b > rb) then
Result := False
else if (c > rc) then
Result := False
else if ((a = ra) and (b = rb) and (c = rc)) then
Result := False;
end;
function triangle_area(t: TTriangle): double;
var
base, height: double;
begin
try
base := dist(t.x[0], t.y[0], t.x[1], t.y[1]);
height := line_dist(t.x[2], t.y[2], t.x[1], t.y[1],
t.x[0], t.y[0]);
if (base < 1.0) then
Result := height
else if (height < 1.0) then
Result := base
else
Result := 0.5 * base * height;
except on E: EMathError do
Result := 0;
end;
end;
{ Parse }
function GetVal(token: string): string;
var
p: integer;
begin
p := Pos('=', token);
Delete(Token, 1, p);
Result := Token;
end;
function ReplaceTabs(str: string): string;
{Changes tab characters in a string to spaces}
var
i: integer;
begin
for i := 1 to Length(str) do
begin
if str[i] = #9 then
begin
Delete(str, i, 1);
Insert(#32, str, i);
end;
end;
Result := str;
end;
(*
{ Palette and gradient functions }
function RGBToColor(Pal: TMapPalette; index: integer): Tcolor;
begin
{ Converts the RGB values from a palette index to the TColor type ...
could maybe change it to SHLs }
Result := (Pal.Blue[index] * 65536) + (Pal.Green[index] * 256)
+ Pal.Red[index];
end;
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
var
maxval, minval: double;
del: double;
begin
Maxval := Max(rgb[0], Max(rgb[1], rgb[2]));
Minval := Min(rgb[0], Min(rgb[1], rgb[2]));
hsv[2] := maxval; // v
if (Maxval > 0) and (maxval <> minval) then begin
del := maxval - minval;
hsv[1] := del / Maxval; //s
hsv[0] := 0;
if (rgb[0] > rgb[1]) and (rgb[0] > rgb[2]) then begin
hsv[0] := (rgb[1] - rgb[2]) / del;
end else if (rgb[1] > rgb[2]) then begin
hsv[0] := 2 + (rgb[2] - rgb[0]) / del;
end else begin
hsv[0] := 4 + (rgb[0] - rgb[1]) / del;
end;
if hsv[0] < 0 then
hsv[0] := hsv[0] + 6;
end else begin
hsv[0] := 0;
hsv[1] := 0;
end;
end;
procedure hsv2rgb(const hsv: array of double; out rgb: array of double);
var
j: integer;
f, p, q, t, v: double;
begin
j := floor(hsv[0]);
f := hsv[0] - j;
v := hsv[2];
p := hsv[2] * (1 - hsv[1]);
q := hsv[2] * (1 - hsv[1] * f);
t := hsv[2] * (1 - hsv[1] * (1 - f));
case j of
0: begin rgb[0] := v; rgb[1] := t; rgb[2] := p; end;
1: begin rgb[0] := q; rgb[1] := v; rgb[2] := p; end;
2: begin rgb[0] := p; rgb[1] := v; rgb[2] := t; end;
3: begin rgb[0] := p; rgb[1] := q; rgb[2] := v; end;
4: begin rgb[0] := t; rgb[1] := p; rgb[2] := v; end;
5: begin rgb[0] := v; rgb[1] := p; rgb[2] := t; end;
end;
end;
function GetGradient(FileName, Entry: string): string;
var
FileStrings: TStringList;
GradStrings: TStringList;
i: integer;
begin
FileStrings := TStringList.Create;
GradStrings := TStringList.Create;
try
try
FileStrings.LoadFromFile(FileName);
for i := 0 to FileStrings.count - 1 do
if Pos(Entry + ' ', Trim(FileStrings[i])) = 1 then break;
GradStrings.Add(FileStrings[i]);
repeat
inc(i);
GradStrings.Add(FileStrings[i]);
until Pos('}', FileStrings[i]) <> 0;
GetGradient := GradStrings.Text;
except on exception do
Result := '';
end;
finally
GradStrings.Free;
FileStrings.Free;
end;
end;
*)
function CheckX64: Boolean; // AV
var
IsWow64Process:
function(hProcess: THandle; out Wow64Process: boolean): boolean; stdcall;
Wow64Process: boolean;
begin
IsWow64Process := GetProcAddress(GetModuleHandle('kernel32.dll'), 'IsWow64Process');
Wow64Process := False;
if Assigned(IsWow64Process) then
Wow64Process := IsWow64Process(GetCurrentProcess, Wow64Process) and Wow64Process;
Result := Wow64Process;
end;
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
begin
while Pos(SearchStr, Str) <> 0 do
begin
Insert(ReplaceStr, Str, Pos(SearchStr, Str));
system.Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
end;
Result := Str;
end;
function SplitFilter(const fText: String; const fSep: Char; fTrim: Boolean=false; fQuotes: Boolean=false): TStringList;
var vI: Integer;
vBuffer: String;
vOn: Boolean;
begin
Result:= TStringList.Create;
vBuffer:='';
vOn:=true;
for vI:=1 to Length(fText) do
begin
if (fQuotes and(fText[vI]=fSep)and vOn)or(Not(fQuotes) and (fText[vI]=fSep)) then
begin
if fTrim then vBuffer:=Trim(vBuffer);
if vBuffer='' then vBuffer:=fSep; // !!! e.g. split(',**',',')...
if vBuffer[1]=fSep then
vBuffer:=Copy(vBuffer,2,Length(vBuffer));
Result.Add(vBuffer);
vBuffer:='';
end;
if fQuotes then
begin
if fText[vI]='"' then
begin
vOn:=Not(vOn);
Continue;
end;
if (fText[vI]<>fSep)or((fText[vI]=fSep)and(vOn=false)) then
vBuffer:=vBuffer+fText[vI];
end else
if fText[vI]<>fSep then
vBuffer:=vBuffer+fText[vI];
end;
if vBuffer<>'' then
begin
if fTrim then vBuffer:=Trim(vBuffer);
Result.Add(vBuffer);
end;
end;
function OpenSaveFileDialog(Parent: TWinControl;
const DefExt,
Filter,
InitialDir,
Title: string;
var FileName: string;
MustExist,
OverwritePrompt,
NoChangeDir,
DoOpen: Boolean): Boolean;
// uses commdlg
var
ofn: TOpenFileName;
szFile: array[0..260] of Char;
fa, fa2: TStringList;
h,i,j,k,c : integer;
cs, s : string;
begin
Result := False;
FillChar(ofn, SizeOf(TOpenFileName), 0);
with ofn do
begin
lStructSize := SizeOf(TOpenFileName);
hwndOwner := Parent.Handle;
lpstrFile := szFile;
nMaxFile := SizeOf(szFile);
if (Title <> '') then
lpstrTitle := PChar(Title);
if (InitialDir <> '') then
lpstrInitialDir := PChar(InitialDir);
StrPCopy(lpstrFile, FileName);
lpstrFilter := PChar(ReplaceStr(Filter, '|', #0)+#0#0);
fa := splitFilter(Filter, '|');
k := 0;
c := (fa.Count div 2);
for i := 0 to c - 1 do begin
j := 2 * i + 1;
cs := LowerCase(fa.Strings[j]);
fa2 := splitFilter(cs, ';');
for h := 0 to fa2.Count - 1 do begin
cs := fa2.Strings[h];
s := '*.' + LowerCase(DefExt);
if (cs = s) then k := i;
end;
fa2.Free; //AV: fixed multiple memory leaks!
end;
fa.Free; // AV: fixed memory leak!
nFilterIndex := k + 1;
if DefExt <> '' then
lpstrDefExt := PChar(DefExt);
end;
if MustExist then ofn.Flags := ofn.Flags or OFN_FILEMUSTEXIST;
if OverwritePrompt then ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT;
if NoChangeDir then ofn.Flags := ofn.Flags or OFN_NOCHANGEDIR;
if DoOpen then
begin
if GetOpenFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end
else
begin
if GetSaveFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end
end; // function OpenSaveFileDialog
end.
Core/Translation.pas
+1127
View File
File diff suppressed because it is too large Load Diff
Core/XFormMan.pas
+356
View File
@@ -0,0 +1,356 @@
{
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 XFormMan;
interface
uses
BaseVariation, SysUtils, Forms, Windows;
const
NRLOCVAR = 36;
var
NumBuiltinVars: integer;
type
TFNToVN = record
FileName: string;
VarName: string;
end;
function NrVar: integer;
function Varnames(const index: integer): String;
procedure RegisterVariation(Variation: TVariationLoader; supports3D, supportsDC : boolean);
function GetNrRegisteredVariations: integer;
function GetRegisteredVariation(const Index: integer): TVariationLoader;
function GetNrVariableNames: integer;
function GetVariableNameAt(const Index: integer): string;
function GetVariationIndex(const str: string): integer;
function GetVariationIndexFromVariableNameIndex(const Index: integer): integer;
procedure VarSupports(index : integer; var supports3D : boolean; var supportsDC : boolean);
procedure InitializeXFormMan;
procedure DestroyXFormMan;
procedure RegisterVariationFile(filename, name: string);
function GetFileNameOfVariation(name: string): string;
implementation
uses
Classes;
var
VariationList: TList;
VariableNames: TStringlist;
loaderNum : integer;
Variable2VariationIndex : array of integer;
FNToVNList : array of TFNToVN;
FNToVNCount: integer;
procedure InitializeXFormMan;
begin
VariationList := TList.Create;
VariableNames := TStringlist.create;
SetLength(Variable2VariationIndex,0);
SetLength(FNToVNList, 0);
FNToVNCount := 0;
end;
procedure VarSupports(index : integer; var supports3D : boolean; var supportsDC : boolean);
const
supports3D_arr: array[0..NRLOCVAR-1] of boolean = (
true, //'linear',
true, //'flatten',
true, //'pre_blur3D',
true, //'spherical',
true, //'swirl',
true, //'horseshoe',
true, //'polar',
true, //'disc',
true, //'spiral',
true, //'hyperbolic',
true, //'diamond',
true, //'eyefish',
true, //'bubble',
true, //'cylinder',
true, //'noise',
true, //'blur',
false, //'gaussian_blur',
true, //'zblur',
true, //'blur3D',
false, //'pre_blur',
true, //'pre_zscale',
true, //'pre_ztranslate',
true, //'pre_rotate_x',
true, //'pre_rotate_y',
true, //'zscale',
true, //'ztranslate',
true, //'zcone',
true, //'post_rotate_x',
true, //'post_rotate_y',
false, //'post_mirror_x',
false, //'post_mirror_y',
true, //'post_mirror_z',
true, //'hemisphere',
true, //'cross',
true, //'pyramid'
true // polar2
);
supportsDC_arr: array[0..NRLOCVAR-1] of boolean = (
false, //'linear',
false, //'flatten',
false, //'pre_blur3D',
false, //'spherical',
false, //'swirl',
false, //'horseshoe',
false, //'polar',
false, //'disc',
false, //'spiral',
false, //'hyperbolic',
false, //'diamond',
false, //'eyefish',
false, //'bubble',
false, //'cylinder',
false, //'noise',
false, //'blur',
false, //'gaussian_blur',
false, //'zblur',
false, //'blur3D',
false, //'pre_blur',
false, //'pre_zscale',
false, //'pre_ztranslate',
false, //'pre_rotate_x',
false, //'pre_rotate_y',
false, //'zscale',
false, //'ztranslate',
false, //'zcone',
false, //'post_rotate_x',
false, //'post_rotate_y'
false, //'post_mirror_x',
false, //'post_mirror_y',
false, //'post_mirror_z',
false, //'hemisphere',
false, //'cross',
false, //'pyramid'
false // polar2
);
var
varl : TVariationLoader;
begin
if (index >= NRLOCVAR) then begin
supports3D := TVariationLoader(VariationList.Items[index - NRLOCVAR]).supports3D;
supportsDC := TVariationLoader(VariationList.Items[index - NRLOCVAR]).supportsDC;
end else begin
supports3D := supports3D_arr[index];
supportsDC := supportsDC_arr[index];
end;
end;
procedure DestroyXFormMan;
var i: integer;
begin
VariableNames.Free;
// The registered variation loaders are owned here, so we must free them.
for i := 0 to VariationList.Count-1 do
TVariationLoader(VariationList[i]).Free;
VariationList.Free;
Finalize(Variable2VariationIndex);
Finalize(FNToVNList);
end;
///////////////////////////////////////////////////////////////////////////////
function NrVar: integer;
begin
Result := NRLOCVAR + VariationList.Count;
end;
///////////////////////////////////////////////////////////////////////////////
function GetVariationIndexFromVariableNameIndex(const Index: integer): integer;
begin
if (Index < 0) or (Index > High(Variable2VariationIndex)) then
Result := -1
else
Result := Variable2VariationIndex[Index];
end;
function Varnames(const index: integer): String;
const
cvarnames: array[0..NRLOCVAR-1] of string = (
'linear',
'flatten',
'pre_blur3D',
'spherical',
'swirl',
'horseshoe',
'polar',
// 'handkerchief',
// 'heart',
'disc',
'spiral',
'hyperbolic',
'diamond',
// 'ex',
// 'julia',
// 'bent',
// 'waves',
// 'fisheye',
// 'popcorn',
// 'exponential',
// 'power',
// 'cosine',
// 'rings',
// 'fan',
'eyefish',
'bubble',
'cylinder',
'noise',
'blur',
'gaussian_blur',
'zblur',
'blur3D',
'pre_blur',
'pre_zscale',
'pre_ztranslate',
'pre_rotate_x',
'pre_rotate_y',
'zscale',
'ztranslate',
'zcone',
'post_rotate_x',
'post_rotate_y',
'post_mirror_x',
'post_mirror_y',
'post_mirror_z',
'hemisphere',
'cross',
'pyramid',
'polar2'
);
begin
if Index < NRLOCVAR then
Result := cvarnames[Index]
else
Result := TVariationLoader(VariationList[Index - NRLOCVAR]).GetName;
end;
///////////////////////////////////////////////////////////////////////////////
function GetVariationIndex(const str: string): integer;
var
i: integer;
begin
i := NRVAR-1;
while (i >= 0) and (Varnames(i) <> str) do Dec(i);
Result := i;
end;
///////////////////////////////////////////////////////////////////////////////
procedure RegisterVariationFile(filename, name: string);
begin
FNToVNCount := FNToVNCount + 1;
SetLength(FNToVNList, FNToVNCount);
FNToVNList[FNToVNCount - 1].FileName := filename;
FNToVNList[FNToVNCount - 1].VarName := name;
end;
function GetFileNameOfVariation(name: string): string;
var i: integer;
begin
for i := 0 to FNToVNCount - 1 do begin
if FNToVNList[i].VarName = name then begin
Result := FNToVNList[i].FileName;
Exit;
end;
end;
Result := '';
end;
procedure RegisterVariation(Variation: TVariationLoader; supports3D, supportsDC : boolean);
var
i: integer;
prevNumVariables:integer;
begin
OutputDebugString(PChar(Variation.GetName));
VariationList.Add(Variation);
Variation.Supports3D := supports3D;
Variation.SupportsDC := supportsDC;
prevNumVariables := GetNrVariableNames;
setLength(Variable2VariationIndex, prevNumVariables + Variation.GetNrVariables);
for i := 0 to Variation.GetNrVariables - 1 do begin
VariableNames.Add(Variation.GetVariableNameAt(i));
Variable2VariationIndex[prevNumVariables + i] := NrVar-1;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function GetNrRegisteredVariations: integer;
begin
Result := VariationList.count;
end;
///////////////////////////////////////////////////////////////////////////////
function GetRegisteredVariation(const Index: integer): TVariationLoader;
begin
Result := TVariationLoader(VariationList[Index]);
end;
///////////////////////////////////////////////////////////////////////////////
function GetNrVariableNames: integer;
begin
Result := VariableNames.Count;
end;
///////////////////////////////////////////////////////////////////////////////
function GetVariableNameAt(const Index: integer): string;
begin
Result := VariableNames[Index];
end;
///////////////////////////////////////////////////////////////////////////////
initialization
InitializeXFormMan;
finalization
DestroyXFormMan;
end.
Flame/ControlPoint.pas
+3158
View File
File diff suppressed because it is too large Load Diff
Flame/RndFlame.pas
+638
View File
@@ -0,0 +1,638 @@
{
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 RndFlame;
interface
uses
ControlPoint, Xform;
function RandomFlame(SourceCP: TControlPoint= nil; algorithm: integer = 0): TControlPoint;
implementation
uses
SysUtils, Global, cmap, GradientHlpr, XFormMan, Classes;
///////////////////////////////////////////////////////////////////////////////
// AV: this procedure repeated in the source code 3 times!
(* procedure RGBBlend(a, b: integer; var Palette: TColorMap);
{ Linear blend between to indices of a palette }
var
c, v: real;
vrange, range: real;
i: integer;
begin
if a = b then
begin
Exit;
end;
range := b - a;
vrange := Palette[b mod 256][0] - Palette[a mod 256][0];
c := Palette[a mod 256][0];
v := vrange / range;
for i := (a + 1) to (b - 1) do
begin
c := c + v;
Palette[i mod 256][0] := Round(c);
end;
vrange := Palette[b mod 256][1] - Palette[a mod 256][1];
c := Palette[a mod 256][1];
v := vrange / range;
for i := a + 1 to b - 1 do
begin
c := c + v;
Palette[i mod 256][1] := Round(c);
end;
vrange := Palette[b mod 256][2] - Palette[a mod 256][2];
c := Palette[a mod 256][2];
v := vrange / range;
for i := a + 1 to b - 1 do
begin
c := c + v;
Palette[i mod 256][2] := Round(c);
end;
end; *)
function CreatePalette(strng: string): TColorMap;
{ Loads a palette from a gradient string }
var
Strings: TStringList;
index, i: integer;
Tokens: TStringList;
Indices, Colors: TStringList;
a, b: integer;
begin
Strings := TStringList.Create;
Tokens := TStringList.Create;
Indices := TStringList.Create;
Colors := TStringList.Create;
try
try
Strings.Text := strng;
if Pos('}', Strings.Text) = 0 then raise EFormatInvalid.Create('No closing brace');
if Pos('{', Strings[0]) = 0 then raise EFormatInvalid.Create('No opening brace.');
GetTokens(ReplaceTabs(strings.text), tokens);
Tokens.Text := Trim(Tokens.text);
i := 0;
while (Pos('}', Tokens[i]) = 0) and (Pos('opacity:', Lowercase(Tokens[i])) = 0) do
begin
if Pos('index=', LowerCase(Tokens[i])) <> 0 then
Indices.Add(GetVal(Tokens[i]))
else if Pos('color=', LowerCase(Tokens[i])) <> 0 then
Colors.Add(GetVal(Tokens[i]));
inc(i)
end;
for i := 0 to 255 do
begin
Result[i][0] := 0;
Result[i][1] := 0;
Result[i][2] := 0;
end;
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
Result[index][0] := StrToInt(Colors[i]) mod 256;
Result[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
Result[index][2] := trunc(StrToInt(Colors[i]) / 65536);
except
end;
end;
i := 1;
repeat
a := StrToInt(Trim(Indices[i - 1]));
b := StrToInt(Trim(Indices[i]));
RGBBlend(a, b, Result);
inc(i);
until i = Indices.Count;
if (Indices[0] <> '0') or (Indices[Indices.Count - 1] <> '255') then
begin
a := StrToInt(Trim(Indices[Indices.Count - 1]));
b := StrToInt(Trim(Indices[0])) + 256;
RGBBlend(a, b, Result);
end;
except on EFormatInvalid do
begin
// Result := False;
end;
end;
finally
Tokens.Free;
Strings.Free;
Indices.Free;
Colors.Free;
end;
end;
procedure GetGradientFileGradientsNames(const filename: string; var NamesList: TStringList);
var
i, p: integer;
Title: string;
FStrings: TStringList;
begin
FStrings := TStringList.Create;
FStrings.LoadFromFile(filename);
try
if (Pos('{', FStrings.Text) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('{', FStrings[i]);
if (p <> 0) and (Pos('(3D)', FStrings[i]) = 0) then
begin
Title := Trim(Copy(FStrings[i], 1, p - 1));
if Title <> '' then
NamesList.Add(Trim(Copy(FStrings[i], 1, p - 1)));
end;
end;
end;
finally
FStrings.Free;
end;
end;
procedure RandomGradient(SourceCP, DestCP: TControlPoint);
var
tmpGrad: string;
tmpGrdList: TStringList;
begin
case randGradient of
0:
begin
cmap_index := Random(NRCMAPS);
GetCMap(cmap_index, 1, DestCP.cmap);
// cmap_index := DestCP.cmapindex;
DestCP.cmapIndex := cmap_index;
end;
1:
begin
DestCP.cmap := DefaultPalette;
DestCP.cmapIndex := cmap_index;
end;
2:
if assigned(SourceCP) then begin
DestCP.cmap := SourceCP.cmap;
DestCP.cmapIndex := SourceCP.cmapIndex;
end else begin
cmap_index := Random(NRCMAPS);
GetCMap(cmap_index, 1, DestCP.cmap);
DestCP.cmapIndex := cmap_index;
end;
3:
DestCP.cmap := GradientHelper.RandomGradient;
4:
if FileExists(randGradientFile) then
begin
tmpGrdList := TStringList.Create;
GetGradientFileGradientsNames(randGradientFile, tmpGrdList);
tmpGrad := GetGradient(randGradientFile, tmpGrdList.Strings[random(tmpGrdList.Count)]);
DestCP.cmap := CreatePalette(tmpGrad);
tmpGrdList.Free;
end else
begin
cmap_index := Random(NRCMAPS);
GetCMap(cmap_index, 1, DestCP.cmap);
DestCP.cmapIndex := cmap_index;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure RandomVariation(cp: TControlPoint);
{ Randomise variation parameters }
var
a, b, i, j: integer;
VarPossible: boolean;
begin
inc(MainSeed);
RandSeed := MainSeed;
VarPossible := false;
for j := 0 to NRVAR - 1 do begin
VarPossible := VarPossible or Variations[j];
end;
for i := 0 to cp.NumXForms - 1 do begin
for j := 0 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0);
if VarPossible then begin
repeat
a := random(NRVAR);
until Variations[a];
repeat
b := random(NRVAR);
until Variations[b];
end else begin
a := 0;
b := 0;
end;
if (a = b) then begin
cp.xform[i].SetVariation(a, 1);
end else begin
cp.xform[i].SetVariation(a, random);
cp.xform[i].SetVariation(b, 1 - cp.xform[i].GetVariation(a));
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure SetVariation(cp: TControlPoint);
{ Set the current Variation }
var
i, j: integer;
begin
if Variation = vRandom then begin
RandomVariation(cp);
end else
for i := 0 to cp.NumXForms - 1 do begin
for j := 0 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0);
cp.xform[i].SetVariation(integer(Variation), 1);
end;
end;
///////////////////////////////////////////////////////////////////////////////
(* --Z-- hmm, exactly the same function exists in module Main
function TrianglesFromCP(const cp1: TControlPoint; var Triangles: TTriangles): integer;
{ Sets up the triangles from the IFS code }
var
xforms: integer;
i, j: integer;
temp_x, temp_y, xset, yset: double;
left, top, bottom, right: double;
a, b, c, d, e, f: double;
begin
top := 0; bottom := 0; right := 0; left := 0;
xforms := NumXForms(cp1);
Result := xforms;
if not FixedReference then
begin
for i := 0 to xforms - 1 do
begin
a := cp1.xform[i].c[0][0];
b := cp1.xform[i].c[0][1];
c := cp1.xform[i].c[1][0];
d := cp1.xform[i].c[1][1];
e := cp1.xform[i].c[2][0];
f := cp1.xform[i].c[2][1];
xset := 1.0;
yset := 1.0;
for j := 0 to 5 do
begin
temp_x := xset * a + yset * c + e;
temp_y := xset * b + yset * d + f;
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;
Triangles[-1].x[0] := left;
Triangles[-1].x[1] := right;
Triangles[-1].x[2] := right;
Triangles[-1].y[0] := bottom;
Triangles[-1].y[1] := bottom;
Triangles[-1].y[2] := top;
end
else
begin
Triangles[-1].x[0] := 0; Triangles[-1].y[0] := 0;
Triangles[-1].x[1] := 1; Triangles[-1].y[1] := 0;
Triangles[-1].x[2] := 1; Triangles[-1].y[2] := 1.5;
end;
for j := 0 to xforms - 1 do
begin
a := cp1.xform[j].c[0][0];
b := cp1.xform[j].c[0][1];
c := cp1.xform[j].c[1][0];
d := cp1.xform[j].c[1][1];
e := cp1.xform[j].c[2][0];
f := cp1.xform[j].c[2][1];
for i := 0 to 2 do
begin
triangles[j].x[i] := Triangles[-1].x[i] * a + Triangles[-1].y[i] *
c + e;
triangles[j].y[i] := Triangles[-1].x[i] * b + Triangles[-1].y[i] *
d + f;
end;
end;
for i := -1 to xforms - 1 do
for j := 0 to 2 do
triangles[i].y[j] := -triangles[i].y[j];
end;
*)
///////////////////////////////////////////////////////////////////////////////
procedure EqualizeWeights(var cp: TControlPoint);
var
t, i: integer;
begin
t := cp.NumXForms;
for i := 0 to t - 1 do
cp.xform[i].density := 1.0 / t;
end;
///////////////////////////////////////////////////////////////////////////////
procedure NormalizeWeights(var cp: TControlPoint);
var
i: integer;
td: double;
begin
td := 0.0;
for i := 0 to cp.NumXForms - 1 do
td := td + cp.xform[i].Density;
if (td < 0.001) then
EqualizeWeights(cp)
else
for i := 0 to cp.NumXForms - 1 do
cp.xform[i].Density := cp.xform[i].Density / td;
end;
///////////////////////////////////////////////////////////////////////////////
procedure ComputeWeights(var cp1: TControlPoint; Triangles: TTriangles; t: integer);
{ Caclulates transform weight from triangles }
var
i: integer;
total_area: double;
begin
total_area := 0.0;
for i := 0 to t - 1 do
begin
cp1.xform[i].Density := triangle_area(Triangles[i]);
total_area := total_area + cp1.xform[i].Density;
end;
for i := 0 to t - 1 do
begin
cp1.xform[i].Density := cp1.xform[i].Density / total_area;
end;
NormalizeWeights(cp1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure RandomWeights(var cp1: TControlPoint);
{ Randomizes xform weights }
var
i: integer;
begin
for i := 0 to Transforms - 1 do
cp1.xform[i].Density := random;
NormalizeWeights(cp1);
end;
///////////////////////////////////////////////////////////////////////////////
function RandomFlame(SourceCP: TControlPoint; algorithm: integer): TControlPoint;
var
Min, Max, i, j, rnd: integer;
Triangles: TTriangles;
r, s, theta, phi: double;
cosphi, sintheta, costheta: double;
skip: boolean;
begin
if Assigned(SourceCP) then
Result := SourceCP.clone
else
Result := TControlPoint.Create;
Min := randMinTransforms;
Max := randMaxTransforms;
inc(MainSeed);
RandSeed := MainSeed;
transforms := random(Max - (Min - 1)) + Min;
repeat
try
inc(MainSeed);
RandSeed := MainSeed;
Result.clear;
Result.RandomCP(transforms, transforms, false);
Result.SetVariation(Variation);
inc(MainSeed);
RandSeed := MainSeed;
case algorithm of
1: rnd := 0;
2: rnd := 7;
3: rnd := 9;
else
if (Variation = vLinear) or (Variation = vRandom) then
rnd := random(10)
else
rnd := 9;
end;
case rnd of
0..6:
begin
for i := 0 to Transforms - 1 do
begin
// AV: useless assignments
{if Random(10) < 9 then
Result.xform[i].c[0, 0] := 1
else
Result.xform[i].c[0, 0] := -1;
Result.xform[i].c[0, 1] := 0;
Result.xform[i].c[1, 0] := 0;
Result.xform[i].c[1, 1] := 1;
Result.xform[i].c[2, 0] := 0;
Result.xform[i].c[2, 1] := 0;
Result.xform[i].color := 0; }
Result.xform[i].symmetry := 0;
Result.xform[i].SetVariation(0, 1);
for j := 1 to NRVAR - 1 do
Result.xform[i].SetVariation(j, 0);
// AV: hundred of useless calculations
{Result.xform[i].Translate(random * 2 - 1, random * 2 - 1);
Result.xform[i].Rotate(random * 360);
if i > 0 then
Result.xform[i].Scale(random * 0.8 + 0.2)
else
Result.xform[i].Scale(random * 0.4 + 0.6); }
if i > 0 then
s := random * 0.8 + 0.2
else
s := random * 0.4 + 0.6;
theta := random * 2 * pi;
sintheta := s * sin(theta);
costheta := s * cos(theta);
if Random(10) < 9 then
begin
Result.xform[i].c[0, 0] := costheta;
Result.xform[i].c[1, 0] := sintheta;
end
else begin
Result.xform[i].c[0, 0] := -costheta;
Result.xform[i].c[1, 0] := -sintheta;
end;
Result.xform[i].c[0, 1] := -sintheta;
Result.xform[i].c[1, 1] := costheta;
Result.xform[i].c[2, 0] := random * 2 - 1;
Result.xform[i].c[2, 1] := random * 2 - 1;
if Random(2) = 0 then
Result.xform[i].Multiply(1, random - 0.5, random - 0.5, 1);
if Random(2) = 1 then
begin
// AV: added post-transforms support!
theta := 2 * random * pi;
r := 0.3 + random * 0.7;
sintheta := r * sin(theta);
costheta := r * cos(theta);
Result.xform[i].p[0, 0] := costheta;
Result.xform[i].p[0, 1] := sintheta;
Result.xform[i].p[1, 0] := -sintheta;
Result.xform[i].p[1, 1] := costheta;
Result.xform[i].p[2,0] := random * 2 - 1;
Result.xform[i].p[2,1] := random * 2 - 1;
end;
end;
SetVariation(Result);
end;
7, 8:
begin
{ From the source to Chaos: The Software }
for i := 0 to Transforms - 1 do begin
r := random * 2 - 1;
if ((0 <= r) and (r < 0.2)) then
r := r + 0.2;
if ((r > -0.2) and (r <= 0)) then
r := r - 0.2;
s := random * 2 - 1;
if ((0 <= s) and (s < 0.2)) then
s := s + 0.2;
if ((s > -0.2) and (s <= 0)) then
s := s - -0.2;
theta := PI * random;
phi := (2 + random) * PI / 4;
// AV: we don't need to calculate everything twice!
sintheta := sin(theta);
costheta := cos(theta);
cosphi := cos(phi);
Result.xform[i].c[0][0] := r * costheta;
Result.xform[i].c[1][0] := s * (costheta * cosphi - sintheta);
Result.xform[i].c[0][1] := r * sintheta;
Result.xform[i].c[1][1] := s * (sintheta * cosphi + costheta);
{ the next bit didn't translate so well, so I fudge it}
Result.xform[i].c[2][0] := random * 2 - 1;
Result.xform[i].c[2][1] := random * 2 - 1;
end;
for i := 0 to NXFORMS-1 do
Result.xform[i].density := 0;
for i := 0 to Transforms - 1 do
Result.xform[i].density := 1 / Transforms;
SetVariation(Result);
end;
9: begin
for i := 0 to NXFORMS-1 do
Result.xform[i].density := 0;
for i := 0 to Transforms - 1 do
Result.xform[i].density := 1 / Transforms;
end;
end; // case
Result.TrianglesFromCp(Triangles);
if Random(2) > 0 then
ComputeWeights(Result, Triangles, transforms)
else
EqualizeWeights(Result);
except on E: EmathError do
begin
Continue;
end;
end;
for i := 0 to Transforms - 1 do
Result.xform[i].color := i / (transforms - 1);
if Result.xform[0].density = 1 then
Continue;
case SymmetryType of
{ Bilateral }
1: add_symmetry_to_control_point(Result, -1);
{ Rotational }
2: add_symmetry_to_control_point(Result, SymmetryOrder);
{ Rotational and Reflective }
3: add_symmetry_to_control_point(Result, -SymmetryOrder);
end;
{ elimate flames with transforms that aren't affine }
skip := false;
for i := 0 to Transforms - 1 do begin
if not transform_affine(Triangles[i], Triangles) then
skip := True;
end;
if skip then
continue;
until not Result.BlowsUP(5000) and (Result.xform[0].density <> 0);
RandomGradient(SourceCP, Result);
Result.brightness := defBrightness;
Result.gamma := defGamma;
Result.gamma_threshold := defGammaThreshold;
Result.vibrancy := defVibrancy;
Result.sample_density := defSampleDensity;
Result.spatial_oversample := defOversample;
Result.spatial_filter_radius := defFilterRadius;
Result.contrast := defContrast; // AV
if KeepBackground and assigned(SourceCP) then begin
Result.background[0] := SourceCP.background[0];
Result.background[1] := SourceCP.background[1];
Result.background[2] := SourceCP.background[2];
end else if (RandBackColor <> 0) then begin // AV: to set the user's predefined BG
Result.background[0] := RandBackColor and 255;
Result.background[1] := RandBackColor shr 8 and 255;
Result.background[2] := RandBackColor shr 16 and 255;
end else begin
Result.background[0] := 0;
Result.background[1] := 0;
Result.background[2] := 0;
end;
Result.zoom := 0;
//Result.Nick := SheepNick;
//Result.URl := SheepURL;
Result.xform[Result.NumXForms].Clear;
Result.xform[Result.NumXForms].symmetry := 1;
end;
end.
Flame/XForm.pas
+2084
View File
File diff suppressed because it is too large Load Diff
Forms/About.dfm
+5367
View File
File diff suppressed because it is too large Load Diff
Forms/About.pas
+163
View File
@@ -0,0 +1,163 @@
{
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 About;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Global, Translation;
type
TAboutForm = class(TForm)
btnOK: TButton;
Label3: TLabel;
Label4: TLabel;
Label10: TLabel;
Label11: TLabel;
lblFlamecom: TLabel;
Bevel1: TBevel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Bevel3: TBevel;
Label17: TLabel;
Label18: TLabel;
Label16: TLabel;
Label2: TLabel;
Bevel2: TBevel;
Label19: TLabel;
Label20: TLabel;
Image1: TImage;
Label5: TLabel;
Bevel4: TBevel;
Label1: TLabel;
Label15: TLabel;
Bevel5: TBevel;
Label21: TLabel;
lbApoTitle: TLabel;
lbApoVers: TLabel;
Label24: TLabel;
Bevel6: TBevel;
lblAuthor: TLabel;
Label26: TLabel;
Label27: TLabel;
Label28: TLabel;
Bevel7: TBevel;
Bevel8: TBevel;
lblPlugins: TLabel;
Bevel9: TBevel;
lblVersion: TLabel;
procedure btnOKClick(Sender: TObject);
procedure lblPluginsClick(Sender: TObject);
procedure DevelopersClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SetTitleColor;
end;
var
AboutForm: TAboutForm;
implementation
uses Main, ShellAPI;
{$R *.DFM}
procedure TAboutForm.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
end;
procedure TAboutForm.lblPluginsClick(Sender: TObject);
var URL : String;
begin
URL := lblPlugins.Hint;
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
URL := 'https://onedrive.live.com/?authkey=%21AEhvN24LOQKCzBY&cid=828A1C23C17CA4C9&id=828A1C23C17CA4C9%211037&parId=root&action=locate';
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.SetTitleColor;
var clr: TColor;
begin
if IsDarkTheme or (CurrentStyle = 'Cyan Night') or (CurrentStyle = 'Calypso SLE')
or (CurrentStyle = 'Obsidian') or (CurrentStyle = 'Metropolis UI Green') then
clr := BrightColor
else
clr := clMaroon;
lbApoTitle.Font.Color := clr;
lbApoVers.Font.Color := clr;
end;
procedure TAboutForm.DevelopersClick(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(TLabel(Sender).Hint),
nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.FormCreate(Sender: TObject);
var s1, s2, s3: string;
AVFont: TResourceStream;
begin
btnOK.Caption := TextByKey('common-close');
if (LanguageFile <> AvailableLanguages.Strings[0]) and (LanguageFile <> '') then
begin
LanguageInfo(LanguageFile, s1, s2);
s3 := LanguageAuthor(LanguageFile);
Label20.Visible := (s2 <> '') and (s3 <> '');
Label20.Caption := s2 + #32 + TextByKey('common-translation') + #32#32 + s3;
end;
lblPlugins.Caption := TextByKey('common-pluginlink');
Label3.Caption := TextByKey('common-thirdparty');
SetTitleColor;
if (pos(LowerCase(s1), 'russian') > 0) or (pos(LowerCase(s1), 'ðóññê') > 0) then
lblAuthor.Caption := 'Àëèñà Âèòàëüåâíà Êîðÿãèíà';
if Screen.Fonts.IndexOf('Harlow Solid Italic') = -1 then
begin // shouldn't happen on modern OS
AVFont := TResourceStream.Create(hInstance, 'HARLOWSI', RT_FONT);
try
s3 := GetEnvVarValue('WINDIR') + '\Fonts\Harlow Solid Italic.ttf';
AVFont.SavetoFile(s3);
except
s3 := AppPath + 'Harlow Solid Italic.ttf';
AVFont.SavetoFile(s3);
end;
AddFontResource(PChar(s3));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
AVFont.Free;
end;
end;
end.
Forms/Adjust.dfm
+2113
View File
File diff suppressed because it is too large Load Diff
Forms/Adjust.pas
+3526
View File
File diff suppressed because it is too large Load Diff
Forms/Browser.dfm
+374
View File
@@ -0,0 +1,374 @@
object GradientBrowser: TGradientBrowser
Left = 494
Top = 299
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'Gradient Browser'
ClientHeight = 297
ClientWidth = 528
Color = clBtnFace
Constraints.MinHeight = 120
Constraints.MinWidth = 380
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001001010000001002000680400001600000028000000100000002000
0000010020000000000040040000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000045C6F00100000000000000002DA5D654247EACE51F89B8FD1F7D
A8FC2385AFFA209DD2A01DA9DF53000000000000000000000000000000000000
00000000000000000000000000003AB6E247228CC1F143C2EAFF48C3E7FF4EC9
ECFF44C1E2F538A3C7FB1A7CABF9199BD1830000000000000000000000000000
000063D2F201000000000000000020B5E9FF34B0DBCE59D2F0FF5CD4F0FF5CD7
F2FF5AD6F2FD51CFECFB37AED7F4187BA9FD1A94C98F00000000000000000000
000070D8F302000000000000000022B3E7FE1C97C9E751CAE9FF5FD7F2FF0AB3
67FF006F00FF008825FF53D1EEFA2E9FCCEE187DACFE0B87BD020000000082DF
F4027CDCF40700000000000000006AD4F36C1181B2FD52CAE8FE62DAF3FF23D9
71FF00912BFF006000FF62D9F3FF49C3E5EF1280B0FE1B9BCE73000000000000
000089E2F42084DFF4421D99C2FD37A4C9FF46C2EBFF65D4F0FB66DAF3FE3EDB
8CFF00BA50FF00AB67FF63D9F3FF51CBEBF41E8BB9F81D95C8A7000000000000
000076DCF4693BB4DCF78BE2F4B59AE7F7E895E6F6FE95E8F6FE8CE3F5FF85E3
F4FF70DEF4FF68DCF4FF6ADBF4FF5CD4EFF4208BB9F72297C9AB000000000000
000054CBF3F98EE3F5CFB6F1F8FFB6F1F8FF9EEAF6FE93E9F6FF94E8F6FFB359
23FFB30F00FFAB2B00FF73DEF4FB63D7EFEE1D84B4F8279DCE94000000000000
000070D4F5FFA4EDF6E6B6F1F8FF2959F3FF00007AFF001FDBFF93E9F6FFB08C
64FFB03A00FF610000FF73DEF4F45CC3E3DE2781AEEF64D3F23E000000000000
000070D4F5FFACF0F7EBB6F1F8FF5490FFFF0022D9FF000058FFB2F0F8FFB4B6
97FFB38D64FFB6AB8CFF78D3ECE8359AC9EC51B6DB8F00000000000000000000
00007AD8F5F89EEAF6E6B6F1F8FF6DAFFFFF5590FFFF6DB0FFFFB6F1F8FFA5EC
F7FEA7ECF7FE98E7F5F14DB0D9F55DBBDDAB84DFF44000000000000000000000
0000A9EFF7786BD4F4FB9DEAF6EEAFF1F7F4B6F1F8FFB6F1F8FFB6F1F8FFA6EE
F6F9A0EAF6EF70D2EDE354C6EDF895E7F5580000000000000000000000000000
000000000000AAEFF78F5ACFF3F998E8F6E0B6F1F8FFB6F1F8FFB6F1F8FF92E7
F6E46CD4F4FA65D2F4E984D4E874000000000000000000000000000000000000
00000000000000000000A9EFF7737CD9F6F476D6F5FA72D4F5FD75D6F5FB5ECF
F4F190E6F5930000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000D80F0000F0070000B0030000B00100003001000080010000800100008001
000080010000800300008003000080070000C00F0000E03F0000FFFF0000}
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnResize = FormResize
OnShow = FormShow
DesignSize = (
528
297)
PixelsPerInch = 96
TextHeight = 13
object btnDefGradient: TSpeedButton
Left = 411
Top = 7
Width = 23
Height = 21
Hint = 'Open...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDefGradientClick
end
object btnRandom: TSpeedButton
Left = 464
Top = 263
Width = 23
Height = 21
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFF9F9F99E9E9EA3A7A69F9F9FC4C3C3EFEEEEFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA0A0A0C6C6C5EAFAF9D7
EAE8BEC7C59B9D9DAFAFAEDAD9DAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFA7A7A7B9B9B9E7E6E7E3F8F7B5C1BE838784D9E9E6C6D0CDA6ACAA9F9F
A0BBBBBBF5F5F5FFFFFFFFFFFFFFFFFFB0B0B0A8A8A8DEDDDDDCDCDCE3F9F7BA
C9C7403D3CC2D3D1EDFFFCCAD3CFC0C5C1B8BDBA959595FFFFFFFFFFFFBDBDBD
9A9A9AD5D5D5D4D5D5DDDDDDDBEFEEE1FDFBDFF3F2C2D1CECBD9D69B9B993932
31D5DDD9939594FFFFFFFFFFFF878787C7C7C7BEBDBDCCCACADDDDDDE1F7F6C7
DBDACBDDDCA2A7A6352F2EBFCDC99AA19DD0D9D5949594FFFFFFFFFFFF8C8D8D
CCCDCD544C4C9F9D9DE3E3E3E5FDFDA9B4B4332C2CBCCBCB9BA5A4CFE0DDECFE
FAE1EEE98F908FFFFFFFFFFFFF8A8A8AC3C3C38C8A8AC0C1C1E2E1E1F0FCFCE1
F8F79FAEAECBE3E1EFFFFFABB0AF6F6E6DDBEAE7949997FFFFFFFFFFFF888888
C1C1C1CDCDCDD6D6D6F3F3F3FAF8F8FAF9FAFDFFFFE6F8F7DEF6F4B6C1C04644
44C7D5D29DA2A1FFFFFFFFFFFF898989C0C0C0C2C2C2F2F2F2EDECEC67626274
6D6EFDFBFBF6F6F6EEF2F2EAF5F4DBEBE8E2F4EFA1A6A5FFFFFFFFFFFF868686
BEBEBEE3E3E3FFFFFFF6F5F5A5A5A5A7A5A5F3F2F2F0EFEFEDEBEBEBE9E9EFEF
EFF8FDFB9A9D9BFFFFFFFFFFFF8D8D8DEDEDEDFFFFFFFAFAFAFFFFFFE8E7E765
5F5F817C7CF4F4F4ECECECE6E6E6F1F0F0AFAEAEA3A3A3FFFFFFFFFFFF858585
E9E9E9FEFEFEFFFFFFFFFFFFEFEEEEA09E9E999595E0DFDFEAEBEBF0F0F0ABAB
ABA3A3A3FEFEFEFFFFFFFFFFFFD2D2D2969696979797BBBBBBE9E9E9FFFFFFCE
CCCC423E3E999696FBFBFBA4A4A4A9A9A9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFF1F1F1B5B5B5999999979797BDBDBDC7C7C7E5E5E5A0A0A0B1B1B1FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBFBFBE1E1E1B3
B3B39797978E8E8EB4B4B4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnRandomClick
end
object ListView: TListView
Left = 7
Top = 7
Width = 398
Height = 234
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
Caption = 'Title'
Width = 150
end>
HideSelection = False
RowSelect = True
ParentShowHint = False
PopupMenu = PopupMenu
ShowHint = True
SmallImages = SmallImages
SortType = stText
TabOrder = 1
ViewStyle = vsList
OnChange = ListViewChange
OnDblClick = ListViewDblClick
OnEdited = ListViewEdited
OnInfoTip = ListViewInfoTip
OnKeyPress = ListViewKeyPress
end
object pnlMain: TPanel
Left = 0
Top = 0
Width = 528
Height = 4
Align = alTop
BevelOuter = bvNone
TabOrder = 0
end
object pnlPreview: TPanel
Left = 0
Top = 256
Width = 457
Height = 37
Anchors = [akLeft, akRight, akBottom]
BevelOuter = bvLowered
TabOrder = 2
object Image: TImage
Left = 1
Top = 1
Width = 455
Height = 35
Align = alClient
Stretch = True
ExplicitWidth = 485
ExplicitHeight = 23
end
end
object SmallImages: TImageList
Left = 192
Top = 24
Bitmap = {
494C010101000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFF5F000FFF1
E900FFEFE600FFEFE600FFF0E700FFF1E800FFF1E900FFF3EB00FFF3EC00FFF4
ED00FFF6F0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFF4ED00FFEE
E400FFEBDF00FFEBDF00FFEBE000FFECE200FFEDE200FFEEE400FFEFE500FFEF
E600FFF1EA000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFF1E900CD52
0800CD520800CD520800CD520800CD520800CD520800CD520800CD520800CD52
0800FFEDE3000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFEFE600CD52
0800E2651800EB7A3700FFA77200FFD1B200FFF7ED00C2E9FF0042ADF700CD52
0800FFE9DC000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFEDE200CD52
0800E1651900E9783500FFA77000FFD1B200FFF7EC00C2E9FF0040ADF700CD52
0800FFE5D6000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFEBDF00CD52
0800E1651800EB783600FFA77000FFD1B200FFF7EC00C2E9FF0042ADF700CD52
0800FFE1D0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE9DB00CD52
0800E1651900EC793500FFA77000FFD0B200FFF7EC00C2E9FF0040AEF700CD52
0800FFDFCD000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE7D800CD52
0800E1651900EB793500FFA57000FFD1B200FFF7EC00C2E9FF0040ADF700CD52
0800FFE1D0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE4D500CD52
0800E3651A00EB7A3900FFA87400FFD1B300FFF7EC00C4E9FF0044AEF700CD52
0800FFE9DC000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE3D100CD52
0800ED793500F9945700FFBC8D00FFE1C500FFFFF90000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE1CF00CD52
0800CD520800CD520800CD520800CD520800CD52080000000000E17D4100EB92
5E00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE2D100FFD7
BF00FFD0B400FFCEB100FFCFB300FFD0B400FFD3B80000000000F5A779000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFE7DA00FFE2
D000FFDECB00FFDECA00FFDDC900FFDECA00FFDFCD0000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFF0000000000008003000000000000
8003000000000000800300000000000080030000000000008003000000000000
8003000000000000800300000000000080030000000000008003000000000000
800300000000000080030000000000008007000000000000800F000000000000
801F000000000000803F00000000000000000000000000000000000000000000
000000000000}
end
object PopupMenu: TPopupMenu
Left = 32
Top = 24
object DeleteItem: TMenuItem
Caption = 'Delete'
ShortCut = 16430
OnClick = DeleteItemClick
end
object RenameItem: TMenuItem
Caption = 'Rename'
ShortCut = 113
OnClick = RenameItemClick
end
end
object OpenDialog: TOpenDialog
DefaultExt = 'ugr'
Filter = 'Gradient files (*.ugr)|*.ugr|Fractint map files (*.map)|*.map'
Left = 136
Top = 24
end
object TooltipTimer: TTimer
OnTimer = TooltipTimerTimer
Left = 88
Top = 20
end
end
Forms/Browser.pas
+602
View File
@@ -0,0 +1,602 @@
{
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 Browser;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, ToolWin, ImgList, StdCtrls, System.ImageList,
Cmap, Menus, Global, Buttons, Translation;
const
PixelCountMax = 32768;
PaletteTooltipTimeout = 1500;
type
TGradientBrowser = class(TForm)
SmallImages: TImageList;
pnlMain: TPanel;
PopupMenu: TPopupMenu;
DeleteItem: TMenuItem;
RenameItem: TMenuItem;
OpenDialog: TOpenDialog;
TooltipTimer: TTimer;
ListView: TListView;
pnlPreview: TPanel;
Image: TImage;
btnDefGradient: TSpeedButton;
btnRandom: TSpeedButton;
procedure FormResize(Sender: TObject);
procedure ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DeleteItemClick(Sender: TObject);
procedure RenameItemClick(Sender: TObject);
procedure ListViewEdited(Sender: TObject; Item: TListItem;
var S: string);
procedure btnDefGradientClick(Sender: TObject);
procedure ListViewDblClick(Sender: TObject);
procedure ListViewKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListViewInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: String);
procedure TooltipTimerTimer(Sender: TObject);
// AV: now you really can rename it :-)
function RenameGradient(OldIdent: string; var NewIdent: string): boolean;
procedure btnRandomClick(Sender: TObject); // AV
private
procedure DrawPalette;
procedure Apply;
public
// AV: deleted all unused identifiers: cp, Renderer, integers etc.
Extension, Identifier, Filename: string;
Palette: TColorMap;
procedure ListFileContents;
function LoadFractintMap(filen: string): TColorMap;
end;
type
EFormatInvalid = class(Exception);
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
var
GradientBrowser: TGradientBrowser;
function CreatePalette(strng: string): TColorMap;
implementation
uses Main, Options, Editor, Registry, Adjust, Mutate;
{$R *.DFM}
function GetVal(token: string): string;
var
p: integer;
begin
p := Pos('=', token);
Delete(Token, 1, p);
Result := Token;
end;
function ReplaceTabs(str: string): string;
{Changes tab characters in a string to spaces}
var
i: integer;
begin
for i := 1 to Length(str) do
begin
if str[i] = #9 then
begin
Delete(str, i, 1);
Insert(#32, str, i);
end;
end;
Result := str;
end;
function TGradientBrowser.LoadFractintMap(filen: string): TColorMap;
var
i: integer;
s: string;
pal: TColorMap;
MapFile: TextFile;
begin
{ Load a map file }
AssignFile(MapFile, Filen);
try
Reset(MapFile);
for i := 0 to 255 do
begin
Read(MapFile, Pal[i][0]);
Read(MapFile, Pal[i][1]);
Read(MapFile, Pal[i][2]);
Read(MapFile, s);
end;
CloseFile(MapFile);
Result := Pal;
except
on EInOutError do Application.MessageBox(PChar(Format(TextByKey('common-genericopenfailure'), [FileName])), PCHAR('Apophysis'), 16);
end;
end;
function CreatePalette(strng: string): TColorMap;
{ Loads a palette from a gradient string }
var
Strings: TStringList;
index, i: integer;
Tokens: TStringList;
Indices, Colors: TStringList;
a, b: integer;
begin
Strings := TStringList.Create;
Tokens := TStringList.Create;
Indices := TStringList.Create;
Colors := TStringList.Create;
try
try
Strings.Text := strng;
if Pos('}', Strings.Text) = 0 then raise EFormatInvalid.Create('No closing brace');
if Pos('{', Strings[0]) = 0 then raise EFormatInvalid.Create('No opening brace.');
GetTokens(ReplaceTabs(strings.text), tokens);
Tokens.Text := Trim(Tokens.text);
i := 0;
while (Pos('}', Tokens[i]) = 0) and (Pos('opacity:', Lowercase(Tokens[i])) = 0) do
begin
if Pos('index=', LowerCase(Tokens[i])) <> 0 then
Indices.Add(GetVal(Tokens[i]))
else if Pos('color=', LowerCase(Tokens[i])) <> 0 then
Colors.Add(GetVal(Tokens[i]));
inc(i)
end;
for i := 0 to 255 do
begin
Result[i][0] := 0;
Result[i][1] := 0;
Result[i][2] := 0;
end;
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
Result[index][0] := StrToInt(Colors[i]) mod 256;
Result[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
Result[index][2] := trunc(StrToInt(Colors[i]) / 65536);
except
end;
end;
i := 1;
repeat
a := StrToInt(Trim(Indices[i - 1]));
b := StrToInt(Trim(Indices[i]));
RGBBlend(a, b, Result);
inc(i);
until i = Indices.Count;
if (Indices[0] <> '0') or (Indices[Indices.Count - 1] <> '255') then
begin
a := StrToInt(Trim(Indices[Indices.Count - 1]));
b := StrToInt(Trim(Indices[0])) + 256;
RGBBlend(a, b, Result);
end;
except on EFormatInvalid do
// Result := False;
end;
finally
Tokens.Free;
Strings.Free;
Indices.Free;
Colors.Free;
end;
end;
procedure TGradientBrowser.DrawPalette;
var
i, j: integer;
Row: pRGBTripleArray;
BitMap: TBitMap;
begin
BitMap := TBitMap.Create;
try
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 1;
for j := 0 to Bitmap.Height - 1 do
begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do
begin
with Row[i] do
begin
rgbtRed := Palette[i][0];
rgbtGreen := Palette[i][1];
rgbtBlue := Palette[i][2];
end
end
end;
Image.Picture.Graphic := Bitmap;
Image.Refresh;
finally
BitMap.Free;
end;
end;
procedure TGradientBrowser.ListFileContents;
{ List identifiers in file }
var
i, p: integer;
Title: string;
ListItem: TListItem;
FStrings: TStringList;
begin
FStrings := TStringList.Create;
FStrings.LoadFromFile(filename);
try
ListView.Items.BeginUpdate;
ListView.Items.Clear;
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
ListItem := ListView.Items.Add;
Listitem.Caption := Trim(filename);
end
else
if (Pos('{', FStrings.Text) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('{', FStrings[i]);
if (p <> 0) and (Pos('(3D)', FStrings[i]) = 0) then
begin
Title := Trim(Copy(FStrings[i], 1, p - 1));
if Title <> '' then
begin { Otherwise bad format }
ListItem := ListView.Items.Add;
Listitem.Caption := Trim(Copy(FStrings[i], 1, p - 1));
end;
end;
end;
end;
ListView.Items.EndUpdate;
ListView.Selected := ListView.Items[0];
finally
FStrings.Free;
end;
end;
procedure TGradientBrowser.ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
var
Tokens, FStrings: TStringList;
EntryStrings: TStringList;
i: integer;
begin
Application.ProcessMessages;
FStrings := TStringList.Create;
EntryStrings := TStringList.Create;
Tokens := TStringList.Create;
try
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
Palette := LoadFractintMap(filename);
DrawPalette;
end
else
if (ListView.SelCount <> 0) and (ListView.Selected.Caption <> Identifier) then
begin
Identifier := ListView.Selected.Caption;
FStrings.LoadFromFile(Filename);
for i := 0 to FStrings.count - 1 do
if Pos(Lowercase(ListView.Selected.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break;
EntryStrings.Add(FStrings[i]);
repeat
inc(i);
EntryStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
Palette := CreatePalette(EntryStrings.Text);
DrawPalette;
end;
finally
EntryStrings.Free;
FStrings.Free;
Tokens.Free;
end;
end;
procedure TGradientBrowser.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('gradientbrowser-title');
btnDefGradient.Hint := TextByKey('common-browse');
DeleteItem.Caption := TextByKey('common-delete');
RenameItem.Caption := TextByKey('common-rename');
btnRandom.Hint := TextByKey('adjustment-tab-gradient-presethint');
end;
procedure TGradientBrowser.FormShow(Sender: TObject);
var
Registry: TRegistry;
begin
{ Read posution from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Browser', False) then
begin
if Registry.ValueExists('Left') then
GradientBrowser.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
GradientBrowser.Top := Registry.ReadInteger('Top');
if Registry.ValueExists('Width') then
GradientBrowser.Width := Registry.ReadInteger('Width');
if Registry.ValueExists('Height') then
GradientBrowser.Height := Registry.ReadInteger('Height');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
if FileExists(filename) then ListFileContents;
end;
procedure TGradientBrowser.DeleteItemClick(Sender: TObject);
var
c: boolean;
begin
if ListView.SelCount <> 0 then
begin
if ConfirmDelete then
c := Application.MessageBox(
PChar(Format(TextByKey('common-confirmdelete'), [ListView.Selected.Caption])), 'Apophysis', 36) = IDYES
else
c := True;
if c then
if ListView.Focused and (ListView.SelCount <> 0) then
begin
Application.ProcessMessages;
if DeleteEntry(ListView.Selected.Caption, Filename) then
begin
ListView.Items.Delete(ListView.Selected.Index);
ListView.Selected := ListView.ItemFocused;
end;
end;
end;
end;
function TGradientBrowser.RenameGradient(OldIdent: string; var NewIdent: string): boolean;
var
Strings: TStringList;
p, i: integer;
s: string;
begin
Result := True;
Strings := TStringList.Create;
try
try
i := 0;
Strings.LoadFromFile(Filename);
if Pos(OldIdent + ' ', Trim(Strings.Text)) <> 0 then
begin
while Pos(OldIdent + ' ', Trim(Strings[i])) <> 1 do
begin
inc(i);
end;
p := Pos('{', Strings[i]);
s := Copy(Strings[i], p, Length(Strings[i]) - p + 1);
Strings[i] := NewIdent + ' ' + s;
Strings.SaveToFile(Filename);
end
else
Result := False;
except on Exception do Result := False;
end;
finally
Strings.Free;
end;
end;
procedure TGradientBrowser.RenameItemClick(Sender: TObject);
begin
if ListView.SelCount <> 0 then
ListView.Items[ListView.Selected.Index].EditCaption;
end;
procedure TGradientBrowser.ListViewEdited(Sender: TObject; Item: TListItem;
var S: string);
begin
if s <> Item.Caption then
if not RenameGradient(Item.Caption, s) then // AV
s := Item.Caption;
end;
procedure TGradientBrowser.btnDefGradientClick(Sender: TObject);
var
fn:string;
begin
OpenDialog.InitialDir := BrowserPath;
OpenDialog.Filter := Format('%s|*.gradient;*.ugr|%s|*.map|%s|*.*',
[TextByKey('common-filter-gradientfiles'),
TextByKey('common-filter-fractintfiles'),
TextByKey('common-filter-allfiles')]);
OpenDialog.FileName := '';
if OpenSaveFileDialog(GradientBrowser, OpenDialog.DefaultExt, OpenDialog.Filter, OpenDialog.InitialDir, TextByKey('common-browse'), fn, true, false, false, true) then
//if OpenDialog.Execute then
begin
Filename := fn; //OpenDialog.FileName;
GradientFile := Filename;
BrowserPath := ExtractFilePath(fn); //ExtractFilePath(OpenDialog.FileName);
ListFileContents;
end;
end;
procedure TGradientBrowser.btnRandomClick(Sender: TObject);
var i: integer;
begin
if ListView.Items.Count < 2 then exit;
i := random(ListView.Items.Count);
ListView.Selected := ListView.Items[i];
Apply;
end;
procedure TGradientBrowser.Apply;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.cmap := Palette;
MainCP.cmapindex := -1;
if EditForm.Visible then EditForm.UpdateDisplay;
if AdjustForm.Visible then AdjustForm.UpdateDisplay;
if MutateForm.Visible then MutateForm.UpdateDisplay;
MainForm.RedrawTimer.enabled := true;
end;
procedure TGradientBrowser.ListViewDblClick(Sender: TObject);
begin
Apply;
end;
procedure TGradientBrowser.ListViewKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #13 then Apply;
end;
procedure TGradientBrowser.FormClose(Sender: TObject;
var Action: TCloseAction);
var
Registry: TRegistry;
begin
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
{ Defaults }
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Browser', True) then
begin
Registry.WriteInteger('Top', GradientBrowser.Top);
Registry.WriteInteger('Left', GradientBrowser.Left);
Registry.WriteInteger('Width', GradientBrowser.Width);
Registry.WriteInteger('Height', GradientBrowser.Height);
end;
finally
Registry.Free;
end;
end;
procedure TGradientBrowser.ListViewInfoTip(Sender: TObject;
Item: TListItem; var InfoTip: String);
var
i, j: integer;
Row: pRGBTripleArray;
Bitmap: TBitmap;
pal: TColorMap;
EntryStrings, FStrings: TStringList;
rect: TRect;
begin
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 100;
FStrings := TStringList.Create;
EntryStrings := TStringList.Create;
try
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
pal := LoadFractintMap(filename);
end
else
begin
Identifier := Item.Caption;
FStrings.LoadFromFile(Filename);
for i := 0 to FStrings.count - 1 do
if Pos(Lowercase(Item.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break;
EntryStrings.Add(FStrings[i]);
repeat
inc(i);
EntryStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
pal := CreatePalette(EntryStrings.Text);
end;
finally
EntryStrings.Free;
FStrings.Free;
end;
for j := 0 to Bitmap.Height - 1 do
begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do
begin
with Row[i] do
begin
rgbtRed := pal[i][0];
rgbtGreen := pal[i][1];
rgbtBlue := pal[i][2];
end
end
end;
rect.TopLeft := Item.Position;
rect.BottomRight.X := rect.TopLeft.X + 100;
rect.BottomRight.Y := rect.TopLeft.Y + 16;
with ListView do
begin
Canvas.Rectangle(Rect);
Canvas.StretchDraw(Rect, Bitmap);
end;
BitMap.Free;
InfoTip := '';
TooltipTimer.Interval := PaletteTooltipTimeout;
TooltipTimer.Enabled := true;
end;
procedure TGradientBrowser.TooltipTimerTimer(Sender: TObject);
begin
ListView.Repaint;
TooltipTimer.Enabled := false;
end;
procedure TGradientBrowser.FormResize(Sender: TObject);
begin
Listview.Width := self.ClientWidth - 4;
btnDefGradient.Left := self.ClientWidth - 2 - btnDefGradient.Width;
ListView.Height := self.ClientHeight - pnlPreview.Height - 6;
btnDefGradient.Top := self.ClientHeight - pnlPreview.Height - 2 + pnlPreview.Height div 2 - btnDefGradient.Height div 2;
btnRandom.Left := btnDefGradient.Left - btnRandom.Width - 2;
btnRandom.Top := btnDefGradient.Top;
ListView.Top := 2;
ListView.Left := 2;
pnlPreview.Top := self.ClientHeight - pnlPreview.Height - 2;
pnlPreview.Left := 2;
pnlPreview.Width := self.ClientWidth - btnDefGradient.Width - 6 - btnRandom.Width;
end;
end.
Forms/Chaos.dfm
+131
View File
@@ -0,0 +1,131 @@
object ChaosForm: TChaosForm
Left = 0
Top = 0
Caption = 'Transform Transitions'
ClientHeight = 324
ClientWidth = 494
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001010200000000000680400001600000028000000100000002000
0000010020000000000000040000000000000000000000000000000000000501
01002A0E0D00250D0B00250D0B00260D0B0026090700000000007B7B7B00E6E6
E600000000000000000000000000000000000000000000000000000000002A0F
0C00F1554A00DE4E4400DF4E4400F653480057181400D7DEDF001A1A1A000000
0000D8D8D800000000000000000000000000000000000000000000000000250D
0B00DE4E4400CD483F00D9483E003A020000D6E1E20000000000000000000000
000000000000E6E6E6000000000000000000000000000000000000000000250D
0B00DF4E4500D8483E004C1C1800CAD8D900000000000000000000000000F4F4
F40010101000000000000000000000000000000000000000000000000000260D
0B00F65348003A020000CAD8D900000000000000000000000000000000000000
0000848484000000000000000000000000000000000000000000000000002609
060056171300D6E1E20000000000000000000000000000000000000000000000
000000000000000000006D6D6D00000000000000000000000000000000000000
0000DAE1E100000000000000000000000000000000000000000000000000F7F7
F7000A0A0A005B5B5B000000000000000000000000000000000000000000F1F1
F10099999900F7F7F70000000000000000000000000000000000000000000000
0000E9E9E9000000000000000000000000000000000000000000000000009292
92000000000000000000E9E9E900DFDFDF00C2C3B600C5C6B700C5C6B700C5C6
B700CACABC00C4C4C100CECECE00000000000000000000000000000000006262
62000000000078787800BBBBBB004C4D40000000620000006E0000006C000000
6D000000850000000000B3B4B10000000000000000000000000000000000DADA
DA0000000000F1F1F10000000000505139001B11EF00261DFD00261DFB00251C
FF0000006F00C9C9C3000000000000000000000000000000000000000000D0D0
D00000000000F5F5F50000000000505139001910E300241CEF00261DFF000906
6400CDCEB800000000000000000000000000000000000000000000000000C8C8
C800000000003F3F3F009F9F9F005D5E46001910E400261DFF0000005E007A7A
6A00393A3C00000000000000000000000000E8E8E8009C9C9C00000000000000
00007F7F7F00000000007373730060614B00160DF00004006700D1D2BF00DBDB
DB0000000000000000004B4B4B00F8F8F800C8C8C80000000000ADADAD000000
00000000000000000000000000004F50460000005900C3C4AD00000000000000
0000BDBDBD006666660000000000000000000000000000000000424242000000
00000000000000000000000000003D3D3D00C9C9BF0000000000000000000000
00000000000000000000C8C8C800D4D4D400AFAFAF004343430000000000007F
0000003F0000031F0000071F00000F9F00001F0F00003F1F00001FBF0000000F
0000000F0000101F0000103F00000039000080000000F1800000F3E10000}
OldCreateOrder = False
OnActivate = FormActivate
OnCreate = FormCreate
OnResize = FormResize
DesignSize = (
494
324)
PixelsPerInch = 96
TextHeight = 13
object PageControl1: TPageControl
Left = 0
Top = 8
Width = 496
Height = 277
ActivePage = TabMatrix
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 0
object TabMatrix: TTabSheet
Caption = 'Probability Matrix'
DesignSize = (
488
249)
object ChaosMatrix: TStringGrid
Left = 0
Top = 80
Width = 488
Height = 145
Anchors = [akLeft, akTop, akRight]
Color = clBtnFace
ColCount = 2
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goThumbTracking]
TabOrder = 0
OnDrawCell = ChaosMatrixDrawCell
end
object chkPercents: TCheckBox
Left = 10
Top = 229
Width = 350
Height = 17
Caption = ' Show values in percents'
TabOrder = 1
OnClick = chkPercentsClick
end
object WeightVector: TStringGrid
Left = 0
Top = 0
Width = 488
Height = 70
Align = alTop
Color = clBtnFace
ColCount = 2
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goThumbTracking]
ScrollBars = ssHorizontal
TabOrder = 2
OnDrawCell = ChaosMatrixDrawCell
end
end
object TabDiagram: TTabSheet
Caption = 'Xaos Diagram'
ImageIndex = 1
TabVisible = False
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
end
end
object btnClose: TButton
Left = 400
Top = 291
Width = 86
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Close'
Default = True
ModalResult = 8
TabOrder = 1
OnClick = btnCloseClick
end
end
Forms/Chaos.pas
+168
View File
@@ -0,0 +1,168 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit Chaos;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.ComCtrls, Editor, Translation,
Vcl.StdCtrls, Math;
type
TChaosForm = class(TForm)
PageControl1: TPageControl;
TabMatrix: TTabSheet;
ChaosMatrix: TStringGrid;
btnClose: TButton;
TabDiagram: TTabSheet;
chkPercents: TCheckBox;
WeightVector: TStringGrid;
procedure ChaosMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure chkPercentsClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ChaosForm: TChaosForm;
implementation
{$R *.dfm}
procedure TChaosForm.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TChaosForm.ChaosMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
h, ax, ay, bx, by: integer;
val: double;
trgColor : TColor;
newRect: TRect;
begin
if (ARow = 0) and (ACol = 0) then exit;
if not (gdFixed in State) then
begin
trgColor := EditForm.GetTriangleColor(ACol - 1);
with TStringGrid(Sender).Canvas do begin
Brush.Color := trgColor;
FillRect(Rect);
Font.Color := clBlack; //clWindowText;
if Sender = ChaosMatrix then
begin
val := EditForm.cp.xform[ACol - 1].modWeights[ARow - 1];
if not chkPercents.Checked then
TextOut(Rect.Left + 4, Rect.Top + 4, FloatToStr(RoundTo(val, -4)))
else begin
if ChaosMatrix.Cells[ACol, 1] = '0' then
TextOut(Rect.Left + 4, Rect.Top + 4, '0%')
else
TextOut(Rect.Left + 4, Rect.Top + 4, Format('%g%%',
[RoundTo(val / StrToFloat(ChaosMatrix.Cells[ACol, 1]), -4)]));
end;
end else // if Sender = WeightVector then
begin
val := EditForm.cp.xform[ACol - 1].density;
if not chkPercents.Checked then
TextOut(Rect.Left + 4, Rect.Top + 4, FloatToStr(RoundTo(val, -4)))
else // weight sum is always not zero
TextOut(Rect.Left + 4, Rect.Top + 4, Format('%g%%',
[RoundTo(val / StrToFloat(WeightVector.Cells[1,1]), -4)]));
end;
end;
end else
begin
if (ACol = 0) then
trgColor := EditForm.GetTriangleColor(ARow - 1)
else
trgColor := EditForm.GetTriangleColor(ACol - 1);
if (Sender = WeightVector) and (ARow = 1) then exit;
with TStringGrid(Sender).Canvas do begin
h := Rect.Bottom - Rect.Top - 2;
ax := Rect.Right - 3;
ay := Rect.Top + 2;
bx := Rect.Right - h;
by := Rect.Bottom - 3;
pen.Color := clBlack;
Polyline([Point(ax+1, ay-2), Point(ax+1, by+1), Point(bx-2, by+1), Point(ax+1, ay-2)]);
pen.Color := trgColor;
brush.Color := pen.Color shr 1 and $7f7f7f;
Polygon([Point(ax, ay), Point(ax, by), Point(bx, by)]);
end;
end;
end;
procedure TChaosForm.chkPercentsClick(Sender: TObject);
begin
WeightVector.Invalidate;
ChaosMatrix.Invalidate;
end;
procedure TChaosForm.FormActivate(Sender: TObject);
var
i, j, n: integer;
sum: double;
begin
n := EditForm.cp.NumXForms + 1;
sum := 0;
with WeightVector do begin
ColCount := n;
for i := 1 to n do
Cells[i,0] := ' ' + IntToStr(i);
for j := 0 to n-2 do
sum := sum + EditForm.cp.xform[j].density;
Cells[1, 1] := FloatToStr(sum * 0.01);
end;
with ChaosMatrix do begin
ColCount := n;
RowCount := n;
for i := 1 to n do
begin
Cells[0,i] := Format(TextByKey('editor-common-toprefix'), [i]);
Cells[i,0] := Format(TextByKey('editor-common-fromprefix'), [i]);
sum := 0;
for j := 0 to n-2 do
sum := sum + EditForm.cp.xform[i-1].modWeights[j];
Cells[i, 1] := FloatToStr(sum * 0.01);
end;
Height := TabMatrix.Height - Top - 24;
Invalidate;
end;
chkPercents.Top := TabMatrix.Height - 20;
end;
procedure TChaosForm.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('transitions-title');
TabMatrix.Caption := TextByKey('transitions-matrix');
btnClose.Caption := TextByKey('common-close');
ChaosMatrix.Cells[0,0] := TextByKey('editor-tab-chaos-path');
chkPercents.Caption := TextByKey('transitions-inpercents');
WeightVector.Cells[0,0] := TextByKey('transitions-transform');
WeightVector.Cells[0,1] := TextByKey('editor-common-weight');
// AV: TODO: visualize Markov chain transitions using arrows
// TabDiagram.Caption := TextByKey('transitions-diagram');
end;
procedure TChaosForm.FormResize(Sender: TObject);
begin
ChaosMatrix.Height := TabMatrix.Height - ChaosMatrix.Top - 24;
chkPercents.Top := TabMatrix.Height - 20;
TabMatrix.Invalidate;
end;
end.
Forms/ColorRangeForm.dfm
+133
View File
@@ -0,0 +1,133 @@
object ColorSelection: TColorSelection
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Palette Interval Selection'
ClientHeight = 114
ClientWidth = 287
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001010000000000000680400001600000028000000100000002000
000001002000000000000004000000000000000000000000000000000000020C
16000C283700051D2900051C260001121A2703131C780A2937C611374AE11038
4CE7061B27A1020D150C030F19000617230011384B000E2E3E0006131F00020C
16000C2736000218222E0F2E3E9B285C7AE03E7DA4FF468FBDFF4994C0FF4C9C
CBFF317295FF1D4E692D1B4A630016476100123E52000D2D3D0006131F00010A
1300092331522A617EE84D99C5FF4F9FD0FF408CB9FF3884AFFF3783AFFF3C8D
BCFF245775CC0F30410C16435A0016486200123D51000D2D3D0006131F00010B
1637316584EE51A3D1FF257AB1FF2A77A3FF3684ADFF3584AFFF3586B1FF3482
ADFF153A4E900A2B3C380F35473D12435B3E0E374A3E0B2A390F061320002142
55B552ACD7FF2391C7FF3FB5E1FF2485C0FF2D7CADFF388AB7FF347AA6FF337D
A6FF2E7499FA27688AF02D7293F139799EF4346E91F51B4960C6020D17344075
93F656B6DEFF31CBF0FF21E4FEFF26B4E2FF2D7FB9FF4096C1FF336E94FF3056
71FF2774A0FF286A90F130749891387EA8E64CA4D8FF55ABDDFF224D67D74380
A1F576BADCFF76BCDCFF7FD1FAFF62B6F0FF61ABD9FF64AFD4FF4699C2FF98AF
BDFF5A839EFF1A638BFD225A7AF52B81AFFC3FA1D2FF4DAAD8FF3A85ABFA3464
7CC774BFE6FF70B0CEFF439186FF367A4FFF4A9D8EFF79BCE6FF77BBDEFF6CAA
CDFFC0CED3FF4C819FFF4D7B98FF61686EFF6B7072FF55A4CAFF2E769AEA1532
3F44599DC7F661BAB3FF18BB0EFF009400FF278543FF7EC4E9FF8ECDE8FF5CAC
D0FF75B1CEFFA1BBC2FF955438FFD4580BFFBA6E34FF5A99B4FF0F31466E0B1E
2700214D626569BCE3F979CBBBFF67DD98FF82CEE0FF77B8E4FF365DC9FF254C
B5FF1D58A9FF3991BCFF4FAEC6FF809DA6FF79B7CCFF2E617EA405111D0F0E23
2E00173B4D0055AAD23D6ABCF0CD82C4FDFB92D4F2FF7EC1E5FF3B6ADDFF1930
DBFF295FD1FF4DA0CEFF3FBDE4FF3EB7EAFF368BBC8F204A6304020913000E23
2D00193E510057AAD30056B4DF0055B8E35459B9E58E63C1E9AB6FC8EDCD64C0
EDD160C2EBC264BFEA8E3E9DCEAF4AC1E0FF49ACDAD73A87AD0A1D425A000E23
2D00193E510057AAD30058B5E00057B9E40057B8E5004FB7E6005CC0E81962C4
E81D57BDE7105AB9E700249BCF0F38ADD3C056C6E6FF4198C66F49C3EB000E23
2D00193E510057AAD30058B5E00057B9E40057B8E50051B8E6005EC0E80062C3
E80058BEE70058B8E50018A2D50023A5D71B4BC4E6DA44A7C9FB41C1E32E0E23
2D00193E510057AAD30058B5E00057B9E40057B8E50051B8E6005EC0E80062C3
E80058BEE70058B8E5001AA1D40024A9D90032B9E32D3CA7CFEE45C8E9540E23
2D00193E510057AAD30058B5E00057B9E40057B8E50051B8E6005EC0E80062C3
E80058BEE70058B8E5001AA1D40025A8D80030B6E2003CC5EB5C50DDFA4FFC3F
0000E03F0000C03F0000803F0000000100000000000000000000000000008001
0000C0010000E0030000F8030000FFF30000FFF90000FFFD0000FFFF0000}
OldCreateOrder = False
Position = poDefault
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
287
114)
PixelsPerInch = 96
TextHeight = 13
object StartColor: TShape
Left = 10
Top = 40
Width = 30
Height = 22
end
object LastColor: TShape
Left = 140
Top = 40
Width = 30
Height = 22
end
object lbStart: TLabel
Left = 8
Top = 16
Width = 94
Height = 13
Caption = 'Start palette index:'
end
object lbLast: TLabel
Left = 140
Top = 16
Width = 90
Height = 13
Caption = 'Last palette index:'
end
object btOK: TButton
Left = 101
Top = 82
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btOKClick
end
object btCancel: TButton
Left = 186
Top = 82
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object SpinStart: TSpinEdit
Left = 40
Top = 40
Width = 70
Height = 22
MaxValue = 253
MinValue = 0
TabOrder = 2
Value = 0
OnChange = SpinStartChange
OnKeyPress = SpinValueKeyPress
end
object SpinLast: TSpinEdit
Left = 170
Top = 40
Width = 70
Height = 22
MaxValue = 255
MinValue = 2
TabOrder = 3
Value = 255
OnChange = SpinLastChange
OnKeyPress = SpinValueKeyPress
end
end
Forms/ColorRangeForm.pas
+91
View File
@@ -0,0 +1,91 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit ColorRangeForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, ComCtrls, StdCtrls, ExtCtrls, Vcl.Forms, Vcl.Dialogs, Adjust, Translation,
Vcl.Samples.Spin;
type
TColorSelection = class(TForm)
btOK: TButton;
btCancel: TButton;
SpinStart: TSpinEdit;
SpinLast: TSpinEdit;
StartColor: TShape;
LastColor: TShape;
lbStart: TLabel;
lbLast: TLabel;
procedure FormCreate(Sender: TObject);
procedure btOKClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SpinLastChange(Sender: TObject);
procedure SpinValueKeyPress(Sender: TObject; var Key: Char);
procedure SpinStartChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ColorSelection: TColorSelection;
implementation
{$R *.dfm}
procedure TColorSelection.btOKClick(Sender: TObject);
begin
AdjustForm.selA := SpinStart.Value;
AdjustForm.selB := SpinLast.Value;
end;
procedure TColorSelection.FormCreate(Sender: TObject);
begin
self.Caption := TextBykey('selectcolors-title');
lbStart.Caption := TextBykey('selectcolors-start');
lbLast.Caption := TextBykey('selectcolors-last');
btOK.Caption := TextByKey('common-ok');
btCancel.Caption := TextByKey('common-cancel');
end;
procedure TColorSelection.SpinValueKeyPress(Sender: TObject; var Key: Char);
begin
if Key = '-' then Key := #0; // AV: non-negative indices only
end;
procedure TColorSelection.FormShow(Sender: TObject);
var a, b: byte;
begin
self.Left := AdjustForm.Left + ((AdjustForm.Width - self.Width) shr 1);
self.Top := AdjustForm.Top + 55;
a := AdjustForm.selA;
b := AdjustForm.selB;
SpinStart.Value := a;
SpinLast.Value := b;
StartColor.Brush.Color := RGB(AdjustForm.palette[a,0], AdjustForm.palette[a,1], AdjustForm.palette[a,2]);
LastColor.Brush.Color := RGB(AdjustForm.palette[b,0], AdjustForm.palette[b,1], AdjustForm.palette[b,2]);
end;
procedure TColorSelection.SpinStartChange(Sender: TObject);
begin
if SpinStart.Value > 253 then SpinStart.Value := 253;
if (SpinLast.Value - SpinStart.Value < 2) then
SpinStart.Value := SpinLast.Value - 2;
StartColor.Brush.Color := RGB(AdjustForm.palette[SpinStart.Value,0],
AdjustForm.palette[SpinStart.Value,1], AdjustForm.palette[SpinStart.Value,2]);
end;
procedure TColorSelection.SpinLastChange(Sender: TObject);
begin
if SpinLast.Value > 255 then SpinLast.Value := 255;
if (SpinLast.Value - SpinStart.Value < 2) then
SpinLast.Value := SpinStart.Value + 2;
LastColor.Brush.Color := RGB(AdjustForm.palette[SpinLast.Value,0],
AdjustForm.palette[SpinLast.Value,1], AdjustForm.palette[SpinLast.Value,2]);
end;
end.
Forms/Curves.dfm
+125
View File
@@ -0,0 +1,125 @@
object CurvesForm: TCurvesForm
Left = 197
Top = 111
BorderStyle = bsDialog
Caption = 'Curves'
ClientHeight = 492
ClientWidth = 489
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 16
object Label1: TLabel
Left = 8
Top = 16
Width = 75
Height = 13
Caption = 'Selected curve:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object CurvesPanel: TPanel
Left = 8
Top = 68
Width = 473
Height = 414
BevelOuter = bvNone
Color = clBlack
ParentBackground = False
TabOrder = 0
end
object cbChannel: TComboBox
Left = 8
Top = 35
Width = 185
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ItemIndex = 0
ParentFont = False
TabOrder = 1
Text = 'Overall'
OnChange = cbChannelChange
Items.Strings = (
'Overall'
'Red'
'Green'
'Blue')
end
object tbWeightLeft: TScrollBar
Left = 326
Top = 8
Width = 155
Height = 21
Max = 160
PageSize = 0
Position = 80
TabOrder = 2
OnChange = tbWeightChange
OnScroll = tbWeightScroll
end
object tbWeightRight: TScrollBar
Left = 326
Top = 35
Width = 155
Height = 21
Max = 160
PageSize = 0
Position = 80
TabOrder = 3
OnChange = tbWeightChange
OnScroll = tbWeightScroll
end
object Panel2: TPanel
Left = 199
Top = 8
Width = 121
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = ' First CP weight:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object Panel1: TPanel
Left = 199
Top = 35
Width = 121
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = ' Second CP weight:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
end
Forms/Curves.pas
+123
View File
@@ -0,0 +1,123 @@
unit Curves;
interface
uses Windows, Classes, Graphics, Forms, Controls, CurvesControl, Vcl.ExtCtrls,
Vcl.StdCtrls, Vcl.ComCtrls, ControlPoint, Registry, Global;
type
TCurvesForm = class(TForm)
CurvesPanel: TPanel;
cbChannel: TComboBox;
tbWeightLeft: TScrollBar;
tbWeightRight: TScrollBar;
Panel2: TPanel;
Panel1: TPanel;
Label1: TLabel;
procedure FormShow(Sender: TObject);
procedure cbChannelChange(Sender: TObject);
procedure tbWeightChange(Sender: TObject);
procedure tbWeightScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
published
CurvesControl: TCurvesControl;
public
procedure SetCp(cp: TControlPoint);
end;
var
CurvesForm: TCurvesForm;
implementation
uses Main;
{$R *.DFM}
procedure TCurvesForm.tbWeightScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
begin
if ScrollCode = scEndScroll then
CurvesControl.UpdateFlame;
end;
procedure TCurvesForm.SetCp(cp: TControlPoint);
begin
if CurvesControl = nil then Exit;
CurvesControl.SetCp(cp);
end;
procedure TCurvesForm.cbChannelChange(Sender: TObject);
begin
if CurvesControl = nil then Exit;
CurvesControl.ActiveChannel := TCurvesChannel(cbChannel.ItemIndex);
tbWeightLeft.Position := Round(CurvesControl.WeightLeft * 10);
tbWeightRight.Position := Round(CurvesControl.WeightRight * 10);
end;
procedure TCurvesForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
Registry: TRegistry;
begin
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Curves', True) then
begin
Registry.WriteInteger('Top', self.Top);
Registry.WriteInteger('Left', self.Left);
end;
finally
Registry.Free;
end;
// bStop := True;
end;
procedure TCurvesForm.FormCreate(Sender: TObject);
begin
//
end;
procedure TCurvesForm.FormShow(Sender: TObject);
var Registry: TRegistry;
begin
if not (assigned(curvesControl)) then
begin
CurvesControl := TCurvesControl.Create(self);
CurvesControl.Align := alClient;
CurvesControl.Parent := CurvesPanel;
end;
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Curves', False) then
begin
if Registry.ValueExists('Left') then
self.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
self.Top := Registry.ReadInteger('Top');
Registry.CloseKey;
end;
finally
Registry.Free;
end;
tbWeightLeft.Position := Round(CurvesControl.WeightLeft * 10);
tbWeightRight.Position := Round(CurvesControl.WeightRight * 10);
SetCp(MainCp);
end;
procedure TCurvesForm.tbWeightChange(Sender: TObject);
begin
CurvesControl.WeightLeft := tbWeightLeft.Position / 10.0;
CurvesControl.WeightRight := tbWeightRight.Position / 10.0;
end;
end.
Forms/Editor.dfm
+5937
View File
File diff suppressed because it is too large Load Diff
Forms/Editor.pas
+7659
View File
File diff suppressed because it is too large Load Diff
Forms/FormExport.dfm
+713
View File
@@ -0,0 +1,713 @@
object ExportDialog: TExportDialog
Left = 313
Top = 276
BorderStyle = bsDialog
Caption = 'Export Flame'
ClientHeight = 403
ClientWidth = 496
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
496
403)
PixelsPerInch = 96
TextHeight = 13
object btnOK: TButton
Left = 398
Top = 182
Width = 89
Height = 25
Anchors = [akTop, akRight]
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 398
Top = 210
Width = 89
Height = 25
Anchors = [akTop, akRight]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object GroupBox1: TGroupBox
Left = 8
Top = 5
Width = 481
Height = 57
Anchors = [akLeft, akTop, akRight]
Caption = ' Destination '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
DesignSize = (
481
57)
object btnBrowse: TSpeedButton
Left = 448
Top = 19
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object Label10: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'File name'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object txtFilename: TEdit
Left = 112
Top = 20
Width = 337
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
end
object GroupBox3: TGroupBox
Left = 256
Top = 66
Width = 233
Height = 105
Anchors = [akTop, akRight]
Caption = ' Quality '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
DesignSize = (
233
105)
object udOversample: TUpDown
Left = 212
Top = 68
Width = 12
Height = 21
Anchors = [akTop, akRight]
Associate = txtOversample
Min = 1
Max = 4
Position = 2
TabOrder = 3
end
object Label4: TPanel
Left = 8
Top = 20
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Density'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object txtDensity: TEdit
Left = 120
Top = 20
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = txtDensityChange
end
object Label5: TPanel
Left = 8
Top = 44
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Filter radius'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
object txtFilterRadius: TEdit
Left = 120
Top = 44
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnChange = txtFilterRadiusChange
end
object Label3: TPanel
Left = 8
Top = 68
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Oversample'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 6
end
object txtOversample: TEdit
Left = 120
Top = 68
Width = 92
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ReadOnly = True
TabOrder = 2
Text = '2'
OnChange = txtOversampleChange
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 66
Width = 241
Height = 105
Anchors = [akLeft, akTop, akRight]
Caption = ' Size '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 4
DesignSize = (
241
105)
object chkMaintain: TCheckBox
Left = 8
Top = 76
Width = 225
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Maintain aspect ratio'
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
State = cbChecked
TabOrder = 0
OnClick = chkMaintainClick
end
object Label1: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Width'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object Label2: TPanel
Left = 8
Top = 44
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Height'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object cbHeight: TComboBox
Left = 112
Top = 44
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'2048'
'2400')
end
object cbWidth: TComboBox
Left = 112
Top = 20
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
end
object GroupBox4: TGroupBox
Left = 8
Top = 176
Width = 377
Height = 113
Anchors = [akLeft, akTop, akRight]
Caption = ' Parameters '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
DesignSize = (
377
113)
object udStrips: TUpDown
Left = 172
Top = 52
Width = 12
Height = 21
Associate = txtStrips
Min = 1
Max = 512
Position = 1
TabOrder = 2
end
object Label7: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Buffer depth'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
object Label8: TPanel
Left = 8
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Strips'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 8
end
object Label9: TPanel
Left = 192
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Radius'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 9
end
object txtEstimator: TEdit
Left = 296
Top = 20
Width = 73
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
Text = '5'
OnChange = txtEstimatorChange
end
object txtStrips: TEdit
Left = 112
Top = 52
Width = 60
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
Text = '1'
end
object cmbDepth: TComboBox
Left = 112
Top = 20
Width = 73
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemIndex = 2
ParentFont = False
TabOrder = 0
Text = '32-bit float'
Items.Strings = (
'16-bit'
'32-bit'
'32-bit float'
'64-bit')
end
object Label14: TPanel
Left = 8
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Gamma threshold'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 10
end
object Label12: TPanel
Left = 192
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Curve'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 11
end
object Label11: TPanel
Left = 192
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Minimum'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 12
end
object txtGammaTreshold: TEdit
Left = 112
Top = 84
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 6
Text = '0.01'
OnChange = txtGammaTresholdChange
end
object txtEstimatorCurve: TEdit
Left = 296
Top = 52
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 5
Text = '0.6'
OnChange = txtEstimatorCurveChange
end
object txtEstimatorMin: TEdit
Left = 296
Top = 84
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 4
Text = '0'
OnChange = txtEstimatorMinChange
end
end
object chkRender: TCheckBox
Left = 400
Top = 246
Width = 89
Height = 43
Anchors = [akTop, akRight]
Caption = 'Render'
Checked = True
State = cbChecked
TabOrder = 6
end
object Panel1: TPanel
Left = 8
Top = 296
Width = 481
Height = 105
Anchors = [akLeft, akTop, akRight]
BevelKind = bkSoft
BevelOuter = bvNone
Color = clInfoBk
TabOrder = 7
OnResize = Panel1Resize
DesignSize = (
477
101)
object Label6: TLabel
Left = 8
Top = 2
Width = 453
Height = 24
Alignment = taCenter
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'WARNING!'
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label15: TLabel
Left = 8
Top = 25
Width = 465
Height = 54
Alignment = taCenter
Anchors = [akLeft, akRight]
AutoSize = False
Caption =
'Fractals created with this version of Apophysis are not supporte' +
'd by the external renderer! To render 2D-only fractals, download' +
' the latest version of FLAM3 from'
Color = clInfoBk
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentColor = False
ParentFont = False
WordWrap = True
end
object lblFlam3Link: TLabel
Left = 180
Top = 80
Width = 111
Height = 13
Cursor = crHandPoint
Hint = 'https://code.google.com/archive/p/flam3/downloads'
Caption = 'http://www.flam3.com/'
Color = clBlue
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblFlam3LinkClick
end
end
object SaveDialog: TSaveDialog
DefaultExt = 'jpg'
Filter =
'JPEG Image (*.jpg)|*.jpg|PPM Image (*.ppm)|*.ppm|PNG Images (*.p' +
'ng)|*.png'
Left = 464
Top = 264
end
end
Forms/FormExport.pas
+302
View File
@@ -0,0 +1,302 @@
{
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 FormExport;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, Translation;
type
TExportDialog = class(TForm)
btnOK: TButton;
btnCancel: TButton;
GroupBox1: TGroupBox;
btnBrowse: TSpeedButton;
txtFilename: TEdit;
SaveDialog: TSaveDialog;
GroupBox3: TGroupBox;
txtOversample: TEdit;
txtFilterRadius: TEdit;
txtDensity: TEdit;
udOversample: TUpDown;
GroupBox2: TGroupBox;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
GroupBox4: TGroupBox;
cmbDepth: TComboBox;
chkRender: TCheckBox;
txtStrips: TEdit;
udStrips: TUpDown;
txtEstimator: TEdit;
txtEstimatorMin: TEdit;
txtEstimatorCurve: TEdit;
txtGammaTreshold: TEdit;
Panel1: TPanel;
Label6: TLabel;
Label15: TLabel;
Label4: TPanel;
Label5: TPanel;
Label3: TPanel;
Label1: TPanel;
Label2: TPanel;
Label7: TPanel;
Label8: TPanel;
Label9: TPanel;
Label14: TPanel;
Label12: TPanel;
Label11: TPanel;
Label10: TPanel;
lblFlam3Link: TLabel;
procedure Panel1Resize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure txtWidthChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject);
procedure txtHeightChange(Sender: TObject);
procedure txtDensityChange(Sender: TObject);
procedure txtFilterRadiusChange(Sender: TObject);
procedure txtOversampleChange(Sender: TObject);
procedure txtEstimatorChange(Sender: TObject);
procedure txtEstimatorMinChange(Sender: TObject);
procedure txtEstimatorCurveChange(Sender: TObject);
procedure txtGammaTresholdChange(Sender: TObject);
procedure lblFlam3LinkClick(Sender: TObject);
private
FloatFormatSettings: TFormatSettings;
public
Filename: string;
ImageWidth, ImageHeight, Oversample, Batches, Strips: Integer;
Sample_Density, Filter_Radius: double;
Estimator, EstimatorMin, EstimatorCurve: double;
GammaTreshold: double;
Jitters: integer;
end;
var
ExportDialog: TExportDialog;
Ratio: double;
implementation
uses Global, Main, ShellAPI;
{$R *.DFM}
procedure TExportDialog.btnBrowseClick(Sender: TObject);
begin
SaveDialog.InitialDir := ExtractFileDir(txtFilename.text);
SaveDialog.Filename := txtFilename.Text;
case ExportFileFormat of
0: SaveDialog.DefaultExt := 'jpg';
1: SaveDialog.DefaultExt := 'ppm';
end;
SaveDialog.filterIndex := ExportFileFormat;
SaveDialog.Filter := Format('Portable Pixmap (*.ppm)|*.ppm|%s|*.jpg;*.jpeg|%s|*.png|%s|*.*',
[TextByKey('common-filter-jpeg'), TextByKey('common-filter-png'),
TextByKey('common-filter-allfiles')]);
if SaveDialog.Execute then
begin
case SaveDialog.FilterIndex of
1: txtFilename.Text := ChangeFileExt(SaveDialog.Filename, '.jpg');
2: txtFilename.Text := ChangeFileExt(SaveDialog.Filename, '.ppm');
3: txtFilename.Text := ChangeFileExt(SaveDialog.Filename, '.png');
end;
ExportFileFormat := SaveDialog.FilterIndex;
renderPath := ExtractFilePath(SaveDialog.Filename);
end;
end;
procedure TExportDialog.FormShow(Sender: TObject);
begin
txtFilename.Text := Filename;
cbWidth.Text := IntToStr(MainCp.Width);
cbHeight.Text := IntToStr(MainCp.Height);
ImageWidth := MainCp.Width;
ImageHeight := MainCp.Height;
txtDensity.text := FloatToStr(Sample_density);
txtFilterRadius.text := FloatToStr(Filter_Radius);
txtOversample.text := IntToSTr(Oversample);
udOversample.Position := Oversample;
Ratio := ImageWidth / ImageHeight;
Batches := 1;
Estimator := 9.0;
EstimatorMin := 0.0;
EstimatorCurve := 0.4;
Jitters := 1;
GammaTreshold := MainCP.gamma_threshold; //0.01;
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FloatFormatSettings);
txtEstimator.Text := FloatToStr(Estimator, FloatFormatSettings);
txtEstimatorMin.Text := FloatToStr(EstimatorMin, FloatFormatSettings);
txtEstimatorCurve.Text := FloatToStr(EstimatorCurve, FloatFormatSettings);
txtGammaTreshold.Text := FloatToStr(GammaTreshold, FloatFormatSettings);
end;
procedure TExportDialog.btnOKClick(Sender: TObject);
begin
Filename := txtFilename.text;
ImageWidth := StrToInt(cbWidth.Text);
ImageHeight := StrToInt(cbHeight.Text);
end;
procedure TExportDialog.txtWidthChange(Sender: TObject);
begin
try
ImageWidth := StrToInt(cbWidth.Text);
if chkMaintain.checked and cbWidth.Focused then
begin
ImageHeight := Round(ImageWidth / ratio);
cbHeight.Text := IntToStr(ImageHeight)
end;
except
end;
end;
procedure TExportDialog.chkMaintainClick(Sender: TObject);
begin
Ratio := ImageWidth / ImageHeight;
end;
procedure TExportDialog.txtHeightChange(Sender: TObject);
begin
try
ImageHeight := StrToInt(cbHeight.Text);
if chkMaintain.checked and cbHeight.Focused then
begin
ImageWidth := Round(ImageHeight * ratio);
cbWidth.Text := IntToStr(ImageWidth)
end;
except
end;
end;
procedure TExportDialog.txtDensityChange(Sender: TObject);
begin
try
Sample_Density := StrToFloat(txtDensity.Text);
except
end;
end;
procedure TExportDialog.txtFilterRadiusChange(Sender: TObject);
begin
try
Filter_Radius := StrToFloat(txtFilterRadius.Text);
except
end;
end;
procedure TExportDialog.txtOversampleChange(Sender: TObject);
begin
if StrToInt(txtOversample.Text) > udOversample.Max then
txtOversample.Text := IntToStr(udOversample.Max);
if StrToInt(txtOversample.Text) < udOversample.Min then
txtOversample.Text := IntToStr(udOversample.Min);
try
Oversample := StrToInt(txtOversample.Text);
except
end;
end;
procedure TExportDialog.txtEstimatorChange(Sender: TObject);
begin
Estimator := 0;
try
Estimator := StrToFloat(txtEstimator.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.txtEstimatorMinChange(Sender: TObject);
begin
EstimatorMin := 0;
try
EstimatorMin := StrToFloat(txtEstimatorMin.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.txtEstimatorCurveChange(Sender: TObject);
begin
EstimatorCurve := 0;
try
EstimatorCurve := StrToFloat(txtEstimatorCurve.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.txtGammaTresholdChange(Sender: TObject);
begin
//GammaTreshold := 0.01;
try
GammaTreshold := StrToFloat(txtGammaTreshold.Text, FloatFormatSettings);
except
end;
end;
procedure TExportDialog.lblFlam3LinkClick(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(TLabel(Sender).Hint),
nil, nil, SW_SHOWNORMAL);
end;
procedure TExportDialog.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
Label1.Caption := TextByKey('common-width');
Label2.Caption := TextByKey('common-height');
GroupBox2.Caption := TextByKey('common-size');
chkMaintain.Caption := TextByKey('common-keepaspect');
GroupBox1.Caption := TextByKey('common-destination');
Label10.Caption := TextByKey('common-filename');
btnBrowse.Hint := TextByKey('common-browse');
GroupBox3.Caption := TextByKey('common-quality');
Label5.Caption := TextByKey('common-filterradius');
Label4.Caption := TextByKey('common-density');
Label3.Caption := TextByKey('common-oversample');
Label14.Caption := TextByKey('common-gammathreshold');
self.Caption := TextByKey('main-menu-file-exportflame');
GroupBox4.Caption := TextByKey('export-paramoptions-title');
Label7.Caption := TextByKey('export-paramoptions-bufferdepth');
Label8.Caption := TextByKey('export-paramoptions-strips');
Label9.Caption := TextByKey('export-paramoptions-estimatorradius');
Label12.Caption := TextByKey('export-paramoptions-estimatorcurve');
Label11.Caption := TextByKey('export-paramoptions-estimatormin');
chkRender.Caption := TextByKey('export-paramoptions-dorender');
Label6.Caption := TextByKey('export-paramoptions-warningtitle');
Label15.Caption := TextByKey('export-paramoptions-warningtext');
end;
procedure TExportDialog.Panel1Resize(Sender: TObject);
begin
Label15.Top := (Panel1.Height - 30) div 2 - Label15.Height div 2 + 25;
end;
end.
Forms/FormExportC.dfm
+553
View File
@@ -0,0 +1,553 @@
object ExportCDialog: TExportCDialog
Left = 313
Top = 276
BorderStyle = bsDialog
Caption = 'Export Flame'
ClientHeight = 134
ClientWidth = 496
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
496
134)
PixelsPerInch = 96
TextHeight = 13
object btnOK: TButton
Left = 254
Top = 98
Width = 115
Height = 25
Anchors = [akTop, akRight]
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 376
Top = 98
Width = 111
Height = 25
Anchors = [akTop, akRight]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object GroupBox1: TGroupBox
Left = 8
Top = 237
Width = 481
Height = 57
Anchors = [akLeft, akTop, akRight]
Caption = ' Destination '
TabOrder = 2
Visible = False
DesignSize = (
481
57)
object btnBrowse: TSpeedButton
Left = 448
Top = 19
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object Label10: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'File name'
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object txtFilename: TEdit
Left = 112
Top = 20
Width = 337
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
end
object GroupBox3: TGroupBox
Left = 256
Top = 10
Width = 233
Height = 79
Anchors = [akTop, akRight]
Caption = ' Quality '
TabOrder = 3
DesignSize = (
233
79)
object udOversample: TUpDown
Left = 212
Top = 44
Width = 12
Height = 21
Anchors = [akTop, akRight]
Associate = txtOversample
Min = 1
Max = 4
Position = 2
TabOrder = 2
end
object Label5: TPanel
Left = 8
Top = 20
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Filter radius'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object txtFilterRadius: TEdit
Left = 120
Top = 20
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
OnChange = txtFilterRadiusChange
end
object Label3: TPanel
Left = 8
Top = 44
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Oversample'
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object txtOversample: TEdit
Left = 120
Top = 44
Width = 92
Height = 21
Anchors = [akLeft, akTop, akRight]
ReadOnly = True
TabOrder = 1
Text = '2'
OnChange = txtOversampleChange
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 10
Width = 241
Height = 111
Anchors = [akLeft, akTop, akRight]
Caption = ' Size '
TabOrder = 4
DesignSize = (
241
111)
object Label13: TLabel
Left = 184
Top = 36
Width = 26
Height = 13
Anchors = [akLeft, akTop, akRight]
Caption = 'pixels'
Visible = False
end
object Label16: TLabel
Left = 168
Top = 22
Width = 15
Height = 36
Anchors = [akLeft, akTop, akRight]
Caption = '}'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -32
Font.Name = 'Times New Roman'
Font.Style = []
ParentFont = False
Visible = False
end
object chkMaintain: TCheckBox
Left = 8
Top = 76
Width = 225
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Maintain aspect ratio'
Checked = True
State = cbChecked
TabOrder = 0
OnClick = chkMaintainClick
end
object Label1: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Width'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object Label2: TPanel
Left = 8
Top = 44
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Height'
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object cbHeight: TComboBox
Left = 112
Top = 44
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
ItemHeight = 13
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'2048'
'2400')
end
object cbWidth: TComboBox
Left = 112
Top = 20
Width = 121
Height = 21
Anchors = [akLeft, akTop, akRight]
ItemHeight = 13
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
end
object GroupBox4: TGroupBox
Left = 8
Top = 392
Width = 377
Height = 113
Anchors = [akLeft, akTop, akRight]
Caption = ' Parameters '
TabOrder = 5
Visible = False
DesignSize = (
377
113)
object udStrips: TUpDown
Left = 172
Top = 52
Width = 12
Height = 21
Associate = txtStrips
Min = 1
Max = 512
Position = 1
TabOrder = 2
end
object Label7: TPanel
Left = 8
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Buffer depth'
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
object Label8: TPanel
Left = 8
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Strips'
ParentShowHint = False
ShowHint = True
TabOrder = 8
end
object Label9: TPanel
Left = 8
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Radius'
ParentShowHint = False
ShowHint = True
TabOrder = 9
end
object txtEstimator: TEdit
Left = 112
Top = 84
Width = 73
Height = 21
TabOrder = 3
Text = '5'
end
object txtStrips: TEdit
Left = 112
Top = 52
Width = 60
Height = 21
TabOrder = 1
Text = '1'
end
object cmbDepth: TComboBox
Left = 112
Top = 20
Width = 73
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 0
Items.Strings = (
'16-bit'
'32-bit'
'32-bit float'
'64-bit')
end
object Label14: TPanel
Left = 192
Top = 20
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Gamma threshold'
ParentShowHint = False
ShowHint = True
TabOrder = 10
end
object Label12: TPanel
Left = 192
Top = 52
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Curve'
ParentShowHint = False
ShowHint = True
TabOrder = 11
end
object Label11: TPanel
Left = 192
Top = 84
Width = 105
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'DE Minimum'
ParentShowHint = False
ShowHint = True
TabOrder = 12
end
object txtGammaTreshold: TEdit
Left = 296
Top = 20
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 6
Text = '0.01'
OnChange = txtGammaTresholdChange
end
object txtEstimatorCurve: TEdit
Left = 296
Top = 52
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
Text = '0.6'
end
object txtEstimatorMin: TEdit
Left = 296
Top = 84
Width = 73
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
Text = '0'
end
end
object chkRender: TCheckBox
Left = 392
Top = 398
Width = 89
Height = 43
Anchors = [akTop, akRight]
Caption = 'Render'
Checked = True
State = cbChecked
TabOrder = 6
Visible = False
end
object Panel1: TPanel
Left = 8
Top = 296
Width = 481
Height = 89
Anchors = [akLeft, akTop, akRight]
BevelKind = bkSoft
BevelOuter = bvNone
Color = clInfoBk
TabOrder = 7
Visible = False
DesignSize = (
477
85)
object Label6: TLabel
Left = 8
Top = 4
Width = 453
Height = 24
Alignment = taCenter
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'WARNING!'
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label15: TLabel
Left = 8
Top = 25
Width = 447
Height = 26
Alignment = taCenter
Anchors = [akLeft, akRight]
Caption =
'Fractals created with this version of Apophysis are not supporte' +
'd by the external renderer! To render 2D-only fractals, download' +
' the latest version of FLAM3 from http://www.flam3.com'
Color = clInfoBk
Font.Charset = DEFAULT_CHARSET
Font.Color = clInfoText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentColor = False
ParentFont = False
WordWrap = True
end
end
object txtDensity: TEdit
Left = 120
Top = 212
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 8
Visible = False
OnChange = txtDensityChange
end
object Label4: TPanel
Left = 8
Top = 212
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Density'
ParentShowHint = False
ShowHint = True
TabOrder = 9
Visible = False
end
object SaveDialog: TSaveDialog
DefaultExt = 'jpg'
Filter =
'JPEG Image (*.jpg)|*.jpg|PPM Image (*.ppm)|*.ppm|PNG Images (*.p' +
'ng)|*.png'
Left = 464
Top = 264
end
end
Forms/FormExportC.pas
+257
View File
@@ -0,0 +1,257 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit FormExportC;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, Translation;
type
TExportCDialog = class(TForm)
btnOK: TButton;
btnCancel: TButton;
GroupBox1: TGroupBox;
btnBrowse: TSpeedButton;
txtFilename: TEdit;
SaveDialog: TSaveDialog;
GroupBox3: TGroupBox;
txtOversample: TEdit;
txtFilterRadius: TEdit;
udOversample: TUpDown;
GroupBox2: TGroupBox;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
GroupBox4: TGroupBox;
cmbDepth: TComboBox;
chkRender: TCheckBox;
txtStrips: TEdit;
udStrips: TUpDown;
txtEstimator: TEdit;
txtEstimatorMin: TEdit;
txtEstimatorCurve: TEdit;
txtGammaTreshold: TEdit;
Panel1: TPanel;
Label6: TLabel;
Label15: TLabel;
Label13: TLabel;
Label16: TLabel;
Label5: TPanel;
Label3: TPanel;
Label1: TPanel;
Label2: TPanel;
Label7: TPanel;
Label8: TPanel;
Label9: TPanel;
Label14: TPanel;
Label12: TPanel;
Label11: TPanel;
Label10: TPanel;
txtDensity: TEdit;
Label4: TPanel;
procedure FormCreate(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure txtWidthChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject);
procedure txtHeightChange(Sender: TObject);
procedure txtDensityChange(Sender: TObject);
procedure txtFilterRadiusChange(Sender: TObject);
procedure txtOversampleChange(Sender: TObject);
procedure txtGammaTresholdChange(Sender: TObject);
private
FloatFormatSettings: TFormatSettings;
Estimator, EstimatorMin, EstimatorCurve: double;
Jitters, Batches, Strips: integer;
public
Filename: string;
ImageWidth, ImageHeight, Oversample: Integer;
Sample_Density, Filter_Radius: double;
GammaTreshold: double;
end;
var
ExportCDialog: TExportCDialog;
Ratio: double;
implementation
uses Global, Main, ShellAPI;
{$R *.DFM}
procedure TExportCDialog.btnBrowseClick(Sender: TObject);
begin
SaveDialog.InitialDir := ExtractFileDir(txtFilename.text);
SaveDialog.Filename := txtFilename.Text;
SaveDialog.DefaultExt := 'png';
SaveDialog.filterIndex := ExportFileFormat;
SaveDialog.Filter := Format('%s|*.png|%s|*.*',
[TextByKey('common-filter-png'),
TextByKey('common-filter-allfiles')]);
if SaveDialog.Execute then
begin
ExportFileFormat := SaveDialog.FilterIndex;
renderPath := ExtractFilePath(SaveDialog.Filename);
end;
end;
procedure TExportCDialog.FormShow(Sender: TObject);
begin
txtFilename.Text := Filename;
cbWidth.Text := IntToStr(MainCp.Width);
cbHeight.Text := IntToStr(MainCp.Height);
ImageWidth := MainCp.Width;
ImageHeight := MainCp.Height;
txtDensity.text := FloatToStr(Sample_density);
// if cmbDepth.ItemIndex <> 2 then
// txtBatches.text := IntToStr(Round(Sample_density / 4));
txtFilterRadius.text := FloatToStr(Filter_Radius);
txtOversample.text := IntToSTr(Oversample);
udOversample.Position := Oversample;
Ratio := ImageWidth / ImageHeight;
Batches := 1;
Estimator := 9.0;
EstimatorMin := 0.0;
EstimatorCurve := 0.4;
Jitters := 1;
GammaTreshold := MainCP.gamma_threshold; //0.01;
GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FloatFormatSettings);
txtEstimator.Text := FloatToStr(Estimator, FloatFormatSettings);
txtEstimatorMin.Text := FloatToStr(EstimatorMin, FloatFormatSettings);
txtEstimatorCurve.Text := FloatToStr(EstimatorCurve, FloatFormatSettings);
// txtJitters.Text := IntToStr(Jitters);
txtGammaTreshold.Text := FloatToStr(GammaTreshold, FloatFormatSettings);
end;
procedure TExportCDialog.btnOKClick(Sender: TObject);
begin
Filename := txtFilename.text;
ImageWidth := StrToInt(cbWidth.Text);
ImageHeight := StrToInt(cbHeight.Text);
end;
procedure TExportCDialog.txtWidthChange(Sender: TObject);
begin
try
ImageWidth := StrToInt(cbWidth.Text);
if chkMaintain.checked and cbWidth.Focused then
begin
ImageHeight := Round(ImageWidth / ratio);
cbHeight.Text := IntToStr(ImageHeight)
end;
except
end;
end;
procedure TExportCDialog.chkMaintainClick(Sender: TObject);
begin
Ratio := ImageWidth / ImageHeight;
end;
procedure TExportCDialog.txtHeightChange(Sender: TObject);
begin
try
ImageHeight := StrToInt(cbHeight.Text);
if chkMaintain.checked and cbHeight.Focused then
begin
ImageWidth := Round(ImageHeight * ratio);
cbWidth.Text := IntToStr(ImageWidth)
end;
except
end;
end;
procedure TExportCDialog.txtDensityChange(Sender: TObject);
begin
try
Sample_Density := StrToFloat(txtDensity.Text);
// if cmbDepth.ItemIndex <> 2 then
// txtBatches.text := IntToStr(Round(Sample_density / 4));
except
end;
end;
procedure TExportCDialog.txtFilterRadiusChange(Sender: TObject);
begin
try
Filter_Radius := StrToFloat(txtFilterRadius.Text);
except
end;
end;
procedure TExportCDialog.txtOversampleChange(Sender: TObject);
begin
if StrToInt(txtOversample.Text) > udOversample.Max then
txtOversample.Text := IntToStr(udOversample.Max);
if StrToInt(txtOversample.Text) < udOversample.Min then
txtOversample.Text := IntToStr(udOversample.Min);
try
Oversample := StrToInt(txtOversample.Text);
except
end;
end;
procedure TExportCDialog.txtGammaTresholdChange(Sender: TObject);
begin
//GammaTreshold := 0.01;
try
GammaTreshold := StrToFloat(txtGammaTreshold.Text, FloatFormatSettings);
except
end;
end;
procedure TExportCDialog.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
Label1.Caption := TextByKey('common-width');
Label2.Caption := TextByKey('common-height');
GroupBox2.Caption := TextByKey('common-size');
Label13.Caption := TextByKey('common-pixels');
chkMaintain.Caption := TextByKey('common-keepaspect');
GroupBox1.Caption := TextByKey('common-destination');
Label10.Caption := TextByKey('common-filename');
btnBrowse.Hint := TextByKey('common-browse');
GroupBox3.Caption := TextByKey('common-quality');
Label5.Caption := TextByKey('common-filterradius');
Label4.Caption := TextByKey('common-density');
Label3.Caption := TextByKey('common-oversample');
Label14.Caption := TextByKey('common-gammathreshold');
self.Caption := TextByKey('main-menu-file-exportchaotica');
GroupBox4.Caption := TextByKey('export-paramoptions-title');
Label7.Caption := TextByKey('export-paramoptions-bufferdepth');
Label8.Caption := TextByKey('export-paramoptions-strips');
Label9.Caption := TextByKey('export-paramoptions-estimatorradius');
Label12.Caption := TextByKey('export-paramoptions-estimatorcurve');
Label11.Caption := TextByKey('export-paramoptions-estimatormin');
chkRender.Caption := TextByKey('export-paramoptions-dorender');
Label6.Caption := TextByKey('export-paramoptions-warningtitle');
Label15.Caption := TextByKey('export-paramoptions-warningtext');
end;
end.
Forms/FormFavorites.dfm
+338
View File
@@ -0,0 +1,338 @@
object FavoritesForm: TFavoritesForm
Left = 493
Top = 541
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Favorite Scripts'
ClientHeight = 275
ClientWidth = 352
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001001010200000000000680400001600000028000000100000002000
0000010020000000000000040000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000D3D8ED00EFEFF800577FD1006988DA00EFEFFA00D3D9F600F8F9FE000000
0000000000000000000000000000000000000000000000000000BABADD009497
CB005B88CB007682CA004583D2005682DB00607ED700297DE100D1D8F6000000
000000000000000000000000000000000000F9F9FC008080C2003737C600211D
B3003C5DB40065A7E0004497DF00419CE50032AFE800597FDF00EFEFFC000000
0000000000000000000000000000E9E9F3006161B300302FD2002D2EE2004E65
D700415CB8005CA8E00084F8FF0066F9FF0032A3E8004880DF007295EA000000
00000000000000000000D0D0E5004949AF003232DE001C1BE5000001BF00557D
CC006F9BE00061AFE80090FFFF006DFFFF0033AFEB002BA6E700348AE7000000
000000000000B1B1D1003434AD002A2AE6001010E2000000D1000000D6000105
CD001F35C30066A9DE0057BAEB0049C2EF0033AFE700697DDC00D7DAF700FDFD
FE009898C3002727B6002929F0000C0CE1000000D6000000DD000000E2000208
D6006299D8003C5CD2002E73D7003B73E6002B7EEB003698E600DDE1F600B5B5
D1002424B8003C3CFE004646FD003D3DF4002828EF000A0AE8000000E8000205
E5001021D7000000D9002E70DB002C63DF00180EEC002134C600C9C9DF004C4C
A8004242F5006565FF006767FF006868FF006969FF005858FB002C2CF5000000
F2000000EF000000EB000612DC00030ED4000501E0002019D9007E7EB5003232
B4007171FF008181FF007B7BFF007B7BFF007D7DFF008181FF008080FF005959
FC001B1BF5000000EE000000E8000000E1000000D8001313EB004646A9003D3D
B7009191FF009898FF009494FF009494FF009494FF009494FF009595FF009C9C
FF008E8EFE005151F8001414EC000000E1000000D7000909EB004040A8004C4C
A2009F9FFC00B9B9FF00ACACFF00ACACFF00ACACFF00ACACFF00B2B2FF00B0B0
FF00B2B2FF00B6B6FF009797FC006565F1004646EC003030E7006969A7009B9B
BB006969C500D3D3FF00D7D7FF00D0D0FF00D1D1FF00D7D7FF00CBCBFF00CECE
FF00D5D5FF00D2D2FF00D8D8FF00E4E4FF00C9C9FF005353AF00C4C4D500F5F5
F7007B7BA6006D6DBD00BFBFF100D6D6FF00D5D5FF00B4B4F8005757D6006A6A
DC00C0C0FD00D7D7FF00D5D5FF00B4B4E9005C5CAB009B9BB700FDFDFE000000
0000F7F7F900ACACC00061619B005454A8004F4FAB004C4C9E008B8BAE007C7C
A6004A4AA0005151AB005454A4006A6A9E00C1C1D000FEFEFE00000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FF80
0000FE000000F8000000F0000000E0000000C000000000000000000000000000
0000000000000000000000000000000000000000000080010000FFFF0000}
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
352
275)
PixelsPerInch = 96
TextHeight = 13
object btnMoveUp: TSpeedButton
Left = 241
Top = 80
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move &Up'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAE5D36
A23C0FA93F0BB24D17EBCEBEFFFFFFFFFFFFFFFFFFFFFFFFF8E1D2E46D1EE966
0EF16B0EF9822BFFFFFFFFFFFFA64A1EE4A66EE79146D06620B95F33FBF4F1FF
FFFFFFFFFFFDF7F3DC793FEA7720F89A40FA9D44F5720FFFFFFFFFFFFFA95233
E0B18AFFDA96FEA754BF5212CD8F73FFFFFFFFFFFFDFA282D96B21FD9433FFA9
4CF79B43ED7420FFFFFFFFFFFFDFC0B5A14423F1CEA8FFC882F09546B14510EC
D4C7F3E0D6C76128F58C36FF7F14FA8524E06109F7C7A8FFFFFFFFFFFFFFFFFF
C0816FB87155FDE2BAFFBE72D97831B55B31BF6B43DF8346FF7A14FF7406E05F
07E59461FFFFFFFFFFFFFFFFFFFFFFFFF8F0EDA74F32D5A992FFE5B5FDB362BC
5417BC5013FD8323FF6D00E86302CE6625FAEBE1FFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFE1C4B89F4020ECD7C5FFDBA5F6A456F48B36FF8117F46902BF4A01EBC1
A7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC38773B2684FFBF3DFFF
C987FFAC5BFD963BC65108D08A64FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFDFAF9A64D32CEA394FFF3D6FFC47BD87D38AF5228FBF5F2FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9D2C9A04226EC
DCD4F2D0A9A24016E5C8BAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFC68D7DB2674AB97559C0826FFFFEFEFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8F6AE
5D3CAB5634FBF7F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveUpClick
end
object btnMoveDown: TSpeedButton
Left = 241
Top = 112
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move &Down'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFEF9F6EB7F38F07D30FEF6F0FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEAA177E9
7522F0822CF39F6AFFFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFF3D5C3DA6219F8B46FFC9036EB6008F9D1B5FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDF9F6D2672EEB9C5FFF
BA73FF760BF56903EC7623FEF5EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFD9916DD77538FDD29EFF9B44FF8420FE770EEE6300F0995DFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE7C4B1C15117F5CBA3FFC484F9
9138F8872CFF8521FB7209E85F00F7C4A1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F7EEE9BC592DE3AD88FFE3B9FEB267D66317D75F11FE963CFF821BF56C07E873
22FCE9DBFFFFFFFFFFFFFFFFFFFFFFFFC6816AC87B56FEF0D9FFD99EE28B46CE
6C36D57741E6853DFF973BFF7B14ED6604EE965AFFFFFFFFFFFFFFFFFFDDBAAF
AA4923F4E6D9FFF7D1F1BF85BF521AF3DBCDF7E6DBCF6225F4A05CFF8E2FFB78
12E65F01F5C5A3FFFFFFFFFFFFA95131E3C6BDFFFFFFFDF2C7C16430D59479FF
FFFFFFFFFFE3A688D46E35FDA75DFF8C28F77612E76D17FFFFFFFFFFFFA74F28
E1C4B2E3C7AACC8E61B85C36FBF5F2FFFFFFFFFFFFFDF7F4D37742E07529F382
28F47618E46103FFFFFFFFFFFFB0613D9D3B179D3A14A7461CECD3C6FFFFFFFF
FFFFFFFFFFFFFFFFF6E3D7CF6220D1570CD65B0BE1772FFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveDownClick
end
object btnAdd: TSpeedButton
Left = 241
Top = 16
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = '&Add'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
9CD8F52195E1B7D7F3FFFFFFFFFFFFFFFFFFFFFFFFF0F6FC3A80811A6B3E196B
3725734184B094FFFFFFFFFFFFFFFFFFBBE7F935B9EB209BE366AAE5F3F8FDFF
FFFFB7D9F21A7782288C5364BA8D95D2B264BA8D288C5381AE91FFFFFFFFFFFF
F7FCFE1BB0EBADE7F83AB1E9248ADC60ABE5249FE11D6F3F62BA8B60BA87FFFF
FF60B98767BC8F20703DFFFFFFFFFFFFFFFFFF58C7F283D7F58DDEF672D3F355
C3EE75D7F4317B4C9CD4B6FFFFFFFFFFFFFFFFFF95D2B2196B37FFFFFFFFFFFF
FFFFFF9BDEF853C6F089DDF576D7F46FD5F463D2F345896290D3B192D6B1FFFF
FF65BC8C67BC8F20703DFFFFFFFFFFFFF3FBFE51C2F277D5F589DCF678D8F46E
D5F366D3F361B2AE61AB8195D4B4BAE6D06ABB8F2D8F5781AE91FFFFFFDBF2FD
27AEF151C7F4A1E3F78ADDF67FD9F575D7F46CD4F36FD5F357ACB15493734F8E
664A8A6199BDA6FFFFFFB1E6FC0CACF46AD2F6C3EDFAABE7F99AE1F788DCF57E
D9F57AD8F57ED9F58BDDF686D9F42CA5E54E9CE0F3F9FDFFFFFF30C7FA41CAF8
41C9F740C8F63FC6F57DD7F79CE1F78BDCF67CD7F54EC4F038BAED39BAEC34B5
EA14A8E4A2D9F3FFFFFFF7FDFFD5F4FED2F3FED2F2FDB1B5AA36B3DA9BE1F8A1
E3F849C5F282ACB5D2F0FBD2EFFBD2EFFBE3F5FCFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFD8B69AC18E5E7AB9C06CD4F7AAE5F916A6E2B48055CEAC92FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDABA9DC69564D9BC95BBAF8A17BBF370
D5F75BA4B7D3B08BB78154CEAC92FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B97940DDC299D5B581C99E5F45B5D12EC3F59E9873CDA575D3B28BA25E2AFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBC7D42E2CCA4CEA867CCA46495AB8F51
B1C1C6995BC49658DABC97A5612DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
BE8045E4CFA6D1AD6BCFAA68CDA666CBA363C99F60C79B5DDCC099A86530FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC18347E5D1A8D3B26FD2AE6DD0AB6ACE
A867CCA565CAA161DDC49DAB6933FFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnAddClick
end
object btnRemove: TSpeedButton
Left = 241
Top = 48
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = '&Remove'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
9CD8F52195E1B7D7F3FFFFFFFFFFFFFFFFFFFFFFFFF0F6FC417ACD084ABA0543
BC1F59C186A6DDFFFFFFFFFFFFFFFFFFBBE7F935B9EB209BE366AAE5F3F8FDFF
FFFFB7D9F21A6DCA2565C92177E60579EA0164DD074FBE86A6DDFFFFFFFFFFFF
F7FCFE1BB0EBADE7F83AB1E9248ADC60ABE5249FE10E53BF639DF4187FFF0076
F80076EE0368E11E59C0FFFFFFFFFFFFFFFFFF58C7F283D7F58DDEF672D3F355
C3EE75D7F40443BCAECDFEFFFFFFFFFFFFFFFFFF187FEF0543BCFFFFFFFFFFFF
FFFFFF9BDEF853C6F089DDF576D7F46FD5F463D2F31257C18DB5F64D92FF1177
FF2186FF408AEB245CC2FFFFFFFFFFFFF3FBFE51C2F277D5F589DCF678D8F46E
D5F366D3F34B9ADE3773D18DB5F7B8D6FE72A8F52F6DCC94AFE2FFFFFFDBF2FD
27AEF151C7F4A1E3F78ADDF67FD9F575D7F46CD4F36FD5F33B91DB0C52C30543
BC205AC188A7DEFFFFFFB1E6FC0CACF46AD2F6C3EDFAABE7F99AE1F788DCF57E
D9F57AD8F57ED9F58BDDF686D9F42CA5E54E9CE0F3F9FDFFFFFF30C7FA41CAF8
41C9F740C8F63FC6F57DD7F79CE1F78BDCF67CD7F54EC4F038BAED39BAEC34B5
EA14A8E4A2D9F3FFFFFFF7FDFFD5F4FED2F3FED2F2FDB1B5AA36B3DA9BE1F8A1
E3F849C5F282ACB5D2F0FBD2EFFBD2EFFBE3F5FCFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFD8B69AC18E5E7AB9C06CD4F7AAE5F916A6E2B48055CEAC92FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDABA9DC69564D9BC95BBAF8A17BBF370
D5F75BA4B7D3B08BB78154CEAC92FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B97940DDC299D5B581C99E5F45B5D12EC3F59E9873CDA575D3B28BA25E2AFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBC7D42E2CCA4CEA867CCA46495AB8F51
B1C1C6995BC49658DABC97A5612DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
BE8045E4CFA6D1AD6BCFAA68CDA666CBA363C99F60C79B5DDCC099A86530FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC18347E5D1A8D3B26FD2AE6DD0AB6ACE
A867CCA565CAA161DDC49DAB6933FFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnRemoveClick
end
object btnSort: TSpeedButton
Left = 241
Top = 144
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = ' &Sort'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFBFBFF
C7C7FFA7A7FFA4A4FFA4A4FFA6A6FFD5D5FFFDFDFFFFFFFFC8C8C82828289898
98FFFFFFFFFFFFFFFFFFFFFFFFF6F6FF6A6AFF1010FF1D1DFF3434FF3C3CFFA3
A3FFFCFCFFF9F9F98484841717175C5C5CE4E4E4FFFFFFFFFFFFFFFFFFFCFCFF
A2A2FF1D1DFF2A2AFFA2A2FFD1D1FFE9E9FFFFFFFFD8D8D83E3E3E1010102626
26B0B0B0FCFCFCFFFFFFFFFFFFFFFFFFEBEBFF7373FF1616FF6F6FFFEFEFFFFF
FFFFFFFFFF9090902625261A19191F1F1F636363F3F3F3FFFFFFFFFFFFFFFFFF
FFFFFFD9D9FF4D4DFF1B1BFF9A9AFFF9F9FFFFFFFFCECDCD8988883737377070
70BABABAFAFAFAFFFFFFFFFFFFFEFEFFDFDFFFBFBFFF7777FF1010FF3232FFCE
CEFFFFFFFFFFFFFFD3D3D34E4E4EABABABFFFFFFFFFFFFFFFFFFFFFFFFFBFBFF
9C9CFF3B3BFF2D2DFF2525FF2C2CFFBABAFFFFFFFFFFFFFFD4D4D4575757AFAF
AFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFE4E4FFC6C6FFC2C2FFC2C2FFC6C6FFEE
EEFFFFFFFFFFFFFFD7D6D6626262B4B4B4FFFFFFFFFFFFFFFFFFFFFFFFFEFCFB
F6E1D1F8E4D5FFFDFBFFFFFDF9E8DAF4DDCBFDFAF7FFFFFFD9D9D96D6D6DB9B9
B9FFFFFFFFFFFFFFFFFFFFFFFFFCF8F4DC9B67D68A4CF2DAC6F5E3D4D99259D7
8C4FFAEFE7FFFFFFDDDDDC797979BFBFBFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFA
E4B188CA6717D07932D27D38C96210DD9D6AFCF6F2FFFFFFE0E0DF858584C4C5
C4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1D6C0CD7024CE7228CF752DC96412EB
C4A5FFFEFEFFFFFFE3E3E2919190CACACAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F9EDE3D88F54CF752CD07730D27F3BF5E2D3FFFFFFFFFFFFE6E6E69D9D9DD0D0
D0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFAE5B48CC8600CC65B05DD9D6AFC
F8F4FFFFFFFFFFFFE9E9E9A9A9A9D6D6D6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFF0D4BDCF752DCC6B1DEAC3A3FFFFFFFFFFFFFFFFFFECECECB8B8B8DCDC
DCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF5EFEFD2BAEDCCB1FAF0E8FF
FFFFFFFFFFFFFFFFF9F9F9E7E7E7F3F3F3FFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnSortClick
end
object btnClear: TSpeedButton
Left = 241
Top = 176
Width = 99
Height = 25
BiDiMode = bdLeftToRight
Caption = ' &Clear'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000CC483FBEBEBE
9F9F9FA1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1
A19F9F9FB4B4B4CC483FC7C7C7BABABAEAEAEAF2F2F2F5F5F5F7F7F7F9F9F9FB
FBFBFCFCFCFBFBFBF9F9F9F7F7F7F5F5F5F1F1F1CACACAB0B0B0A4A4A4E3E3E3
6E6EE41717DB1616D91414D81313D71212D61111D61212D61212D71414D81515
D95454E1F0F0F0A3A3A3A0A0A0E9E9E92929DF1313DC1111DA1010D90E0ED80E
0ED80E0ED80E0ED80E0ED80F0FD91111DA1212DCF1F1F1A9A9A9A0A0A0E9E9E9
2B2BE11515DE1717DD7F80E56566E31111DA1111DA3838DE898AE63031DF1313
DD1515DEF1F1F1A9A9A9A0A0A0E8E8E82D2DE31818E04E4FE3ECEEEEECEEEE7B
7CE54444E0E0E2EDECEEEE8E8FE71616DF1818E0F0F0F0A9A9A9A0A0A0E7E7E7
2E2EE41A1AE32020E2C6C8ECECEEEEECEEEEE6E8EDECEEEEE4E6EE4949E41919
E11A1AE2EFEFEFA9A9A9A0A0A0E6E6E63131E61D1DE51C1CE42C2DE4D0D2EDEC
EEEEECEEEEE9EBEE5152E61B1BE31C1CE41D1DE5EDEDEDA9A9A9A0A0A0E5E5E5
3333E82020E71F1FE74F4FE8E2E4EEECEEEEECEEEEECEEEE8485EA1E1EE61F1F
E62020E7ECECECA8A8A8A0A0A0E3E3E33636EB2323EA3F40EAE3E5EEECEEEEE4
E7EED1D3EDECEEEEECEEEE696AEA2222E92323EAEAEAEAA8A8A8A0A0A0E1E1E1
3838ED2626EC5252ECECEEEEE4E6EE5859EC3435ECC8CAEDECEEEE8E8FED2525
EC2626ECE8E8E8A8A8A8A0A0A0E0E0E03939EE2828EE2828EE5657EE3E3EEE27
27ED2727ED3434ED5F5FED3030EE2828EE2828EEE6E6E6A8A8A8A0A0A0DEDEDE
3D3DED2828EE2828EE2828EE2828EE2828EE2828EE2828EE2828EE2828EE2828
EE2B2BEEE4E4E4A8A8A8A9A9A9D2D2D29D9DE75D5DEB5C5CEB5D5DEC5D5DEC5D
5DEC5D5DEC5D5DEC5D5DEC5D5DEC5C5CEB8D8DE8DFDFDFA1A1A1D2D2D2A9A9A9
CBCBCBD4D4D4D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5
D5D0D0D0B2B2B2BBBBBBCC483FDBDBDBB3B3B3ACACACACACACACACACACACACAC
ACACACACACACACACACACACACACACACACACAFAFAFD1D1D1CC483F}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnClearClick
end
object ScriptList: TListView
Left = 16
Top = 16
Width = 218
Height = 215
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
AutoSize = True
Caption = 'Name'
end>
HideSelection = False
ReadOnly = True
RowSelect = True
ParentShowHint = False
ShowColumnHeaders = False
ShowHint = True
TabOrder = 0
ViewStyle = vsReport
OnChange = ScriptListChange
OnInfoTip = ScriptListInfoTip
end
object btnOK: TButton
Left = 180
Top = 246
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&OK'
TabOrder = 1
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 260
Top = 246
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&Cancel'
ModalResult = 2
TabOrder = 2
end
end
Forms/FormFavorites.pas
+273
View File
@@ -0,0 +1,273 @@
{
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 FormFavorites;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Translation, Vcl.Buttons;
type
TFavoritesForm = class(TForm)
ScriptList: TListView;
btnMoveUp: TSpeedButton;
btnMoveDown: TSpeedButton;
btnOK: TButton;
btnCancel: TButton;
btnAdd: TSpeedButton;
btnRemove: TSpeedButton;
btnSort: TSpeedButton;
btnClear: TSpeedButton;
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnRemoveClick(Sender: TObject);
procedure ScriptListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure btnMoveUpClick(Sender: TObject);
procedure btnMoveDownClick(Sender: TObject);
procedure ScriptListInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: string);
procedure btnSortClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
private
{ Private declarations }
public
Faves: TStringList;
{ Public declarations }
end;
var
FavoritesForm: TFavoritesForm;
implementation
uses Global, ScriptForm;
{$R *.DFM}
procedure TFavoritesForm.FormShow(Sender: TObject);
var
ListItem: TListItem;
i: integer;
s: string;
begin
Faves.Text := Favorites.Text;
ScriptList.Items.Clear;
for i := 0 to Favorites.Count - 1 do
begin
ListItem := ScriptList.Items.Add;
s := ExtractFileName(Favorites[i]);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
Listitem.Caption := s;
end;
if Favorites.Count <> 0 then
ScriptList.Selected := ScriptList.Items[0]
else
btnRemove.Enabled := False;
if ScriptList.Items.Count <= 1 then
begin
btnMoveUp.Enabled := False;
btnMoveDown.Enabled := False;
end;
end;
procedure TFavoritesForm.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
Faves.SaveToFile(AppPath + scriptFavsFilename);
end;
procedure TFavoritesForm.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
self.Caption := TextByKey('favscripts-title');
btnAdd.Caption := TextByKey('favscripts-add');
btnRemove.Caption := TextByKey('favscripts-remove');
btnMoveUp.Caption := TextByKey('favscripts-moveup');
btnMoveDown.Caption := TextByKey('favscripts-movedown');
btnSort.Caption := TextByKey('varorder-byname'); // AV
btnClear.Caption := TextByKey('common-clear'); // AV
Faves := TStringList.Create;
end;
procedure TFavoritesForm.FormDestroy(Sender: TObject);
begin
Faves.Free;
end;
procedure TFavoritesForm.btnAddClick(Sender: TObject);
var
ListItem: TListItem;
i : integer;
s: string;
begin
s := AppPath + 'Scripts';
if DirectoryExists(s) then
ScriptEditor.MainOpenDialog.InitialDir := s
else ScriptEditor.MainOpenDialog.InitialDir := ParamFolder;
ScriptEditor.MainOpenDialog.Filter := Format('%s|*.aposcript;*.asc|%s|*.*',
[TextByKey('common-filter-scriptfiles'),
TextByKey('common-filter-allfiles')]);
if ScriptEditor.mainOpenDialog.Execute then
begin
for i := 0 to Faves.Count - 1 do
begin
if ScriptEditor.MainOpenDialog.Filename = Faves[i] then exit;
end;
Faves.add(ScriptEditor.MainOpenDialog.Filename);
ListItem := ScriptList.Items.Add;
s := ExtractFileName(ScriptEditor.MainOpenDialog.Filename);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
Listitem.Caption := s;
ScriptList.Selected := ScriptList.Items[ScriptList.Items.Count - 1];
btnRemove.Enabled := True;
end;
if ScriptList.Items.Count <= 1 then
begin
btnMoveUp.Enabled := False;
btnMoveDown.Enabled := False;
end;
end;
procedure TFavoritesForm.btnRemoveClick(Sender: TObject);
var
i: integer;
begin
if not assigned(ScriptList.Selected) then exit; // AV
i := ScriptList.Selected.Index;
Faves.Delete(i);
ScriptList.Items[i].delete;
if ScriptList.Items.Count <> 0 then
if i < ScriptList.Items.Count then
ScriptList.Selected := ScriptList.Items[i]
else
ScriptList.Selected := ScriptList.Items[ScriptList.Items.Count - 1]
else
btnRemove.Enabled := False;
if ScriptList.Items.Count <= 1 then
begin
btnMoveUp.Enabled := False;
btnMoveDown.Enabled := False;
end;
end;
procedure TFavoritesForm.btnSortClick(Sender: TObject);
var
scripts: TStringList;
i : integer;
begin
if (ScriptList.Items.Count <= 1) then exit;
scripts := TStringList.Create;
for i := 0 to Faves.Count - 1 do
scripts.AddPair(ScriptList.Items[i].Caption, Faves[i]);
ScriptList.Items.BeginUpdate;
scripts.Sort;
for i := 0 to Faves.Count - 1 do
begin
ScriptList.Items[i].Caption := scripts.Names[i];
Faves[i] := scripts.ValueFromIndex[i];
end;
ScriptList.Items.EndUpdate;
scripts.Free;
end;
procedure TFavoritesForm.ScriptListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
// TODO: optimize old code
btnRemove.Enabled := (ScriptList.Items.Count > 0);
if (Item.Index = ScriptList.Items.Count - 1) then
btnMoveDown.Enabled := False
else
btnMoveDown.Enabled := True;
if (Item.Index = 0) then
btnMoveUp.Enabled := False
else
btnMoveUp.Enabled := True;
if (ScriptList.Items.Count <= 1) then
begin
btnMoveDown.Enabled := False;
btnMoveUp.Enabled := False;
end;
end;
procedure TFavoritesForm.ScriptListInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: string);
begin
InfoTip := Faves[Item.Index]; // AV: show the corresponding full file name
end;
procedure TFavoritesForm.btnMoveUpClick(Sender: TObject);
var
i: integer;
s: string;
begin
if not assigned(ScriptList.Selected) then exit; // AV
i := ScriptList.Selected.Index;
s := Faves[i];
Faves[i] := Faves[i - 1];
Faves[i - 1] := s;
s := ScriptList.Selected.Caption;
ScriptList.Selected.Caption := ScriptList.Items[i - 1].Caption;
ScriptList.Items[i - 1].Caption := s;
ScriptList.Selected := ScriptList.Items[i - 1];
end;
procedure TFavoritesForm.btnClearClick(Sender: TObject);
begin
ScriptList.Items.Clear;
Faves.Clear;
btnRemove.Enabled := False;
end;
procedure TFavoritesForm.btnMoveDownClick(Sender: TObject);
var
i: integer;
s: string;
begin
if not assigned(ScriptList.Selected) then exit; // AV
i := ScriptList.Selected.Index;
s := faves[i];
Faves[i] := Faves[i + 1];
Faves[i + 1] := s;
s := ScriptList.Selected.Caption;
ScriptList.Selected.Caption := ScriptList.Items[i + 1].Caption;
ScriptList.Items[i + 1].Caption := s;
ScriptList.Selected := ScriptList.Items[i + 1];
end;
end.
Forms/FormRender.dfm
+971
View File
@@ -0,0 +1,971 @@
object RenderForm: TRenderForm
Left = 851
Top = 205
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Render to Disk'
ClientHeight = 532
ClientWidth = 497
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
497
532)
PixelsPerInch = 96
TextHeight = 13
object btnRender: TButton
Left = 252
Top = 483
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Start'
Default = True
TabOrder = 0
OnClick = btnRenderClick
end
object btnCancel: TButton
Left = 412
Top = 483
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Close'
TabOrder = 1
OnClick = btnCancelClick
end
object btnPause: TButton
Left = 332
Top = 483
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Pause'
TabOrder = 2
OnClick = btnPauseClick
end
object PageCtrl: TPageControl
Left = 8
Top = 8
Width = 481
Height = 436
ActivePage = TabSettings
Anchors = [akLeft, akTop, akRight, akBottom]
Images = MainForm.Buttons
TabOrder = 3
object TabSettings: TTabSheet
Caption = 'Settings'
ImageIndex = 18
DesignSize = (
473
407)
object btnBrowse: TSpeedButton
Left = 416
Top = 7
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object btnGoTo: TSpeedButton
Left = 440
Top = 7
Width = 24
Height = 24
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FF964924EADBD3FF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF9D
4D259D4E28EADBD3FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFCF835D9247239A4B25A24F27AB5429BF6A3FA0502AEADBD3FF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFD78B65FDB089F7905CEC8856DE
7F4FD17648C46E42A25631EADBD3FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFDE926CFCB997FDA578FC935EF28C59E58453D87B4CC66E41AE582BFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFE49872FBC3A6FDBE9EFEAE85FF
A87DF89D6FE58351AE582BF4E7E1FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFE89C76E29670DA8E68D1855FDB906AF79A6BAE582BF4E7E1FF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFE5
9973C5764EF3E6DFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFE89C76F8EDE8FF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnGoToClick
end
object GroupBox5: TGroupBox
Left = 5
Top = 35
Width = 425
Height = 57
Caption = 'Preset'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
object btnSavePreset: TSpeedButton
Left = 368
Top = 18
Width = 24
Height = 24
Hint = 'Save Preset'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnSavePresetClick
end
object btnDeletePreset: TSpeedButton
Left = 392
Top = 18
Width = 24
Height = 24
Hint = 'Delete Preset'
Caption = 'r'
Flat = True
Font.Charset = SYMBOL_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Marlett'
Font.Style = [fsItalic]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDeletePresetClick
end
object cmbPreset: TComboBox
Left = 10
Top = 20
Width = 351
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = cmbPresetChange
end
end
object GroupBox2: TGroupBox
Left = 5
Top = 92
Width = 233
Height = 97
Anchors = [akLeft, akTop, akRight]
Caption = 'Size'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
DesignSize = (
233
97)
object lblRatio: TLabel
Left = 12
Top = 72
Width = 56
Height = 13
Caption = 'Aspect ratio'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object pnlWidth: TPanel
Left = 8
Top = 20
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Width'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
end
object pnlHeight: TPanel
Left = 8
Top = 44
Width = 113
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Height'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
end
object cbHeight: TComboBox
Left = 120
Top = 44
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
TabOrder = 1
OnChange = txtHeightChange
OnExit = cbHeightExit
OnKeyPress = NumFieldKeyPress
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'1920'
'2048'
'2400')
end
object cbWidth: TComboBox
Left = 120
Top = 20
Width = 105
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
TabOrder = 0
OnChange = txtWidthChange
OnExit = cbWidthExit
OnKeyPress = NumFieldKeyPress
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
object cbAspectRatio: TComboBox
Left = 101
Top = 70
Width = 123
Height = 21
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 4
OnChange = cbAspectRatioChange
Items.Strings = (
'Custom'
'Maintain aspect ratio'
'3 : 2 (Classic Film)'
'4 : 3 (Standart Monitor)'
'5 : 4 '
'16 : 9 (HD Video)'
'16 : 10'
'21 : 9 (CinemaScope)')
end
end
object GroupBox3: TGroupBox
Left = 248
Top = 92
Width = 218
Height = 97
Anchors = [akTop, akRight]
Caption = 'Quality settings'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
DesignSize = (
218
97)
object udOversample: TUpDown
Left = 196
Top = 68
Width = 15
Height = 21
Anchors = [akTop, akRight]
Associate = txtOversample
Min = 1
Max = 4
Position = 1
TabOrder = 3
end
object pnlDensity: TPanel
Left = 8
Top = 20
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Density'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 4
end
object pnlFilter: TPanel
Left = 8
Top = 44
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Filter radius'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 5
end
object pnlOversample: TPanel
Left = 8
Top = 68
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Oversample'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 6
end
object txtDensity: TComboBox
Left = 128
Top = 20
Width = 82
Height = 21
AutoComplete = False
Anchors = [akLeft, akTop, akRight]
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnChange = txtDensityChange
OnCloseUp = txtDensityChange
OnExit = txtDensityExit
OnKeyPress = NumFieldKeyPress
Items.Strings = (
'200'
'500'
'1000'
'2000'
'4000')
end
object txtFilterRadius: TEdit
Left = 128
Top = 44
Width = 68
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
TabOrder = 1
Text = '0.1'
OnExit = txtFilterRadiusExit
OnKeyPress = NumFieldKeyPress
end
object txtOversample: TEdit
Left = 128
Top = 68
Width = 68
Height = 21
Anchors = [akLeft, akTop, akRight]
BiDiMode = bdLeftToRight
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentBiDiMode = False
ParentFont = False
ReadOnly = True
TabOrder = 2
Text = '1'
OnChange = txtOversampleChange
OnKeyPress = NumFieldKeyPress
end
object sbFilterRadius: TSpinButton
Left = 196
Top = 44
Width = 15
Height = 21
DownGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000008080000080800000808000000000000080800000808000008080000080
8000008080000080800000808000000000000000000000000000008080000080
8000008080000080800000808000000000000000000000000000000000000000
0000008080000080800000808000000000000000000000000000000000000000
0000000000000000000000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
FocusControl = txtFilterRadius
TabOrder = 7
UpGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000000000000000000000000000000000000000000000000000000000000080
8000008080000080800000000000000000000000000000000000000000000080
8000008080000080800000808000008080000000000000000000000000000080
8000008080000080800000808000008080000080800000808000000000000080
8000008080000080800000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
OnDownClick = sbFilterRadiusDownClick
OnUpClick = sbFilterRadiusUpClick
end
end
object GroupBox4: TGroupBox
Left = 5
Top = 192
Width = 461
Height = 99
Anchors = [akLeft, akTop, akRight]
Caption = 'Resource usage'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
DesignSize = (
461
99)
object lblApproxMem: TLabel
Left = 431
Top = 100
Width = 50
Height = 13
Alignment = taRightJustify
Caption = '0000 Mb'
Visible = False
end
object lblPhysical: TLabel
Left = 439
Top = 96
Width = 42
Height = 13
Alignment = taRightJustify
Caption = '0000 Mb'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Visible = False
end
object lblMaxbits: TLabel
Left = 433
Top = 116
Width = 40
Height = 13
Hint = '- No render stats -'
Alignment = taRightJustify
Caption = '99.999'
ParentShowHint = False
ShowHint = True
Visible = False
end
object Label9: TLabel
Left = 440
Top = 108
Width = 117
Height = 13
Hint = '- No render stats -'
Caption = 'Max bits per sample:'
ParentShowHint = False
ShowHint = True
Visible = False
end
object lblMemory: TLabel
Left = 11
Top = 12
Width = 445
Height = 24
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption =
'The render process will use 0000 Mb of 0000MB available physical' +
' memory'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Layout = tlCenter
WordWrap = True
ExplicitWidth = 442
end
object lblCPUCores: TLabel
Left = 11
Top = 35
Width = 445
Height = 26
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Layout = tlCenter
WordWrap = True
ExplicitWidth = 442
end
object chkLimitMem: TCheckBox
Left = 444
Top = 134
Width = 125
Height = 17
Caption = 'Limit memory usage to:'
TabOrder = 0
Visible = False
end
object pnlLimit: TPanel
Left = 8
Top = 68
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Memory limit'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
end
object cbMaxMemory: TComboBox
Left = 128
Top = 68
Width = 97
Height = 21
Style = csDropDownList
BiDiMode = bdLeftToRight
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemIndex = 0
ParentBiDiMode = False
ParentFont = False
TabOrder = 1
Text = 'No limit'
OnChange = cbMaxMemoryChange
Items.Strings = (
'No limit'
'32'
'64'
'128'
'256'
'512'
'1024'
'1536')
end
object PBMem: TProgressBar
Left = 232
Top = 68
Width = 217
Height = 21
TabOrder = 3
end
end
object GroupBox1: TGroupBox
Left = 5
Top = 303
Width = 220
Height = 81
Caption = 'Output options'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
DesignSize = (
220
81)
object chkSave: TCheckBox
Left = 8
Top = 16
Width = 204
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Save parameters in a flame'
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
State = cbChecked
TabOrder = 0
end
object chkSaveIncompleteRenders: TCheckBox
Left = 8
Top = 58
Width = 204
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Save incomplete renders'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = chkSaveIncompleteRendersClick
end
object chkEmbedFlame: TCheckBox
Left = 8
Top = 37
Width = 204
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Save parameters in a PNG-image '
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
State = cbChecked
TabOrder = 2
end
end
object GroupBox6: TGroupBox
Left = 232
Top = 303
Width = 234
Height = 81
Anchors = [akLeft, akTop, akRight]
Caption = 'Completion options'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 6
DesignSize = (
234
81)
object chkPostProcess: TCheckBox
Left = 8
Top = 16
Width = 217
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Post-process after completion'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
end
object chkShutdown: TCheckBox
Left = 8
Top = 37
Width = 217
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Shut down computer when complete'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
end
object chkPlaySound: TCheckBox
Left = 8
Top = 58
Width = 217
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Play sound when complete'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
OnClick = chkPlaySoundClick
end
end
object pnlTarget: TPanel
Left = 5
Top = 8
Width = 121
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Destination'
TabOrder = 7
end
object txtFilename: TEdit
Left = 125
Top = 8
Width = 290
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
OnChange = txtFilenameChange
end
object chkBinary: TCheckBox
Left = 13
Top = 388
Width = 457
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption =
'Write raw data (WARNING: this is experimental and slows down the' +
' rendering!!!)'
Enabled = False
TabOrder = 8
Visible = False
end
end
object TabOutput: TTabSheet
Caption = 'Output'
ImageIndex = 38
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object Output: TMemo
Left = 0
Top = 0
Width = 473
Height = 407
Align = alClient
BorderStyle = bsNone
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object StatusBar: TStatusBar
Left = 0
Top = 513
Width = 497
Height = 19
Panels = <
item
Width = 161
end
item
Width = 150
end
item
Width = 50
end>
end
object btnDonate: TButton
Left = 8
Top = 483
Width = 82
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'Donate'
ParentShowHint = False
ShowHint = True
TabOrder = 6
OnClick = btnDonateClick
end
object btnSaveLog: TButton
Left = 95
Top = 483
Width = 73
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'Save log'
Enabled = False
TabOrder = 5
Visible = False
OnClick = btnSaveLogClick
end
object ProgressBar2: TProgressBar
Left = 8
Top = 451
Width = 481
Height = 25
Anchors = [akLeft, akRight, akBottom]
TabOrder = 7
end
object btnSnapshot: TButton
Left = 172
Top = 483
Width = 75
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'Snapshot'
TabOrder = 8
Visible = False
OnClick = btnSnapshotClick
end
object SaveDialog: TSaveDialog
Left = 456
Top = 72
end
object ProgressTaskbar: TTaskbar
TaskBarButtons = <>
ProgressMaxValue = 100
TabProperties = []
Left = 432
Top = 424
end
end
Forms/FormRender.pas
+1501
View File
File diff suppressed because it is too large Load Diff
Forms/Fullscreen.dfm
+58
View File
@@ -0,0 +1,58 @@
object FullscreenForm: TFullscreenForm
Left = 439
Top = 325
BorderStyle = bsNone
Caption = 'FullscreenForm'
ClientHeight = 131
ClientWidth = 186
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PopupMenu = FullscreenPopup
OnClose = FormClose
OnCreate = FormCreate
OnDblClick = ImageDblClick
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Image: TImage
Left = 0
Top = 0
Width = 186
Height = 131
PopupMenu = FullscreenPopup
OnDblClick = ImageDblClick
end
object Timelimiter: TTimer
Enabled = False
Interval = 2000
OnTimer = TimelimiterOnTimer
Left = 8
Top = 8
end
object FullscreenPopup: TPopupMenu
Left = 40
Top = 8
object RenderStop: TMenuItem
Caption = '&Stop Render'
OnClick = RenderStopClick
end
object RenderMore: TMenuItem
Caption = 'Render &More'
OnClick = RenderMoreClick
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = '&Close'
OnClick = ImageDblClick
end
end
end
Forms/Fullscreen.pas
+344
View File
@@ -0,0 +1,344 @@
{
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 Fullscreen;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, ControlPoint, RenderThread, Translation;
type
TFullscreenForm = class(TForm)
Image: TImage;
Timelimiter: TTimer;
FullscreenPopup: TPopupMenu;
RenderStop: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
RenderMore: TMenuItem;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ImageDblClick(Sender: TObject);
procedure TimelimiterOnTimer(Sender: TObject);
procedure RenderStopClick(Sender: TObject);
procedure RenderMoreClick(Sender: TObject);
private
Remainder, StartTime, t: double;
imgLeft, imgTop,
imgWidth, imgHeight: integer;
Closing: boolean;
Renderer: TRenderThread;
procedure showTaskbar;
procedure hideTaskbar;
procedure DrawFlame;
procedure OnProgress(prog: double);
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
procedure HandleThreadTermination(var Message: TMessage);
message WM_THREAD_TERMINATE;
public
Calculate : boolean;
cp: TControlPoint;
Zoom: double;
center: array[0..1] of double;
ActiveForm: TForm;
end;
var
FullscreenForm: TFullscreenForm;
implementation
uses
Main, Math, Global,
Tracer;
{$R *.DFM}
procedure Trace1(const str: string);
begin
if TraceLevel >= 1 then
TraceForm.FullscreenTrace.Lines.Add('. ' + str);
end;
procedure Trace2(const str: string);
begin
if TraceLevel >= 2 then
TraceForm.FullscreenTrace.Lines.Add('. . ' + str);
end;
procedure TFullscreenForm.DrawFlame;
var
r: double;
begin
if (cp.width / cp.height) > (ClientWidth / ClientHeight) then
begin
imgWidth := ClientWidth;
r := cp.width / imgWidth;
imgHeight := round(cp.height / r);
imgLeft := 1;
imgTop := (ClientHeight - imgHeight) div 2;
end
else begin
imgHeight := ClientHeight;
r := cp.height / imgHeight;
imgWidth := round(cp.Width / r);
imgTop := 1;
imgLeft := (ClientWidth - ImgWidth) div 2;
end;
cp.AdjustScale(imgWidth, imgHeight);
// cp.Zoom := MainForm.Zoom;
// cp.center[0] := MainForm.center[0];
// cp.center[1] := MainForm.center[1];
cp.sample_density := defSampleDensity;
StartTime := Now;
t := now;
Remainder := 1;
if Assigned(Renderer) then begin // hmm...
Trace2('Killing previous RenderThread #' + inttostr(Renderer.ThreadID));
Renderer.Terminate;
Renderer.WaitFor;
while Renderer <> nil do
Application.ProcessMessages; // HandleThreadTermination kinda should be called here...(?)
end;
assert(not assigned(renderer), 'Render thread is still running!?');
Renderer := TRenderThread.Create; // Hmm... Why do we use RenderThread here, anyway? :-\
Renderer.TargetHandle := Handle;
Renderer.OnProgress := OnProgress;
Renderer.NrThreads := NrTreads; // AV: fixed Apo7X glitch here
if TraceLevel > 0 then Renderer.Output := TraceForm.FullscreenTrace.Lines;
Renderer.SetCP(cp);
Renderer.WaitForMore := true;
RenderStop.Enabled := true;
RenderMore.Enabled := false;
Renderer.Resume;
end;
procedure TFullscreenForm.HandleThreadCompletion(var Message: TMessage);
var
bm: TBitmap;
begin
Trace2(MsgComplete + IntToStr(message.LParam));
if not Assigned(Renderer) then begin
Trace2(MsgNotAssigned);
exit;
end;
if Renderer.ThreadID <> message.LParam then begin
Trace2(MsgAnotherRunning);
exit;
end;
if Assigned(Renderer) then
begin
bm := TBitmap.Create;
bm.assign(Renderer.GetImage);
Image.SetBounds(imgLeft, imgTop, imgWidth, imgHeight);
Image.Picture.Graphic := bm;
bm.Free;
end;
RenderStop.Enabled := false;
RenderMore.Enabled := true;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.HandleThreadTermination(var Message: TMessage);
var
bm: TBitmap;
begin
Trace2(MsgTerminated + IntToStr(message.LParam));
if not Assigned(Renderer) then begin
Trace2(MsgNotAssigned);
exit;
end;
if Renderer.ThreadID <> message.LParam then begin
Trace2(MsgAnotherRunning);
exit;
end;
RenderStop.Enabled := false;
RenderMore.Enabled := false;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.OnProgress(prog: double);
begin
prog := (Renderer.Slice + Prog) / Renderer.NrSlices;
Canvas.Lock;
try
if prog >= 1 then
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
end
else if prog >= 0 then begin
Canvas.Brush.Color := clTeal;
Canvas.FrameRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
Canvas.Brush.Color := clTeal;
Canvas.Fillrect(Rect(7, ClientHeight - 13, 7 + Round(prog * (ClientWidth - 14)), ClientHeight - 7));
Canvas.Brush.Color := clBlack;
Canvas.Fillrect(Rect(7 + Round(prog * (ClientWidth - 14)), ClientHeight - 13, ClientWidth - 7, ClientHeight - 7));
end;
finally
Canvas.Unlock;
end;
//Application.ProcessMessages;
end;
procedure TFullscreenForm.hideTaskbar;
var wndHandle: THandle;
wndClass: array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE);
end;
procedure TFullscreenForm.showTaskbar;
var wndHandle: THandle;
wndClass: array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_RESTORE);
end;
procedure TFullscreenForm.FormShow(Sender: TObject);
begin
Trace1('--- Opening Fullscreen View ---');
if Image.Width < ClientWidth then
Image.Left := (ClientWidth - Image.Width) div 2;
if Image.Height < ClientHeight then
Image.Top := (ClientHeight - Image.Height) div 2;
Closing := false;
TimeLimiter.Enabled := false;
RenderStop.Enabled := false;
RenderMore.Enabled := false;
MainForm.mnuFullScreen.enabled := true;
HideTaskbar;
if calculate then
DrawFlame;
end;
procedure TFullscreenForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Closing := true;
if Assigned(Renderer) then begin
if Renderer.Suspended then begin
Renderer.WaitForMore := false;
Renderer.Resume;
end;
Trace2('Form closing: killing RenderThread #' + inttostr(Renderer.ThreadID));
Renderer.Terminate;
Renderer.WaitFor;
Trace2('Destroying RenderThread #' + IntToStr(Renderer.ThreadID));
Renderer.Free;
Renderer := nil;
end;
Trace1('--- Closing Fullscreen View ---');
Trace1('');
ShowTaskbar;
ActiveForm.SetFocus;
end;
procedure TFullscreenForm.FormCreate(Sender: TObject);
begin
Exit1.Caption := TextByKey('common-close');
RenderMore.Caption := TextByKey('fullscreen-popup-rendermore');
RenderStop.Caption := TextByKey('fullscreen-popup-stoprender');
cp := TControlPoint.Create;
end;
procedure TFullscreenForm.FormDestroy(Sender: TObject);
begin
if assigned(Renderer) then begin
Renderer.Terminate;
Renderer.WaitFor;
Renderer.Free;
end;
cp.Free;
end;
procedure TFullscreenForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = ' ' then begin
if RenderStop.Enabled then RenderStop.Click
else if RenderMore.Enabled then RenderMore.Click;
end
else Close;
end;
procedure TFullscreenForm.ImageDblClick(Sender: TObject);
begin
Close;
end;
procedure TFullscreenForm.TimelimiterOnTimer(Sender: TObject);
begin
//if assigned(Renderer) then Renderer.Break;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.RenderStopClick(Sender: TObject);
begin
if assigned(Renderer) then Renderer.BreakRender;
end;
procedure TFullscreenForm.RenderMoreClick(Sender: TObject);
begin
if assigned(Renderer) and Renderer.Suspended then begin
Renderer.Resume;
RenderStop.Enabled := true;
RenderMore.Enabled := false;
end;
end;
end.
Forms/LoadTracker.dfm
+120
View File
@@ -0,0 +1,120 @@
object LoadForm: TLoadForm
Left = 443
Top = 274
ActiveControl = Button1
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Messages'
ClientHeight = 388
ClientWidth = 662
Color = clBtnFace
Constraints.MinHeight = 275
Constraints.MinWidth = 550
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsStayOnTop
Icon.Data = {
0000010001001010000001002000680400001600000028000000100000002000
0000010020000000000040040000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000006349
35146349352E927A69FF8C7563FF87705EFF6349352E7F6654FF7A624FFF755D
4AFF6349352E6E5441FF6A513EFF674E3AFF6349352E00000000000000006349
352EAE9888FFEFE3DDFFF2E7E1FFEDDFD7FF836B59FFB79B8BFFDBBDADFFD9B7
A6FF725946FFAE8B77FFD0A692FFCC9E87FF654B38FF6349352E00000000B7A2
93FFFBF8F7FFF9F4F2FFF7F0ECFFF4EBE6FFF1E5DFFF7F6754FF7A624FFF765D
4AFF735946FF6E5542FF6B523EFF674E3AFF654B38FF634935FF00000000B7A2
93FFFDFCFBFFFBF9F7FFFAF5F2FFF7EFEDFFF4EAE6FFF2E5DFFFDDDCD7FFDFD7
CEFFDECDC0FFDEC5B6FFDEBFACFFDBBAA6FFD8B5A3FF634935FF00000000B7A2
93FFFFFFFFFFB47F65FFB47F64FFEDDDD5FFB37E63FFF4EBE6FFF1E5DFFFEFDF
D7FFEBD9D1FFE8D3C9FFE5CDC1FFE1C6B9FFD6B3A1FF634A35FF00000000B9A4
95FFFFFFFFFFFFFFFFFFFDFCFCFFFCF9F7FFFAF4F2FFF6F0ECFFF4EBE5FFF2E5
DFFFEEDFD8FFEBD9D0FFE8D3C8FFE5CCC1FFDBBDADFF634A36FF00000000BDA7
98FFFFFFFFFF968E88FFEEDED7FF968E87FFEDDDD6FF968D86FF958C85FFF4EB
E6FFF2E5DFFFEFDFD8FFECD9D0FFE8D3C9FFE0C7BAFF634A35FF00000000C1AB
9CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFCFCFFFBF8F7FFFAF4F2FFF7F0
ECFFF4EAE6FFF1E5DFFFEEDFD7FFEBD9D0FFE6D1C6FF634A35FF00000000C5AF
A0FFFFFFFFFFB48065FFB48065FF968E88FFC2B0A3FF968E87FF968E86FFF9F4
F2FFF7EFECFFF4EBE6FFF2E5DFFFEFDFD8FFEADBD1FF634936FF00000000C8B2
A3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFCFCFFFCF8
F7FFF9F5F2FFF7F0ECFFF4EBE6FFF1E5DFFFEEE2DAFF644A36FF00000000C9B4
A5FFFFFFFFFFFFFFFFFF66A365FF66A365FF66A365FFC0B4ADFF66A365FF66A3
65FF66A264FFFAF5F2FFF7F0ECFFF4EBE6FFEEE2DAFF644A36FF00000000C8B2
A3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFEFCFBFFFBF9F7FFFAF4F2FFF7F0EDFFF3EAE4FF644A36FF00000000C8B2
A3FFCAB4A5FFCBB5A6FFCAB4A5FFC9B3A4FFC7B2A3FFC6B0A1FFC3AE9FFFC1AC
9DFFBFAA9BFFBDA899FFBBA697FFB9A495FFB8A394FFB7A293FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000FFFF00000003000000010000000100000001000000010000000100000001
0000000100000001000000010000000100000001000000010000FFFF0000}
OldCreateOrder = False
OnCreate = FormCreate
OnResize = FormResize
DesignSize = (
662
388)
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 7
Top = 7
Width = 533
Height = 308
Anchors = [akLeft, akTop, akRight, akBottom]
Style = bsRaised
end
object Button1: TButton
Left = 527
Top = 359
Width = 110
Height = 22
Anchors = [akRight, akBottom]
Caption = 'Close'
TabOrder = 0
OnClick = Button1Click
end
object CheckBox1: TCheckBox
Left = 8
Top = 360
Width = 384
Height = 24
Anchors = [akLeft, akRight, akBottom]
Caption = 'Automatically open this window when loading flame'
TabOrder = 1
WordWrap = True
OnClick = CheckBox1Click
end
object Button2: TButton
Left = 406
Top = 359
Width = 110
Height = 22
Anchors = [akRight, akBottom]
Caption = 'Clear'
TabOrder = 2
OnClick = Button2Click
end
object Output: TMemo
Left = 8
Top = 8
Width = 528
Height = 303
BevelOuter = bvRaised
BorderStyle = bsNone
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 3
end
end
Forms/LoadTracker.pas
+105
View File
@@ -0,0 +1,105 @@
{
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 LoadTracker;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Global, Settings, ExtCtrls, Translation;
type
TLoadForm = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
Button2: TButton;
Bevel1: TBevel;
Output: TMemo;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
LoadForm: TLoadForm;
implementation
{$R *.dfm}
procedure TLoadForm.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TLoadForm.CheckBox1Click(Sender: TObject);
begin
AutoOpenLog := CheckBox1.Checked;
end;
procedure TLoadForm.FormCreate(Sender: TObject);
begin
Button2.Caption := TextByKey('common-clear');
Button1.Caption := TextByKey('common-close');
self.Caption := TextByKey('messages-title');
CheckBox1.Caption := TextByKey('messages-openautomatically');
CheckBox1.Checked := AutoOpenLog;
end;
procedure TLoadForm.Button2Click(Sender: TObject);
begin
Output.Text := '';
end;
procedure TLoadForm.FormResize(Sender: TObject);
begin
CheckBox1.Left := 2;
Checkbox1.Top := self.ClientHeight - Checkbox1.Height - 2;
CheckBox1.Width := self.ClientWidth - button1.Width - button2.Width - 8;
Button1.Left := self.ClientWidth - button1.Width - button2.Width - 4;
Button1.Top := self.ClientHeight - Checkbox1.Height - 2 + Checkbox1.Height div 2 - Button1.Height div 2;
Button2.Left := self.ClientWidth - button2.Width - 2;
Button2.Top := Button1.Top;
Bevel1.Left := 2;
Bevel1.Top := 2;
Bevel1.Width := self.ClientWidth - 4;
Bevel1.Height := self.ClientHeight - 6 - checkbox1.Height;
Output.Left := Bevel1.Left + 2;
Output.Top := Bevel1.Top + 2;
Output.Width := Bevel1.Width - 4;
Output.Height := Bevel1.Height -4;
end;
end.
Forms/Main.dfm
+4009
View File
File diff suppressed because it is too large Load Diff
Forms/Main.pas
+8306
View File
File diff suppressed because it is too large Load Diff
Forms/Mutate.dfm
+383
View File
@@ -0,0 +1,383 @@
object MutateForm: TMutateForm
Left = 589
Top = 326
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Mutation'
ClientHeight = 398
ClientWidth = 422
Color = clBtnFace
Constraints.MinHeight = 400
Constraints.MinWidth = 400
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDefault
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
422
398)
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 8
Top = 8
Width = 409
Height = 273
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Directions'
TabOrder = 0
DesignSize = (
409
273)
object Panel10: TPanel
Left = 12
Top = 20
Width = 384
Height = 238
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
TabOrder = 0
object Panel6: TPanel
Left = 112
Top = 168
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 0
object Image6: TImage
Tag = 6
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel7: TPanel
Left = 0
Top = 168
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 1
object Image7: TImage
Tag = 7
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel4: TPanel
Left = 224
Top = 84
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 2
object Image4: TImage
Tag = 4
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel0: TPanel
Left = 112
Top = 84
Width = 108
Height = 80
HelpContext = 2003
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 3
object Image0: TImage
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = Image0Click
end
end
object Panel8: TPanel
Left = 0
Top = 84
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 4
object Image8: TImage
Tag = 8
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel3: TPanel
Left = 224
Top = 0
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 5
object Image3: TImage
Tag = 3
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel2: TPanel
Left = 112
Top = 0
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 6
object Image2: TImage
Tag = 2
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 7
object Image1: TImage
Tag = 1
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
object Panel5: TPanel
Left = 224
Top = 168
Width = 108
Height = 80
BevelOuter = bvLowered
Caption = 'PrevPnl3'
Color = clBlack
ShowCaption = False
TabOrder = 8
object Image5: TImage
Tag = 5
Left = 1
Top = 1
Width = 106
Height = 78
Align = alClient
PopupMenu = QualityPopup
Stretch = True
OnClick = MutantClick
end
end
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 288
Width = 409
Height = 105
Anchors = [akLeft, akRight, akBottom]
TabOrder = 1
DesignSize = (
409
105)
object scrollTime: TScrollBar
Left = 120
Top = 20
Width = 202
Height = 20
Anchors = [akLeft, akTop, akRight]
LargeChange = 5
Max = 50
Min = 1
PageSize = 0
Position = 1
TabOrder = 0
OnChange = scrollTimeChange
end
object cmbTrend: TComboBox
Left = 119
Top = 48
Width = 282
Height = 21
Style = csDropDownList
Anchors = [akLeft, akTop, akRight]
DropDownCount = 16
TabOrder = 1
OnChange = cmbTrendChange
Items.Strings = (
'Random'
'Linear')
end
object chkSameNum: TCheckBox
Left = 12
Top = 78
Width = 389
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Same no. of transforms'
TabOrder = 2
OnClick = chkSameNumClick
end
object pnlSpeed: TPanel
Left = 12
Top = 20
Width = 101
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Speed'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object txtTime: TEdit
Left = 328
Top = 20
Width = 73
Height = 21
Anchors = [akTop, akRight]
ReadOnly = True
TabOrder = 4
Text = '0.25'
end
object pnlTrend: TPanel
Left = 12
Top = 48
Width = 101
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Trend'
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
end
object Timer: TTimer
Enabled = False
Interval = 100
OnTimer = TimerTimer
Left = 168
Top = 80
end
object QualityPopup: TPopupMenu
Images = MainForm.Buttons
Left = 144
Top = 40
object mnuLowQuality: TMenuItem
Caption = 'Low Quality'
RadioItem = True
OnClick = mnuLowQualityClick
end
object mnuMediumQuality: TMenuItem
Caption = 'Medium Quality'
Checked = True
RadioItem = True
OnClick = mnuMediumQualityClick
end
object mnuHighQuality: TMenuItem
Caption = 'High Quality'
RadioItem = True
OnClick = mnuHighQualityClick
end
object N3: TMenuItem
Caption = '-'
end
object mnuBack: TMenuItem
Caption = 'Previous'
Enabled = False
ImageIndex = 4
OnClick = mnuBackClick
end
object N1: TMenuItem
Caption = '-'
end
object mnuMaintainSym: TMenuItem
Caption = 'Maintain Symmetry'
Checked = True
OnClick = mnuMaintainSymClick
end
object N2: TMenuItem
Caption = '-'
end
object mnuResetLocation: TMenuItem
Caption = 'Reset Location'
Checked = True
OnClick = mnuResetLocationClick
end
end
end
Forms/Mutate.pas
+634
View File
@@ -0,0 +1,634 @@
{
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 Mutate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ControlPoint, ComCtrls, Menus, Buttons, Cmap,
RenderingInterface, Translation, Curves;
type
TMutateForm = class(TForm)
GroupBox1: TGroupBox;
Timer: TTimer;
GroupBox2: TGroupBox;
scrollTime: TScrollBar;
cmbTrend: TComboBox;
chkSameNum: TCheckBox;
QualityPopup: TPopupMenu;
mnuLowQuality: TMenuItem;
mnuMediumQuality: TMenuItem;
mnuHighQuality: TMenuItem;
N3: TMenuItem;
mnuResetLocation: TMenuItem;
mnuBack: TMenuItem;
N1: TMenuItem;
mnuMaintainSym: TMenuItem;
N2: TMenuItem;
Panel10: TPanel;
Panel6: TPanel;
Image6: TImage;
Panel7: TPanel;
Image7: TImage;
Panel4: TPanel;
Image4: TImage;
Panel0: TPanel;
Image0: TImage;
Panel8: TPanel;
Image8: TImage;
Panel3: TPanel;
Image3: TImage;
Panel2: TPanel;
Image2: TImage;
Panel1: TPanel;
Image1: TImage;
Panel5: TPanel;
Image5: TImage;
pnlSpeed: TPanel;
txtTime: TEdit;
pnlTrend: TPanel;
//procedure Panel10Resize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image0Click(Sender: TObject);
procedure MutantClick(Sender: TObject);
procedure sbTimeChange(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure scrollTimeChange(Sender: TObject);
procedure cmbTrendChange(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure mnuHighQualityClick(Sender: TObject);
procedure mnuLowQualityClick(Sender: TObject);
procedure mnuMediumQualityClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure chkSameNumClick(Sender: TObject);
procedure mnuResetLocationClick(Sender: TObject);
procedure mnuBackClick(Sender: TObject);
procedure mnuMaintainSymClick(Sender: TObject);
private
name: string;
bm: TBitmap;
PreviewDensity: double;
Updating: boolean;
cps: array[0..8] of TControlPoint;
Mutants: array[0..8] of TControlPoint;
Render: TRenderer;
Time: double;
bstop: boolean;
brightness, gamma, vibrancy, contrast, gamma_threshold: double;
width, height: integer; // AV: to keep original flame size
seed, InitSeed: integer;
procedure RandomSet;
procedure ShowMain;
procedure ShowMutants;
procedure Interpolate;
public
Zoom: Double;
Center: array[0..1] of double;
cmap: TColorMap;
procedure UpdateDisplay;
procedure UpdateFlame;
end;
var
MutateForm: TMutateForm;
implementation
uses
Main, Global, Registry, Editor, Adjust, XFormMan;
{$R *.DFM}
procedure TMutateForm.UpdateFlame;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.Copy(cps[0]);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
MainCp.cmap := cmap;
MainCp.name := name; // this is kinda funny
MainCp.AdjustScale(width, height); // AV: restore normal size
if mnuResetLocation.checked then
begin
//MainForm.Mainzoom := cps[0].zoom;
MainForm.Center[0] := cps[0].Center[0];
MainForm.Center[1] := cps[0].Center[1];
end;
MainForm.RedrawTimer.enabled := true;
if EditForm.Visible then EditForm.UpdateDisplay;
// if AdjustForm.Visible then AdjustForm.UpdateDisplay;
end;
procedure TMutateForm.UpdateDisplay;
begin
cps[0].copy(MainCp);
cps[0].AdjustScale(Image0.Width, Image0.Height);
cps[0].cmap := MainCp.cmap;
cmap := MainCp.cmap;
name := Maincp.name;
zoom := MainCp.zoom;
width := MainCp.Width; // AV
height := MainCp.Height; // AV
center[0] := MainCp.center[0];
center[1] := MainCp.center[1];
vibrancy := cps[0].vibrancy;
gamma := cps[0].gamma;
gamma_threshold := cps[0].gamma_threshold; // AV
brightness := cps[0].brightness;
contrast := cps[0].contrast; // AV
Interpolate;
ShowMain;
Application.ProcessMessages;
ShowMutants;
end;
procedure TMutateForm.ShowMain;
begin
cps[0].Width := Image0.Width;
cps[0].Height := Image0.Height;
cps[0].spatial_oversample := defOversample;
cps[0].spatial_filter_radius := defFilterRadius;
cps[0].sample_density := PreviewDensity;
cps[0].brightness := brightness;
cps[0].contrast := contrast; // AV
cps[0].gamma := gamma;
cps[0].gamma_threshold := gamma_threshold; // AV
cps[0].vibrancy := vibrancy;
cps[0].sample_density := PreviewDensity;
cps[0].cmap := cmap;
cps[0].background := MainCp.background;
if mnuResetLocation.checked then begin
cps[0].CalcBoundbox;
zoom := 0;
center[0] := cps[0].center[0];
center[1] := cps[0].Center[1];
end;
cps[0].zoom := zoom;
cps[0].center[0] := center[0];
cps[0].center[1] := center[1];
Render.SetCP(cps[0]);
Render.Render;
BM.Assign(Render.GetImage);
Image0.Picture.Graphic := bm;
end;
procedure TMutateForm.ShowMutants;
var
i: integer;
begin
if Visible = false then exit;
Updating := true;
for i := 1 to 8 do
begin
mutants[i].Width := Image1.Width;
mutants[i].Height := Image1.Height;
mutants[i].spatial_filter_radius := defFilterRadius;
mutants[i].spatial_oversample := defOversample;
mutants[i].sample_density := PreviewDensity;
mutants[i].brightness := brightness;
mutants[i].contrast := contrast; // AV
mutants[i].gamma := gamma;
mutants[i].vibrancy := vibrancy;
mutants[i].gamma_threshold := gamma_threshold; // AV
if mnuResetLocation.checked then
begin
mutants[i].CalcBoundbox;
mutants[i].zoom := 0;
end
else begin
mutants[i].zoom := zoom;
mutants[i].center[0] := center[0];
mutants[i].center[1] := center[1];
end;
Render.SetCP(mutants[i]);
Render.Render;
BM.Assign(Render.GetImage);
case i of
1: begin
Image1.Picture.Graphic := bm;
Image1.Refresh;
end;
2: begin
Image2.Picture.Graphic := bm;
Image2.Refresh;
end;
3: begin
Image3.Picture.Graphic := bm;
Image3.Refresh;
end;
4: begin
Image4.Picture.Graphic := bm;
Image4.Refresh;
end;
5: begin
Image5.Picture.Graphic := bm;
Image5.Refresh;
end;
6: begin
Image6.Picture.Graphic := bm;
Image6.Refresh;
end;
7: begin
Image7.Picture.Graphic := bm;
Image7.Refresh;
end;
8: begin
Image8.Picture.Graphic := bm;
Image8.Refresh;
end;
end;
Updating := false;
end;
end;
procedure TMutateForm.Interpolate;
var i, j, k: Integer;
begin
if MainCp = nil then Exit;
for i := 1 to 8 do
begin
if bstop then exit;
cps[0].Time := 0;
cps[i].Time := 1;
(* -X- something is not right here...
Mutants[i] may be destroyed already
Investigate? *)
Mutants[i].clear;
Mutants[i].InterpolateX(cps[0], cps[i], Time / 100);
Mutants[i].cmapindex := cps[0].cmapindex;
Mutants[i].cmap := cps[0].cmap;
Mutants[i].background := MainCp.background;
if mnuMaintainSym.Checked then // maintain symmetry
for j := 0 to transforms - 1 do
if cps[0].xform[j].Symmetry = 1 then
mutants[i].xform[j].Assign(cps[0].xform[j]);
end;
end;
procedure TMutateForm.RandomSet;
var i, j, k: Integer;
begin
RandSeed := seed;
for i := 1 to 8 do
begin
cps[i].clear;
if chkSameNum.checked then
cps[i].RandomCP(transforms, transforms, false)
else
cps[i].RandomCP(mutantMinTransforms, mutantMaxTransforms, false);
if cmbTrend.ItemIndex = NRVAR then // AV
cps[i].SetVariation(vRandom)
else
for j := 0 to cps[i].NumXforms-1 do
begin
for k := 0 to NrVar-1 do // AV: simplified the calculations
cps[i].xform[j].SetVariation(k, 0);
cps[i].xform[j].SetVariation(cmbTrend.ItemIndex, 1);
end;
if cps[0].HasFinalXForm = false then
begin
cps[i].xform[cps[i].NumXForms].Clear;
cps[i].xform[cps[i].NumXForms].symmetry := 1;
end;
end;
Interpolate;
end;
procedure TMutateForm.FormShow(Sender: TObject);
var
Registry: TRegistry;
begin
{ Read position from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Mutate', False) then
begin
if Registry.ValueExists('Left') then
MutateForm.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
MutateForm.Top := Registry.ReadInteger('Top');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
{
if (cps[0].xform[0].density <> 0) and Assigned(MainCp) then
begin // hmm...!?
//Interpolate; // AV: this method is already called inside RandomSet
ShowMain;
ShowMutants;
end;
}
end;
procedure TMutateForm.FormCreate(Sender: TObject);
var
i: integer;
begin
self.Caption := TextByKey('mutation-title');
GroupBox1.Caption := TextByKey('mutation-directions');
pnlSpeed.Caption := TextByKey('mutation-speed');
pnlTrend.Caption := TextByKey('mutation-trend');
chkSameNum.Caption := TextByKey('mutation-keepnumberoftransforms');
mnuLowQuality.Caption := TextByKey('common-lowquality');
mnuMediumQuality.Caption := TextByKey('common-mediumquality');
mnuHighQuality.Caption := TextByKey('common-highquality');
mnuResetLocation.Caption := TextByKey('common-resetlocation');
mnuMaintainSym.Caption := TextByKey('mutation-maintainsymmetry');
mnuBack.Caption := TextByKey('mutation-previous');
cmbTrend.Items.clear;
for i:= 0 to NRVAR -1 do // AV
cmbTrend.Items.Add(varnames(i));
cmbTrend.Items.Add(TextByKey('mutation-randomtrend'));
bm := TBitMap.Create;
case MutatePrevQual of
0: begin
mnuLowQuality.Checked := true;
PreviewDensity := prevLowQuality;
end;
1: begin
mnuMediumQuality.Checked := true;
PreviewDensity := prevMediumQuality;
end;
2: begin
mnuHighQuality.Checked := true;
PreviewDensity := prevHighQuality;
end;
end;
Render := TRenderer.Create;
for i := 0 to 8 do
begin
cps[i] := TControlPoint.Create;
Mutants[i] := TControlPoint.Create;
end;
Time := 35;
scrollTime.Position := 25;
txtTime.Text := '0.25'; // AV
cmbTrend.ItemIndex := NRVAR; // AV
InitSeed := random(1234567890);
seed := InitSeed;
RandomSet;
end;
procedure TMutateForm.FormDestroy(Sender: TObject);
var
i: integer;
begin
Render.Stop;
Render.Free;
for i := 0 to 8 do
begin
cps[i].Free;
Mutants[i].Free;
end;
bm.free;
end;
procedure TMutateForm.Image0Click(Sender: TObject);
begin
Render.Stop;
mnuBack.Enabled := true;
inc(seed);
RandomSet;
ShowMutants;
end;
procedure TMutateForm.MutantClick(Sender: TObject);
var
i: integer;
cpt: TControlPoint;
begin
cpt := TControlPoint.Create;
cpt.Copy(cps[0], false, transforms); // AV
bstop := true;
// AV: optimized fast version without checking indices
i := TImage(Sender).Tag;
cps[0].Time := 0;
cps[i].Time := 1;
cps[0].InterpolateX(cps[0], cps[i], Time / 100);
if mnuMaintainSym.Checked then // maintain symmetry
begin
for i := 0 to transforms - 1 do
begin
if cpt.xform[i].Symmetry = 1 then
cps[0].xform[i].Assign(cpt.xform[i]);
end;
end;
bstop := false;
ShowMain;
Interpolate;
ShowMutants;
UpdateFlame;
cpt.free;
end;
procedure TMutateForm.sbTimeChange(Sender: TObject);
begin
bstop := true;
Render.Stop;
Time := scrollTime.Position;
bstop := false;
Interpolate;
ShowMutants;
end;
procedure TMutateForm.TimerTimer(Sender: TObject);
begin
Timer.Enabled := false;
if (Time <> scrollTime.Position) and (not updating) then
begin
Time := scrollTime.Position;
Interpolate;
ShowMutants;
end;
end;
procedure TMutateForm.scrollTimeChange(Sender: TObject);
begin
Timer.Enabled := true;
txtTime.Text := FloatToStr(scrollTime.Position / 100);
end;
procedure TMutateForm.cmbTrendChange(Sender: TObject);
var
i, j, k: integer;
begin
for i := 1 to 8 do
if cmbTrend.ItemIndex = NRVAR then
cps[i].SetVariation(VRandom) // AV
else
for j := 0 to cps[i].NumXforms-1 do
begin // AV
for k := 0 to NrVar-1 do
cps[i].xform[j].SetVariation(k, 0);
cps[i].xform[j].SetVariation(cmbTrend.ItemIndex, 1);
end;
Interpolate;
ShowMutants;
end;
procedure TMutateForm.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TMutateForm.mnuHighQualityClick(Sender: TObject);
begin
mnuHighQuality.Checked := True;
PreviewDensity := prevHighQuality;
MutatePrevQual := 2;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.mnuLowQualityClick(Sender: TObject);
begin
mnuLowQuality.Checked := True;
PreviewDensity := prevLowQuality;
MutatePrevQual := 0;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.mnuMediumQualityClick(Sender: TObject);
begin
mnuMediumQuality.Checked := True;
PreviewDensity := prevMediumQuality;
MutatePrevQual := 1;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
Registry: TRegistry;
begin
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Mutate', True) then
begin
Registry.WriteInteger('Top', MutateForm.Top);
Registry.WriteInteger('Left', MutateForm.Left);
end;
finally
Registry.Free;
end;
end;
procedure TMutateForm.chkSameNumClick(Sender: TObject);
begin
RandomSet;
// Interpolate; // AV: this method is already called inside RandomSet
ShowMutants;
end;
procedure TMutateForm.mnuResetLocationClick(Sender: TObject);
begin
mnuResetLocation.Checked := not mnuResetLocation.Checked;
if not mnuResetLocation.checked then
begin
cps[0].width := MainCp.width;
cps[0].height := MainCp.height;
cps[0].pixels_per_unit := MainCp.pixels_per_unit;
cps[0].AdjustScale(Image0.width, Image0.Height);
cps[0].zoom := MainCp.zoom;
cps[0].center[0] := MainCp.center[0];
cps[0].center[1] := MainCp.center[1];
zoom := cps[0].zoom;
center[0] := cps[0].center[0];
center[1] := cps[0].center[1];
end;
ShowMain;
ShowMutants;
end;
procedure TMutateForm.mnuBackClick(Sender: TObject);
begin
Render.Stop;
if seed > InitSeed then
dec(seed);
if seed = InitSeed then mnuBack.enabled := false;
RandomSet;
ShowMutants;
end;
procedure TMutateForm.mnuMaintainSymClick(Sender: TObject);
begin
mnuMaintainSym.Checked := not mnuMaintainSym.Checked;
Interpolate;
ShowMutants;
end;
(*
procedure TMutateForm.Panel10Resize(Sender: TObject);
const gap:integer = 4 ;
var
w, h : integer;
begin
w := (Panel10.Width - 2*gap) div 3;
h := (Panel10.Height - 2*gap) div 3;
Panel0.Width := w; Panel1.Width := w; Panel2.Width := w;
Panel3.Width := w; Panel4.Width := w; Panel5.Width := w;
Panel6.Width := w; Panel7.Width := w; Panel8.Width := w;
Panel0.Height := h; Panel1.Height := h; Panel2.Height := h;
Panel3.Height := h; Panel4.Height := h; Panel5.Height := h;
Panel6.Height := h; Panel7.Height := h; Panel8.Height := h;
Panel2.Left := w + gap; Panel0.Left := w + gap; Panel6.Left := w + gap;
Panel3.Left := 2*(w + gap); Panel4.Left := 2*(w + gap); Panel5.Left := 2*(w + gap);
Panel8.Top := h + gap; Panel0.Top := h + gap; Panel4.Top := h + gap;
Panel7.Top := 2*(h + gap); Panel6.Top := 2*(h + gap); Panel5.Top := 2*(h + gap);
end;
*)
end.
Forms/Options.dfm
+4308
View File
File diff suppressed because it is too large Load Diff
Forms/Options.pas
+1796
View File
File diff suppressed because it is too large Load Diff
Forms/Preview.dfm
+66
View File
@@ -0,0 +1,66 @@
object PreviewForm: TPreviewForm
Left = 541
Top = 357
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSizeToolWin
Caption = 'Preview'
ClientHeight = 147
ClientWidth = 196
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PopupMenu = PreviewPopup
Scaled = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 13
object BackPanel: TPanel
Left = 0
Top = 0
Width = 196
Height = 147
Align = alClient
BevelInner = bvLowered
BevelOuter = bvLowered
Color = clBlack
TabOrder = 0
object Image: TImage
Left = 2
Top = 2
Width = 192
Height = 143
Align = alClient
AutoSize = True
Stretch = True
ExplicitWidth = 200
ExplicitHeight = 153
end
end
object PreviewPopup: TPopupMenu
Left = 72
Top = 40
object MakeScreenShot: TMenuItem
Caption = 'Make a screenshot of the window'
ShortCut = 16471
OnClick = MakeScreenShotClick
end
object KeepFrame: TMenuItem
AutoCheck = True
Caption = 'Keep the window frame'
end
object N1: TMenuItem
Caption = '-'
end
object PreviewPause: TMenuItem
Caption = 'Pause the preview'
OnClick = PreviewPauseClick
end
end
end
Forms/Preview.pas
+151
View File
@@ -0,0 +1,151 @@
{
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 Preview;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ControlPoint, RenderingInterface, Translation, Vcl.Menus,
Vcl.Imaging.PNGimage;
type
TPreviewForm = class(TForm)
BackPanel: TPanel;
Image: TImage;
PreviewPopup: TPopupMenu;
MakeScreenShot: TMenuItem;
KeepFrame: TMenuItem;
N1: TMenuItem;
PreviewPause: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure MakeScreenShotClick(Sender: TObject); // AV
procedure PreviewPauseClick(Sender: TObject); // AV
private
public
cp: TControlPoint;
Render: TRenderer;
procedure DrawFlame;
end;
var
PreviewForm: TPreviewForm;
implementation
uses Main, Global, ScriptForm;
{$R *.DFM}
procedure TPreviewForm.DrawFlame;
begin
Render.Stop;
// AV: this is already done by cp.AdjustScale
{
cp.width := Image.width;
cp.Height := Image.Height;
}
Render.SetCP(cp);
Render.Render;
Image.Picture.Bitmap.Assign(Render.GetImage);
Application.ProcessMessages;
end;
procedure TPreviewForm.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('preview-title');
MakeScreenShot.Caption := TextByKey('main-menu-screenshot');
KeepFrame.Caption := TextByKey('preview-keepframe');
cp := TControlPoint.Create;
Render := TRenderer.Create;
PreviewPause.Caption := TextByKey('preview-pause');
end;
procedure TPreviewForm.FormDestroy(Sender: TObject);
begin
Render.Free;
cp.Free;
end;
procedure TPreviewForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if ScriptEditor.btnPause.Down then ScriptEditor.btnPause.Click; // AV
ScriptEditor.Stopped := True;
end;
procedure TPreviewForm.MakeScreenShotClick(Sender: TObject);
var
s: string;
pic: TPNGObject;
begin
if not DirectoryExists(ScreenShotPath) then
begin
CreateDir(AppPath + 'ScreenShots\');
ScreenShotPath := AppPath + 'ScreenShots\';
end;
s := ScreenShotPath + 'Apophysis Animation Preview' + FormatDateTime(' (MM-dd-yyyy hh-mm-ss)', Now) + '.bmp';
try
if KeepFrame.Checked then
GetFormScreenShot(s)
else
begin
try
pic := TPNGObject.Create;
try
pic.Assign(Image.Picture.Bitmap);
if cp.name = '' then cp.name := RemoveExt(s);
pic.AddtEXt('ApoFlame', AnsiString(Trim(MainForm.RetrieveXML(cp))));
s := ChangeFileExt(s, '.png');
pic.SaveToFile(s);
finally
pic.Free;
end;
except
Image.Picture.Bitmap.SaveToFile(s);
end;
end;
Application.MessageBox(PChar(Format(TextByKey('common-screenshot-saved'),
[ExtractFileName(s), ExtractFilePath(s)])), PChar('Apophysis AV'), MB_ICONINFORMATION);
except
Application.MessageBox(PChar(TextByKey('common-screenshot-error')), PChar('Apophysis AV'), MB_ICONERROR);
end;
end;
procedure TPreviewForm.PreviewPauseClick(Sender: TObject);
begin
ScriptEditor.btnPause.Click;
end;
procedure TPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ScriptEditor.btnPause.Down then ScriptEditor.btnPause.Click; // AV
ScriptEditor.Stopped := True;
end;
end.
Forms/Save.dfm
+153
View File
@@ -0,0 +1,153 @@
object SaveForm: TSaveForm
Left = 434
Top = 432
BorderStyle = bsDialog
Caption = 'Save Parameters'
ClientHeight = 153
ClientWidth = 517
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poOwnerFormCenter
OnCreate = FormCreate
OnShow = FormShow
DesignSize = (
517
153)
PixelsPerInch = 120
TextHeight = 16
object btnDefGradient: TSpeedButton
Left = 480
Top = 9
Width = 30
Height = 29
Hint = 'Browse...'
Anchors = [akTop, akRight]
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF75848F66808F
607987576E7B4E626F4456613948522E3A43252E351B222914191E0E12160E13
18FF00FFFF00FFFF00FF77879289A1AB6AB2D4008FCD008FCD008FCD048CC708
88BE0F82B4157CA91B779F1F7296224B5C87A2ABFF00FFFF00FF7A8A957EBED3
8AA4AE7EDCFF5FCFFF55CBFF4CC4FA41BCF537B3F02EAAEB24A0E5138CD42367
805E696DFF00FFFF00FF7D8E9879D2EC8BA4AD89C2CE71D8FF65D3FF5CCEFF51
C9FE49C1FA3FB9F534B0EE29A8E91085CD224B5B98B2BAFF00FF80919C81D7EF
7DC5E08CA6B080DDFE68D3FF67D4FF62D1FF58CDFF4EC7FC46BEF73BB6F231AC
EC2569817A95A1FF00FF83959F89DCF18CE2FF8DA8B18CBAC774D8FF67D4FF67
D4FF67D4FF5FD0FF54CDFF4BC5FC41BBF72EA2DB51677498B2BA869AA392E1F2
98E8FD80C4DE8EA7B081DEFD84E0FF84E0FF84E0FF84E0FF81DFFF7BDDFF74D8
FF6BD6FF56A9D18F9BA4889CA59AE6F39FEBFB98E8FE8BACB98BACB98AAAB788
A6B386A3AF839FAA819AA67F95A17C919D7A8E99798B957788938BA0A8A0EAF6
A6EEF99FEBFB98E8FE7ADAFF67D4FF67D4FF67D4FF67D4FF67D4FF67D4FF7788
93FF00FFFF00FFFF00FF8EA2ABA7EEF6ABF0F7A6EEF99FEBFB98E8FD71D4FB89
9EA78699A382949F7E909A7A8C97778893FF00FFFF00FFFF00FF8FA4ACA0D2DA
ABF0F7ABF0F7A6EEF99FEBFB8DA1AAB5CBD0FF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFBDCED48FA4AC8FA4AC8FA4AC8FA4AC8FA4ACB5CBD0FF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDefGradientClick
end
object btnSave: TButton
Left = 310
Top = 116
Width = 93
Height = 30
Anchors = [akRight, akBottom]
Caption = '&Save'
Default = True
TabOrder = 2
OnClick = btnSaveClick
end
object btnCancel: TButton
Left = 410
Top = 116
Width = 92
Height = 30
Anchors = [akRight, akBottom]
Caption = 'Cancel'
TabOrder = 3
OnClick = btnCancelClick
end
object pnlTarget: TPanel
Left = 10
Top = 10
Width = 124
Height = 26
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Destination'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnDblClick = pnlTargetDblClick
end
object pnlName: TPanel
Left = 10
Top = 39
Width = 124
Height = 26
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Name'
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
object txtFilename: TEdit
Left = 128
Top = 10
Width = 353
Height = 24
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
Text = 'txtFilename'
end
object txtTitle: TEdit
Left = 128
Top = 39
Width = 383
Height = 24
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
Text = 'txtTitle'
end
object optUseOldFormat: TRadioButton
Left = 10
Top = 79
Width = 304
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Use classic flame format'
Checked = True
TabOrder = 6
TabStop = True
end
object optUseNewFormat: TRadioButton
Left = 10
Top = 101
Width = 304
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Use new flame format'
Enabled = False
TabOrder = 7
end
end
Forms/Save.pas
+243
View File
@@ -0,0 +1,243 @@
{
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 Save;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Translation;
type
ESaveType = (stSaveParameters, stSaveAllParameters, stSaveGradient, stExportUPR, stSaveTemplate);
TSaveForm = class(TForm)
txtFilename: TEdit;
txtTitle: TEdit;
btnSave: TButton;
btnCancel: TButton;
btnDefGradient: TSpeedButton;
pnlTarget: TPanel;
pnlName: TPanel;
optUseOldFormat: TRadioButton;
optUseNewFormat: TRadioButton;
procedure FormCreate(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnDefGradientClick(Sender: TObject);
procedure pnlTargetDblClick(Sender: TObject);
private
public
Title: string;
Filename: string;
SaveType : ESaveType;
end;
var
SaveForm: TSaveForm;
implementation
uses Main, Global, cmap;
{$R *.DFM}
function EntryExists(En, Fl: string): boolean;
{ Searches for existing identifier in parameter files }
var
FStrings: TStringList;
i: integer;
begin
Result := False;
if FileExists(Fl) then
begin
FStrings := TStringList.Create;
try
FStrings.LoadFromFile(Fl);
for i := 0 to FStrings.Count - 1 do
if Pos(LowerCase(En) + ' {', Lowercase(FStrings[i])) = 1 then
Result := True;
finally
FStrings.Free;
end
end
else
Result := False;
end;
function SaveTypeTextKey(st : ESaveType) : string;
begin
case st of
stSaveParameters: Result := 'save-type-parameters';
stSaveAllParameters: Result := 'save-type-allparameters';
stSaveGradient: Result := 'save-type-gradient';
stExportUPR: Result := 'save-type-exportupr';
stSaveTemplate: Result := 'save-type-template';
end;
end;
function SaveDefaultExt(st : ESaveType) : string;
begin
case st of
stSaveParameters: Result := 'flame';
stSaveAllParameters: Result := 'flame';
stSaveGradient: Result := 'gradient';
stExportUPR: Result := 'upr';
stSaveTemplate: Result := 'template';
end;
end;
function SaveFilter(st : ESaveType): string;
begin
case st of
stSaveParameters: Result := Format('%s|*.flame;*.xml|%s|*.*',
[TextByKey('common-filter-flamefiles'), TextByKey('common-filter-allfiles')]);
stSaveAllParameters: Result := Format('%s|*.flame;*.xml|%s|*.*',
[TextByKey('common-filter-flamefiles'), TextByKey('common-filter-allfiles')]);
stSaveGradient: Result := Format('%s|*.gradient;*.ugr|%s|*.*',
[TextByKey('common-filter-gradientfiles'), TextByKey('common-filter-allfiles')]);
stExportUPR: Result := Format('%s|*.upr|%s|*.*',
[TextByKey('common-filter-uprfiles'), TextByKey('common-filter-allfiles')]);
stSaveTemplate: Result := Format('%s|*.template;*.flame',
[TextByKey('common-filter-templatefiles')]);
end;
end;
procedure TSaveForm.btnSaveClick(Sender: TObject);
var
t, f: string;
check, onestr: boolean;
begin
t := Trim(txtTitle.Text);
f := Trim(txtFilename.Text);
if ((t = '') and txtTitle.Enabled) then
begin
Application.MessageBox(PChar(TextByKey('save-status-notitle')), 'Apophysis', 48);
Exit;
end;
if f = '' then
begin
Application.MessageBox(PChar(TextByKey('save-status-invalidfilename')), 'Apophysis', 48);
Exit;
end;
if ExtractFileExt(f) = '' then
begin
Application.MessageBox(PChar(TextByKey('save-status-invalidfilename')), 'Apophysis', 48);
Exit;
end;
if (SaveType = stSaveParameters) or (SaveType = stSaveTemplate) then // AV
begin
check := XMLEntryExists(t, f);
onestr := false;
end
else if SaveType = stSaveAllParameters then
begin
onestr := true;
check := FileExists(f);
end
else
begin
onestr := false;
t := CleanIdentifier(t);
check := EntryExists(t, f);
end;
if check then begin if onestr then begin
if Application.MessageBox(PChar(Format(TextByKey('save-status-alreadyexists2'), [f])),
'Apophysis', 52) = ID_NO then exit;
end else begin
if Application.MessageBox(PChar(Format(TextByKey('save-status-alreadyexists'), [t, f])),
'Apophysis', 52) = ID_NO then exit;
end end;
if (t = '*') then t := '';
Title := t;
Filename := f;
ModalResult := mrOK;
end;
procedure TSaveForm.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TSaveForm.FormShow(Sender: TObject);
begin
txtFilename.Text := Filename;
txtTitle.Text := Title;
//btnSave.SetFocus;
self.Caption := TextByKey(SaveTypeTextKey(SaveType));
{if (SaveType = stSaveParameters) or (SaveType = stSaveAllParameters) then
self.Height := 160
else self.Height := 120; }
if (SaveType = stSaveGradient) then // AV
pnlName.Caption := TextByKey('save-namepal')
else pnlName.Caption := TextByKey('save-name');
if (SaveType = stSaveAllParameters) then txtTitle.Text := '';
txtTitle.Enabled := (SaveType <> stSaveAllParameters);
if (not txtTitle.Enabled) then pnlName.Font.Color := clGrayText
else pnlName.Font.Color := clWindowText;
optUseOldFormat.Visible := (SaveType = stSaveParameters) or (SaveType = stSaveAllParameters);
optUseNewFormat.Visible := (SaveType = stSaveParameters) or (SaveType = stSaveAllParameters);
txtFileName.ReadOnly := (SaveType = stSaveTemplate); // AV
end;
procedure TSaveForm.pnlTargetDblClick(Sender: TObject);
begin
if (SaveType = stSaveParameters) then // AV
txtFileName.Text := OpenFile;
end;
procedure TSaveForm.btnDefGradientClick(Sender: TObject);
var
fn:string;
begin
if OpenSaveFileDialog(self, SaveDefaultExt(SaveType), SaveFilter(SaveType),
ExtractFilePath(txtFilename.Text), TextByKey('common-browse'), fn, false,
false, false, false) then
if (SaveType <> stSaveTemplate) then
txtFileName.Text := fn
else
txtFileName.Text := AppPath + 'Templates\' + ExtractFileName(fn); // AV
end;
procedure TSaveForm.FormCreate(Sender: TObject);
begin
btnCancel.Caption := TextByKey('common-cancel');
btnSave.Caption := TextByKey('common-ok');
btnDefGradient.Hint := TextByKey('common-browse');
pnlTarget.Caption := TextByKey('common-destination');
//pnlName.Caption := TextByKey('save-name');
optUseOldFormat.Caption := TextByKey('save-oldformat');
optUseNewFormat.Caption := TextByKey('save-newformat');
end;
end.
Forms/SavePreset.dfm
+63
View File
@@ -0,0 +1,63 @@
object SavePresetForm: TSavePresetForm
Left = 295
Top = 331
BorderStyle = bsDialog
Caption = 'Save Preset'
ClientHeight = 66
ClientWidth = 349
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
349
66)
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 190
Top = 37
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 270
Top = 37
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Cancel'
ModalResult = 2
TabOrder = 2
end
object pnlName: TPanel
Left = 8
Top = 8
Width = 101
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Name'
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object txtPresetName: TEdit
Left = 104
Top = 8
Width = 239
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
end
end
Forms/SavePreset.pas
+70
View File
@@ -0,0 +1,70 @@
{
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 SavePreset;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Translation;
type
TSavePresetForm = class(TForm)
txtPresetName: TEdit;
Button1: TButton;
Button2: TButton;
pnlName: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SavePresetForm: TSavePresetForm;
implementation
{$R *.DFM}
procedure TSavePresetForm.Button1Click(Sender: TObject);
begin
if txtPresetName.Text = '' then
begin
Application.MessageBox(PChar(TextByKey('savepreset-notitle')), 'Apophysis', 48);
Exit;
end;
end;
procedure TSavePresetForm.FormCreate(Sender: TObject);
begin
self.Caption := TextBykey('savepreset-title');
button1.Caption := TextByKey('common-ok');
button2.Caption := TextByKey('common-cancel');
pnlName.Caption := TextByKey('savepreset-name');
end;
end.
Forms/ScriptForm.dfm
+1482
View File
File diff suppressed because it is too large Load Diff
Forms/ScriptForm.pas
+5913
View File
File diff suppressed because it is too large Load Diff
Forms/ScriptRender.dfm
+40
View File
@@ -0,0 +1,40 @@
object ScriptRenderForm: TScriptRenderForm
Left = 390
Top = 391
BorderStyle = bsDialog
Caption = 'ScriptRenderForm'
ClientHeight = 58
ClientWidth = 285
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = (
285
58)
PixelsPerInch = 96
TextHeight = 13
object btnCancel: TButton
Left = 96
Top = 28
Width = 95
Height = 25
Anchors = [akLeft, akRight, akBottom]
Caption = '&Cancel'
TabOrder = 0
OnClick = btnCancelClick
end
object ProgressBar: TProgressBar
Left = 8
Top = 8
Width = 271
Height = 13
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
end
end
Forms/ScriptRender.pas
+178
View File
@@ -0,0 +1,178 @@
{
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 ScriptRender;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, RenderThread, cmap, ControlPoint, Translation;
type
TScriptRenderForm = class(TForm)
btnCancel: TButton;
ProgressBar: TProgressBar;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
private
// PixelsPerUnit: double;
StartTime: TDateTime;
Remainder: TDateTime;
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
procedure HandleThreadTermination(var Message: TMessage);
message WM_THREAD_TERMINATE;
public
Renderer: TRenderThread;
ColorMap: TColorMap;
cp: TControlPoint;
Filename: string;
ImageWidth, ImageHeight, Oversample: Integer;
zoom, Sample_Density, Brightness, Gamma, Vibrancy, Filter_Radius: double;
center: array[0..1] of double;
procedure OnProgress(prog: double);
procedure Render;
procedure SetRenderBounds;
end;
var
ScriptRenderForm: TScriptRenderForm;
Cancelled: boolean;
implementation
uses Global, Math, FormRender, ScriptForm, Main;
{$R *.DFM}
procedure TScriptRenderForm.SetRenderBounds;
begin
cp.copy(ScriptEditor.cp);
cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height);
// --?-- cp.CalcBoundBox;
cp.center[0] := ScriptEditor.cp.center[0];
cp.center[1] := ScriptEditor.cp.center[1];
cp.zoom := ScriptEditor.cp.zoom;
end;
procedure TScriptRenderForm.Render;
begin
assert(not Assigned(Renderer));
Renderer := TRenderThread.Create;
Cancelled := False;
ScriptEditor.Scripter.Paused := True;
StartTime := Now;
Remainder := 1;
cp.copy(ScriptEditor.cp);
Filename := ScriptEditor.Renderer.Filename;
cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height);
//cp.Transparency := (PNGTransparency <> 0) and (UpperCase(ExtractFileExt(ScriptEditor.Renderer.FileName)) = '.PNG');
if (UpperCase(ExtractFileExt(ScriptEditor.Renderer.FileName)) = '.PNG') then
begin // AV: added new property
cp.Transparency := (PNGTransparency <> 0);
if ScriptEditor.Renderer.EmbedParameters then
Renderer.EmbedText(Trim(MainForm.RetrieveXML(cp))); // AV
end
else
cp.Transparency := False; // AV
Renderer.OnProgress := OnProgress;
Renderer.SetCP(cp);
if (ScriptEditor.Renderer.MaxMemory > 0) then
Renderer.MaxMem := ScriptEditor.Renderer.MaxMemory;
Renderer.TargetHandle := Handle;
renderPath := ExtractFilePath(ScriptEditor.Renderer.Filename);
Renderer.Priority := tpLower;
Renderer.NrThreads := NrTreads; // AV: now works fine
Renderer.Resume;
// Renderer.SaveImage(FileName);
// ScriptEditor.Scripter.Paused := False;
end;
procedure TScriptRenderForm.OnProgress(prog: double);
var
Elapsed: TDateTime;
begin
prog := (Renderer.Slice + Prog) / Renderer.NrSlices;
ProgressBar.Position := round(100 * prog);
Elapsed := Now - StartTime;
// if prog > 0 then Remainder := Elapsed * (1/prog - 1);
//Application.ProcessMessages;
end;
procedure TScriptRenderForm.FormDestroy(Sender: TObject);
begin
cp.free;
assert(not Assigned(Renderer)); //if Assigned(Renderer) then Renderer.free;
end;
procedure TScriptRenderForm.FormCreate(Sender: TObject);
begin
//Renderer := TRenderThread.Create;
self.Hint := TextByKey('script-rendering');
btnCancel.Caption := TextByKey('common-cancel');
cp := TControlPoint.Create;
end;
procedure TScriptRenderForm.btnCancelClick(Sender: TObject);
begin
ScriptEditor.Scripter.Halt;
Cancelled := True;
// Renderer.Stop;
if Assigned(Renderer) then begin
Renderer.Terminate;
Renderer.WaitFor;
Renderer.Free;
Renderer := nil;
end;
LastError := TextByKey('script-status-cancelrender');
end;
procedure TScriptRenderForm.HandleThreadCompletion(var Message: TMessage);
begin
Renderer.SaveImage(FileName);
Renderer.Free;
Renderer := nil;
ScriptEditor.Scripter.Paused := False;
end;
procedure TScriptRenderForm.HandleThreadTermination(var Message: TMessage);
begin
if Assigned(Renderer) then
begin
Renderer.Free;
Renderer := nil;
end;
end;
end.
Forms/SplashForm.dfm
+3638
View File
File diff suppressed because it is too large Load Diff
Forms/SplashForm.pas
+60
View File
@@ -0,0 +1,60 @@
unit SplashForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Global, Vcl.Imaging.jpeg;
type
TSplashWindow = class(TForm)
BackgroundImage: TImage;
lblVersion: TLabel;
lblInfo: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
private
{ Private declarations }
public
procedure SetInfo(info:string);
end;
const DURATION: integer = 900;
var
SplashWindow: TSplashWindow;
implementation
{$R *.dfm}
procedure TSplashWindow.FormCreate(Sender: TObject);
begin
lblVersion.Caption := APP_VERSION + APP_BUILD;
// AV: for compatibility with different UI color styles:
with lblVersion do Canvas.Font := Font;
Left := (Screen.Width - Width) div 2;
Top := (Screen.Height - Height) div 2;
end;
procedure TSplashWindow.FormHide(Sender: TObject);
begin
repeat
Application.ProcessMessages;
until CloseQuery;
AnimateWindow(Handle, DURATION, {AW_BLEND} AW_CENTER or AW_HIDE)
end;
procedure TSplashWindow.FormShow(Sender: TObject);
begin
AnimateWindow(Handle, DURATION, {AW_BLEND} AW_CENTER);
end;
procedure TSplashWindow.SetInfo(info: string);
begin
// AV: for compatibility with different UI color styles:
lblInfo.Repaint;
lblInfo.Canvas.TextOut(0, 0, info);
end;
end.
Forms/Template.dfm
+110
View File
@@ -0,0 +1,110 @@
object TemplateForm: TTemplateForm
Left = 399
Top = 213
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'New Flame'
ClientHeight = 391
ClientWidth = 564
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsStayOnTop
Icon.Data = {
0000010001001010000001001800680300001600000028000000100000002000
0000010018000000000000030000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000B7A293634935634935634935
6349356349356349356349356349356349356349350000000000000000000000
00000000B7A293FFFFFFB7A293B7A293B7A293B7A293B7A293B7A293B7A293B7
A293634935000000000000000000000000000000B7A293FFFFFFFFFFFFFCFAF9
F7F1EEF1E7E1ECDDD5E6D3C9E1CABDB7A2936349350000000000000000000000
00000000B7A293FFFFFFFFFFFFF5F5F5F1EEECECE4E0E6DBD4E1D1C9E4CFC4B7
A293634935000000000000000000000000000000B7A293FFFFFFC1C1C1ACACAC
ABAAA9A7A4A2A39D99A09692B4A69FB7A2936349350000000000000000000000
00000000BAA596FFFFFFB6B6B6ECECECFFFFFFFBF8F7EEE7E49C9591E8D8D0B7
A293634935000000000000000000000000000000BEA99AFFFFFFB6B6B6ECECEC
FFFFFFF8F7F6ACAAA7E7DEDAEEE1DAB7A2936349350000000000000000000000
00000000C3AE9EFFFFFFB6B6B6ECECECFCFCFCB9B9B9CCCBCAF7F1EEF1E7E1B7
A293634935000000000000000000000000000000C8B2A3FFFFFFB5B5B5EDEDED
C1C1C1CBCBCBFEFEFEFAF7F5F5EDE9B7A2936349350000000000000000000000
00000000CCB6A7FFFFFFB0B0B0C7C7C7C7C7C7FFFFFFFFFFFFFDFCFBB7A293B7
A293644A36000000000000000000000000000000D1BBABFFFFFFB6B6B6C1C1C1
FFFFFFFFFFFFFFFFFFB7A293644A36644A36644A360000000000000000000000
00000000D5BFAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB9A495D4C5BA64
4A36E1D5CD000000000000000000000000000000D8C2B2FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFC0AB9C644A36E2D6CD0000000000000000000000000000
00000000D8C2B2D8C2B2D8C2B2D8C2B2D8C2B2D4BEAECFB9A9C9B3A4E2D6CD00
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
0000C0070000C0070000C0070000C0070000C0070000C0070000C0070000C007
0000C0070000C0070000C0070000C0070000C00F0000C01F0000FFFF0000}
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
564
391)
PixelsPerInch = 96
TextHeight = 13
object lblFile: TLabel
Left = 16
Top = 364
Width = 346
Height = 13
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
ExplicitWidth = 329
end
object btnCancel: TButton
Left = 464
Top = 359
Width = 89
Height = 25
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object btnOK: TButton
Left = 368
Top = 359
Width = 89
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
Enabled = False
TabOrder = 2
OnClick = btnOKClick
end
object TemplateList: TListView
Left = 8
Top = 8
Width = 546
Height = 344
Anchors = [akLeft, akTop, akRight, akBottom]
BevelInner = bvNone
BevelOuter = bvNone
BevelKind = bkTile
BorderStyle = bsNone
Color = clBtnFace
Columns = <>
ColumnClick = False
LargeImages = UsedThumbnails
TabOrder = 0
OnChange = TemplateListChange
end
object UsedThumbnails: TImageList
Height = 128
Masked = False
Width = 128
Left = 40
Top = 304
end
end
Forms/Template.pas
+347
View File
@@ -0,0 +1,347 @@
{
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 Template;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Translation,
Dialogs, StdCtrls, ComCtrls, ImgList, ControlPoint, cmap, RenderingInterface, Main,
Global, Adjust, System.ImageList;
type
TTemplateForm = class(TForm)
TemplateList: TListView;
btnCancel: TButton;
btnOK: TButton;
UsedThumbnails: TImageList;
lblFile: TLabel;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TemplateListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure btnOKClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Files: TStringList; // AV: replaced "useless" hidded TListBox
public
{ Public declarations }
end;
var
TemplateForm: TTemplateForm;
const
blankFlameXML1 = '<flame name="Blank Flame" version="Apophysis" size="1500 1000" center="0 0" background="0 0 0">';
blankFlameXML2 = '<xform weight="0.5" color="0" linear3D="1" coefs="1 0 0 1 0 0" />';
blankFlameXML3 = '<palette count="256" format="RGB">';
procedure ListTemplateByFileName(filename:string);
implementation
{$R *.dfm}
function LoadUserTemplates2(mask: string): integer;
var
FindResult: integer;
SearchRec : TSearchRec;
Path : string;
begin
Path := AppPath + 'Templates\'; // AV
result := 0;
FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec);
while FindResult = 0 do
begin
ListTemplateByFileName(Path + SearchRec.Name);
result := result + 1;
FindResult := FindNext(SearchRec);
end;
{ free memory }
FindClose(SearchRec);
end;
function LoadUserTemplates: integer;
begin
LoadUserTemplates2('*.flame');
LoadUserTemplates2('*.template');
Result := 0; // make RTL happy
end;
function BlankXML: string;
var
i: integer;
s: string;
const
break = ' ';
begin
s := blankFlameXML1 + break + blankFlameXML2 + break + blankFlameXML3 + break;
for i := 1 to 256 do begin
s := s + '000000';
if (i mod 32 = 0) then s := s + break;
end;
s := s + '</palette></flame>';
Result := s;
end;
procedure DropBlank();
var
flameXML: string;
cp: TControlPoint;
bm: TBitmap;
Render: TRenderer;
ListItem: TListItem;
begin
cp := TControlPoint.Create;
Render := TRenderer.Create;
bm := TBitmap.Create;
cp.Clear;
flameXML := BlankXML;
MainForm.ParseXML(cp, PCHAR(flameXML), true);
cp.AdjustScale(TemplateForm.UsedThumbnails.Width, TemplateForm.UsedThumbnails.Height);
// start preview
cp.Width := TemplateForm.UsedThumbnails.Width;
cp.Height := TemplateForm.UsedThumbnails.Height;
cp.spatial_oversample := 1;
cp.spatial_filter_radius := 0.1;
cp.sample_density := 0.5; //3;
try
Render.SetCP(cp);
Render.Render;
finally
BM.Assign(Render.GetImage);
cp.Free;
Render.free;
end;
// Thumbnails
TemplateForm.UsedThumbnails.Add(bm, nil);
bm.Free; // AV: fixed multiple memory leaks!
ListItem := TemplateForm.TemplateList.Items.Add;
ListItem.Caption := 'Blank Flame';
ListItem.ImageIndex := 0;
TemplateForm.Files.Add('n/a');
//end preview
//
Application.ProcessMessages;
end;
procedure DropListItem(FileName: string; FlameName: string);
var
flameXML: string;
cp: TControlPoint;
bm: TBitmap;
Render: TRenderer;
ListItem: TListItem;
begin
cp := TControlPoint.Create;
Render := TRenderer.Create;
bm := TBitmap.Create;
cp.Clear;
flameXML := LoadXMLFlameText(filename, FlameName);
MainForm.ParseXML(cp, PCHAR(flameXML), true);
cp.AdjustScale(TemplateForm.UsedThumbnails.Width, TemplateForm.UsedThumbnails.Height);
// start preview
cp.Width := TemplateForm.UsedThumbnails.Width;
cp.Height := TemplateForm.UsedThumbnails.Height;
cp.spatial_oversample := 1;
cp.spatial_filter_radius := 0.1;
cp.sample_density := 3;
try
Render.SetCP(cp);
Render.Render;
finally
BM.Assign(Render.GetImage);
cp.Free;
Render.free;
end;
// Thumbnails
TemplateForm.UsedThumbnails.Add(bm, nil);
bm.Free; // AV: fixed multiple memory leaks!
ListItem := TemplateForm.TemplateList.Items.Add;
ListItem.Caption := FlameName;
ListItem.ImageIndex := TemplateForm.TemplateList.Items.Count - 1;
TemplateForm.Files.Add(FileName);
//end preview
//
Application.ProcessMessages;
end;
procedure ListTemplateByFileName(filename:string);
{ List .flame file }
var
sel: integer;
i, p: integer;
Title: string;
FStrings: TStringList;
begin
sel := 0;
if not FileExists(FileName) then exit;
FStrings := TStringList.Create;
FStrings.LoadFromFile(FileName);
try
if (Pos('<flame ', Lowercase(FStrings.Text)) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('<flame ', LowerCase(FStrings[i]));
if (p <> 0) then
begin
MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(FSTrings[i])));
MainForm.ListXMLScanner.Execute;
if Length(pname) = 0 then
Title := '*untitled ' + ptime
else
Title := Trim(pname);
if Title <> '' then
begin { Otherwise bad format }
DropListItem(FileName, Title);
end;
end;
end;
end;
finally
FStrings.Free;
end;
end;
procedure ListTemplate;
begin
TemplateForm.TemplateList.Items.BeginUpdate;
TemplateForm.TemplateList.Items.Clear;
TemplateForm.UsedThumbnails.Clear;
// AV: fixed - someone forgot to refresh the file list
TemplateForm.Files.Clear;
// hmmm...
(*for i := 0 to TemplateForm.UsedThumbnails.Count - 1 do
begin
TemplateForm.UsedThumbnails.GetBitmap(i, bm);
bm.Free;
end; *)
DropBlank;
ListTemplateByFileName(AppPath + templateFileName);
LoadUserTemplates;
TemplateForm.TemplateList.Items.EndUpdate;
TemplateForm.TemplateList.Selected := TemplateForm.TemplateList.Items[0];
end;
procedure TTemplateForm.FormCreate(Sender: TObject);
begin
self.Caption := TextByKey('template-title');
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
Files := TStringList.Create; // AV
end;
procedure TTemplateForm.FormDestroy(Sender: TObject);
begin
Files.Free; // AV
end;
procedure TTemplateForm.TemplateListChange(Sender: TObject;
Item: TListItem; Change: TItemChange);
var
fn : string;
begin
if (TemplateList.Selected = nil) then
btnOK.Enabled := false
else begin
if (TemplateList.Selected.Index >= 0) then begin
btnOK.Enabled := true;
if (TemplateList.Selected.Index > 0) then begin
fn := ChangeFileExt(ExtractFileName(Files[TemplateList.Selected.Index]), '');
if (LowerCase(fn) <> 'apophysisav') then
lblFile.Caption := TextByKey('template-filename') + fn
else lblFile.Caption := '';
end else begin
lblFile.Caption := '';
end;
end else
btnOK.Enabled := false;
end;
end;
procedure TTemplateForm.btnOKClick(Sender: TObject);
var
flameXML: string;
fn: string;
ci: integer;
blank: boolean;
begin
fn := Files[TemplateList.Selected.Index];
blank := (TemplateList.Selected.Index = 0);
if blank then
flameXML := BlankXML
else
flameXML := LoadXMLFlameText(fn, TemplateList.Selected.Caption);
MainForm.UpdateUndo;
MainForm.StopThread;
MainForm.InvokeLoadXML(flameXML);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
MainForm.Statusbar.Panels[3].Text := MainCp.name;
{if ResizeOnLoad then}
MainForm.ResizeImage;
MainForm.RedrawTimer.Enabled := True;
Application.ProcessMessages;
MainForm.UpdateWindows;
// AV: fixed a bug with black flames on the black background
if RandomizeTemplates or blank then // AV
if (randGradient = 3) then // AV: only if user prefer new palettes
AdjustForm.mnuRandomize.Click
else begin // AV: use preset palette
ci := Random(NRCMAPS);
GetCMap(ci, 1, MainCp.cmap);
MainCp.cmapIndex := ci;
end;
if blank then // AV: fixed resetting values to 1
begin
MainCp.brightness := defBrightness;
MainCp.gamma := defGamma;
MainCp.gammaThreshRelative := defGammaThreshold;
MainCp.contrast := defContrast;
MainCp.Vibrancy := defVibrancy;
Maincp.sample_density := defSampleDensity;
end;
ModalResult := mrOK; // AV
end;
procedure TTemplateForm.FormShow(Sender: TObject);
begin
ListTemplate;
end;
end.
Forms/Tracer.dfm
+132
View File
@@ -0,0 +1,132 @@
object TraceForm: TTraceForm
Left = 36
Top = 159
Caption = 'Trace'
ClientHeight = 489
ClientWidth = 395
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001001010000000000800680500001600000028000000100000002000
0000010008000000000000010000000000000000000000010000000100000000
0000000080000080000000808000800000008000800080800000C0C0C000C0DC
C000F0CAA60004040400080808000C0C0C0011111100161616001C1C1C002222
220029292900555555004D4D4D004242420039393900807CFF005050FF009300
D600FFECCC00C6D6EF00D6E7E70090A9AD000000330000006600000099000000
CC00003300000033330000336600003399000033CC000033FF00006600000066
330000666600006699000066CC000066FF000099000000993300009966000099
99000099CC000099FF0000CC000000CC330000CC660000CC990000CCCC0000CC
FF0000FF660000FF990000FFCC00330000003300330033006600330099003300
CC003300FF00333300003333330033336600333399003333CC003333FF003366
00003366330033666600336699003366CC003366FF0033990000339933003399
6600339999003399CC003399FF0033CC000033CC330033CC660033CC990033CC
CC0033CCFF0033FF330033FF660033FF990033FFCC0033FFFF00660000006600
330066006600660099006600CC006600FF006633000066333300663366006633
99006633CC006633FF00666600006666330066666600666699006666CC006699
00006699330066996600669999006699CC006699FF0066CC000066CC330066CC
990066CCCC0066CCFF0066FF000066FF330066FF990066FFCC00CC00FF00FF00
CC009999000099339900990099009900CC009900000099333300990066009933
CC009900FF00996600009966330099336600996699009966CC009933FF009999
330099996600999999009999CC009999FF0099CC000099CC330066CC660099CC
990099CCCC0099CCFF0099FF000099FF330099CC660099FF990099FFCC0099FF
FF00CC00000099003300CC006600CC009900CC00CC0099330000CC333300CC33
6600CC339900CC33CC00CC33FF00CC660000CC66330099666600CC669900CC66
CC009966FF00CC990000CC993300CC996600CC999900CC99CC00CC99FF00CCCC
0000CCCC3300CCCC6600CCCC9900CCCCCC00CCCCFF00CCFF0000CCFF330099FF
6600CCFF9900CCFFCC00CCFFFF00CC003300FF006600FF009900CC330000FF33
3300FF336600FF339900FF33CC00FF33FF00FF660000FF663300CC666600FF66
9900FF66CC00CC66FF00FF990000FF993300FF996600FF999900FF99CC00FF99
FF00FFCC0000FFCC3300FFCC6600FFCC9900FFCCCC00FFCCFF00FFFF3300CCFF
6600FFFF9900FFFFCC006666FF0066FF660066FFFF00FF666600FF66FF00FFFF
66002100A5005F5F5F00777777008686860096969600CBCBCB00B2B2B200D7D7
D700DDDDDD00E3E3E300EAEAEA00F1F1F100F8F8F800F0FBFF00A4A0A0008080
80000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
000000000000000000000000000000000000000000000000000000000000AC12
1212121212121212121212F70000AC000000000000000000000000120000AC00
0000000000000000000000120000AC00FA00FAFA00FA0000000000120000AC00
0000000000000000000000120000AC00FAFA00FAFAFA00FA000000120000AC00
0000000000000000000000120000AC00FA00FAFA00FAFA00000000120000AC00
0000000000000000000000120000AC000000000000000000000000120000ACAC
ACACACACACACACACACACACAC0000ACFF090909090909090909FFADFF0000ACAC
ACACACACACACACACACACACACAC0000000000000000000000000000000000FFFF
0000000100000001000000010000000100000001000000010000000100000001
0000000100000001000000010000000100000001000000010000FFFF0000}
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
395
489)
PixelsPerInch = 96
TextHeight = 13
object PageControl1: TPageControl
Left = 0
Top = 0
Width = 395
Height = 489
ActivePage = TabMain
Align = alClient
Images = MainForm.Buttons
TabOrder = 0
object TabMain: TTabSheet
Caption = 'Main'
ImageIndex = 16
object MainTrace: TMemo
Left = 0
Top = 0
Width = 387
Height = 460
Align = alClient
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clLime
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
object TabFullscreen: TTabSheet
Caption = 'Fullscreen'
ImageIndex = 52
object FullscreenTrace: TMemo
Left = 0
Top = 0
Width = 387
Height = 460
Align = alClient
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clLime
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object cbTraceLevel: TComboBox
Left = 280
Top = 0
Width = 121
Height = 21
Style = csDropDownList
Anchors = [akTop, akRight]
TabOrder = 1
OnSelect = cbTraceLevelSelect
Items.Strings = (
'No trace'
'Minimal trace'
'Full trace')
end
end
Forms/Tracer.pas
+156
View File
@@ -0,0 +1,156 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit Tracer;
{$define TRACEFORM_HIDDEN}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Translation;
type
TTraceForm = class(TForm)
PageControl1: TPageControl;
TabMain: TTabSheet;
TabFullscreen: TTabSheet;
FullscreenTrace: TMemo;
cbTraceLevel: TComboBox;
MainTrace: TMemo;
procedure cbTraceLevelSelect(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
TraceForm: TTraceForm;
var
TraceLevel: integer;
const
MsgComplete = '< Received WM_THREAD_COMPLETE from RenderThread #';
MsgTerminated = '< Received WM_THREAD_TERMINATE from RenderThread #';
MsgNotAssigned = 'Ignoring message: RenderThread does not exist';
MsgAnotherRunning = 'Ignoring message: another RenderThread is running';
implementation
{$R *.dfm}
uses
Registry,
Global, Main;
procedure TTraceForm.cbTraceLevelSelect(Sender: TObject);
begin
TraceLevel := cbTraceLevel.ItemIndex;
end;
procedure TTraceForm.FormCreate(Sender: TObject);
var
Registry: TRegistry;
begin
{ Read position from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Trace', False) then
begin
if Registry.ValueExists('Top') then
self.Top := Registry.ReadInteger('Top');
if Registry.ValueExists('Left') then
self.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Width') then
self.Width := Registry.ReadInteger('Width');
if Registry.ValueExists('Height') then
self.Height := Registry.ReadInteger('Height');
{$ifndef TRACEFORM_HIDDEN}
if Registry.ValueExists('TraceLevel') then
TraceLevel := Registry.ReadInteger('TraceLevel')
else
TraceLevel := 0;
MainForm.tbShowTrace.Visible := true;
MainForm.tbShowTrace.Enabled := true;
MainForm.tbTraceSeparator.Visible := true;
MainForm.tbTraceSeparator.Enabled := true;
{$else}
TraceLevel := 0;
//MainForm.tbShowTrace.Visible := false;
//MainForm.tbShowTrace.Enabled := false;
//MainForm.tbTraceSeparator.Visible := false;
//MainForm.tbTraceSeparator.Enabled := false;
{$endif}
end;
Registry.CloseKey;
finally
Registry.Free;
end;
// AV: translation added
self.Caption := TextByKey('common-trace-title');
TabMain.Caption := TextByKey('common-trace-main');
TabFullScreen.Caption := TextByKey('common-trace-fullscreen');
cbTraceLevel.Items[0] := TextByKey('common-trace-notrace');
cbTraceLevel.Items[1] := TextByKey('common-trace-minimal');
cbTraceLevel.Items[2] := TextByKey('common-trace-fulltrace');
cbTraceLevel.ItemIndex := TraceLevel;
end;
procedure TTraceForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
Registry: TRegistry;
begin
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Trace', True) then
begin
if self.WindowState <> wsMaximized then begin
Registry.WriteInteger('Top', self.Top);
Registry.WriteInteger('Left', self.Left);
Registry.WriteInteger('Width', self.Width);
Registry.WriteInteger('Height', self.Height);
Registry.WriteInteger('TraceLevel', TraceLevel);
end;
end;
finally
Registry.Free;
end;
end;
end.
Forms/VarOrderForm.dfm
+381
View File
@@ -0,0 +1,381 @@
object VarOrder: TVarOrder
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Variation Order'
ClientHeight = 371
ClientWidth = 335
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001616000000000000100800001600000028000000160000002C00
000001002000000000009007000000000000000000000000000000000000FFFF
FF00FFFFFF00FFFFFF00FF66000BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF66003FFF66
00DFFF6B09FFFF6600E0FF66003AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF690601FF6906E4FFB17EFFFFC299FFFFB5
84FFFF6906D2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FF731606FF7316F7FF934CFFFF751AFFFFCDACFFFF7316F5FFFF
FF004F4F4FB44F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FB4FFFFFF00FFFFFF00FFFF
FF00FF7D2657FF7D26FFFFC69FFFFFAA71FFFF7D26C1FFFFFF00636363FFFCFC
FCFFFCFCFCFFFCFCFCFFFCFCFCFFF9F9F9FFF3F3F3FFEDEDEDFFE6E6E6FFE0E0
E0FFE0E0E0FFE0E0E0FF636363FFFFFFFF00FFFFFF00FFFFFF00FF8636E8FFA5
68FFFF893BFFFFCBA9FFFF8636DCFFFFFF00777777B4777777FF777777FF7777
77FF777777FF777777FF777777FF777777FF777777FF777777FF777777FF7777
77FF777777B4FFFFFF00FFFFFF00FFFFFF00FF9046C4FFB17DFFFFCCA9FFFFB4
81FFFF9046B1FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FF995522FF9955B4FF9955E2FF9955B0FF995519FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FF66000BFF660040FF660040FF66003DFF660006FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF660003FF6600C1FF66
00FFFF6600FFFF6600FFFF6600B4FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF6B0904FF6C0AF4FFD2B3FFFFB585FFFFA3
65FFFF6B09BBFFFFFF004F4F4FB44F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FB4FFFF
FF00FFFFFF00FFFFFF00FF771D8BFF924AFFFFB98AFFFF7B25FFFF771D74FFFF
FF00636363FFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFF9F9F9FFF3F3F3FFEDED
EDFFE6E6E6FFE0E0E0FFE0E0E0FFE0E0E0FF636363FFFFFFFF00FFFFFF00FFFF
FF00FF8330EAFF8D41FFFF9D5BFFFFB482FFFF8330B5FFFFFF00777777B47777
77FF777777FF777777FF777777FF777777FF777777FF777777FF777777FF7777
77FF777777FF777777FF777777B4FFFFFF00FFFFFF00FFFFFF00FF8F44C0FFBD
91FFFFC49CFFFFB07BFFFF8F4487FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF9A5717FF9A5796FF9A57B9FF9A
577EFF9A5707FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FF660008FF660040FF660040FF66003CFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FF6600B9FF6600FFFF6600FFFF6600FFFF66008EFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF6600CAFFA5
69FFFFCFAFFFFF9853FFFF66009EFFFFFF004F4F4FB44F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F
4FFF4F4F4FB4FFFFFF00FFFFFF00FFFFFF00FF701151FF7011FDFFC29AFFFF70
11E6FF701104FFFFFF00636363FFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFF9F9
F9FFF3F3F3FFEDEDEDFFE6E6E6FFE0E0E0FFE0E0E0FFE0E0E0FF636363FFFFFF
FF00FFFFFF00FFFFFF00FF7C24EBFF8433FFFFC59EFFFF7C24DEFFFFFF00FFFF
FF00777777B4777777FF777777FF777777FF777777FF777777FF777777FF7777
77FF777777FF777777FF777777FF777777FF777777B4FFFFFF00FFFFFF00FFFF
FF00FF8737BEFFAE78FFFFC7A2FFFF8737D6FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF934A0DFF93
4A87FF934ABDFF934A30FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C7FFFF0083FFFF0082000E00C200
0E0082000F0083FFFE00C7FFFE00FFFFFF0083FFFF0082000E0086000E008200
0E0083FFFE00CFFFFE00FFFFFF0083FFFF0082000E00C6000E0086000F0087FF
FE00CFFFFE00}
OldCreateOrder = False
Position = poOwnerFormCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
335
371)
PixelsPerInch = 96
TextHeight = 13
object btnTop: TSpeedButton
Left = 221
Top = 25
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'To Top'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFBF6331
CA7544CB7238C56125DFA88DFFFFFFFFFFFFFFFFFFFFFFFFEAB99BD96215E161
0AE46A14E16E1FFFFFFFFFFFFFBE653CE6C1A6FFFCD6F5C283CB6220D89A7CFF
FFFFFFFFFFE2A98AD66921F77711FF8A22F3852BDE7025FFFFFFFFFFFFF2E1D9
C06847DEAF91FFE9BDF9B064D0611AD79673DB9F7FD67032FA8325FF8B21EB7E
26D97434F7DECEFFFFFFFFFFFFFFFFFFF6EBE6BE6842D99D7BFFDBA8FD9C42D4
5A0BD35B0CFC8222FF871DE5761DD47134F8E6DBFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFDF9F8C36F4BD2936DFECE96FF8722FF6F00FF8419DF6E1BD17741FBF3
EEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCF8F6C7795CCD855DFD
C285FF8E2AD66413CF7E52FBF4F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFEFECC876CCB7A4DD0773BCF835EFDFBF9FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFFEFEFFFFFFFFFFFFFEFCFBDB
AA93DBA68CFDFAF8FFFFFFFFFFFFFFFEFEFFFEFEFFFFFFFFFFFFFFFFFFCE9E86
B56849B76745C27E60F3E6E0FFFFFFFFFFFFFFFFFFFFFFFFF7ECE6D38E67CC74
41CF7641DFA27CFFFFFFFFFFFFA44516DDBA92E7C392D38B53B15831EEDBD3FF
FFFFFFFFFFF3E2DBC16C3FDA5F0AEE7310EB7D25C55209FFFFFFFFFFFFD4A591
BA7352F7F4CFFFE8ABE18D4BAF5027ECD8CEF1E1D9B8633AE4792DFF8618FB90
2DCF6117DEA584FFFFFFFFFFFFFFFFFFD3A497AD5A35EEDBB0FFD48BE67F2EAF
4D1BB1562BE67F36FF861AF48625C05210DBA58AFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFD8AFA3AB5835E8D0A6FFC575EC6E0FEA6605FF8314EE7F22BA5114DCAF
99FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE0BEB4A95537E2C497FF
B760FF7E0FE9791EB4501BDFB8A6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFE8D0C9AA5639DEB688E59850AE4C22E5C9BCFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEEDCD6AF
5F3BAE603AEAD4CBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnTopClick
end
object btnMoveUp: TSpeedButton
Left = 221
Top = 60
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move Up'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAE5D36
A23C0FA93F0BB24D17EBCEBEFFFFFFFFFFFFFFFFFFFFFFFFF8E1D2E46D1EE966
0EF16B0EF9822BFFFFFFFFFFFFA64A1EE4A66EE79146D06620B95F33FBF4F1FF
FFFFFFFFFFFDF7F3DC793FEA7720F89A40FA9D44F5720FFFFFFFFFFFFFA95233
E0B18AFFDA96FEA754BF5212CD8F73FFFFFFFFFFFFDFA282D96B21FD9433FFA9
4CF79B43ED7420FFFFFFFFFFFFDFC0B5A14423F1CEA8FFC882F09546B14510EC
D4C7F3E0D6C76128F58C36FF7F14FA8524E06109F7C7A8FFFFFFFFFFFFFFFFFF
C0816FB87155FDE2BAFFBE72D97831B55B31BF6B43DF8346FF7A14FF7406E05F
07E59461FFFFFFFFFFFFFFFFFFFFFFFFF8F0EDA74F32D5A992FFE5B5FDB362BC
5417BC5013FD8323FF6D00E86302CE6625FAEBE1FFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFE1C4B89F4020ECD7C5FFDBA5F6A456F48B36FF8117F46902BF4A01EBC1
A7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC38773B2684FFBF3DFFF
C987FFAC5BFD963BC65108D08A64FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFDFAF9A64D32CEA394FFF3D6FFC47BD87D38AF5228FBF5F2FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9D2C9A04226EC
DCD4F2D0A9A24016E5C8BAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFC68D7DB2674AB97559C0826FFFFEFEFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8F6AE
5D3CAB5634FBF7F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveUpClick
end
object btnMoveDown: TSpeedButton
Left = 221
Top = 95
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Move Down'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFEF9F6EB7F38F07D30FEF6F0FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEAA177E9
7522F0822CF39F6AFFFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFF3D5C3DA6219F8B46FFC9036EB6008F9D1B5FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDF9F6D2672EEB9C5FFF
BA73FF760BF56903EC7623FEF5EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFD9916DD77538FDD29EFF9B44FF8420FE770EEE6300F0995DFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE7C4B1C15117F5CBA3FFC484F9
9138F8872CFF8521FB7209E85F00F7C4A1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F7EEE9BC592DE3AD88FFE3B9FEB267D66317D75F11FE963CFF821BF56C07E873
22FCE9DBFFFFFFFFFFFFFFFFFFFFFFFFC6816AC87B56FEF0D9FFD99EE28B46CE
6C36D57741E6853DFF973BFF7B14ED6604EE965AFFFFFFFFFFFFFFFFFFDDBAAF
AA4923F4E6D9FFF7D1F1BF85BF521AF3DBCDF7E6DBCF6225F4A05CFF8E2FFB78
12E65F01F5C5A3FFFFFFFFFFFFA95131E3C6BDFFFFFFFDF2C7C16430D59479FF
FFFFFFFFFFE3A688D46E35FDA75DFF8C28F77612E76D17FFFFFFFFFFFFA74F28
E1C4B2E3C7AACC8E61B85C36FBF5F2FFFFFFFFFFFFFDF7F4D37742E07529F382
28F47618E46103FFFFFFFFFFFFB0613D9D3B179D3A14A7461CECD3C6FFFFFFFF
FFFFFFFFFFFFFFFFF6E3D7CF6220D1570CD65B0BE1772FFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnMoveDownClick
end
object btnBottom: TSpeedButton
Left = 221
Top = 130
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'To Bottom'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFF5D9CBE07936E57C36F7D5C0FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEECBBDD66E37F2
C48DF79E4EE3671BF5CAB0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFE5B9A7CB6A38F2CF9CFFAE58FF770BF7801EE46A16F2BD9BFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDBA999C46936F3D8A8FFBD6FF1
710FF16906FF7F13F98522E66B14F1B58FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
D29D8CBD683CF5E1B3FFCE87EA7F2DCB6121D06C31EE8337FF831AFB8825E76B
12EFAA7DFFFEFEFFFFFFFFFFFFCC9985C17E5BFDFCD2FFE4A8E38B47C05E2AF5
E3D8F9ECE5D1723CEB7B2CFF8116FF8F2CEC741AF0A979FFFFFFFFFFFFA74717
D8B18AE1B787D0824BBD653BF3E2DAFFFFFFFFFFFFF8E9E1D67F49E46308F171
0DF17E23E36208FFFFFFFFFFFFDDAF97BD795FBD785ECB9177F6EBE5FFFFFFFF
FFFFFFFFFFFFFFFFFBF2EDE3A47DDF8E5BE4905AF0B790FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFCF9FFB580FFB27AFFFAF6FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8FE9D60FF
9D54FF953EFE9854FFF9F4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFEF6F1F58F51FCA564FFBD80FF8724FF7C15FF9447FFF3E9FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDF4EFED8342F7AC76FFC990FF
821EFF6C00FF7F17FF811CFF8B37FFEEE2FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F8E5DBE3773AF3B183FFD5A2FD983FF66D09FA7310FF8324FF811AFF831FFF86
2DFFE3D0FFFFFFFFFFFFFFFFFFF4DBCEDB7746F1C09CFFE6BAFCAE62ED7018F6
AD7DFAB789FB8431FF8426FF841EFF8927FF852BFFDDC4FFFFFFFFFFFFD06B33
F0C7A8FFF4CEF8BF7EE26D1EF1AF87FFFFFFFFFFFFFBBF96FA7D22FF7710FF83
1EFF8C2AFF7E1DFFFFFFFFFFFFCD7039D3743DD67231D86C26EFBA9BFFFFFFFF
FFFFFFFFFFFFFFFFFCCBA9FB7819FE7007FF7812FF8529FFFFFF}
Margin = 3
ParentBiDiMode = False
Spacing = 10
OnClick = btnBottomClick
end
object btnSort: TSpeedButton
Left = 221
Top = 165
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Sort by name'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFBFBFF
C7C7FFA7A7FFA4A4FFA4A4FFA6A6FFD5D5FFFDFDFFFFFFFFC8C8C82828289898
98FFFFFFFFFFFFFFFFFFFFFFFFF6F6FF6A6AFF1010FF1D1DFF3434FF3C3CFFA3
A3FFFCFCFFF9F9F98484841717175C5C5CE4E4E4FFFFFFFFFFFFFFFFFFFCFCFF
A2A2FF1D1DFF2A2AFFA2A2FFD1D1FFE9E9FFFFFFFFD8D8D83E3E3E1010102626
26B0B0B0FCFCFCFFFFFFFFFFFFFFFFFFEBEBFF7373FF1616FF6F6FFFEFEFFFFF
FFFFFFFFFF9090902625261A19191F1F1F636363F3F3F3FFFFFFFFFFFFFFFFFF
FFFFFFD9D9FF4D4DFF1B1BFF9A9AFFF9F9FFFFFFFFCECDCD8988883737377070
70BABABAFAFAFAFFFFFFFFFFFFFEFEFFDFDFFFBFBFFF7777FF1010FF3232FFCE
CEFFFFFFFFFFFFFFD3D3D34E4E4EABABABFFFFFFFFFFFFFFFFFFFFFFFFFBFBFF
9C9CFF3B3BFF2D2DFF2525FF2C2CFFBABAFFFFFFFFFFFFFFD4D4D4575757AFAF
AFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFE4E4FFC6C6FFC2C2FFC2C2FFC6C6FFEE
EEFFFFFFFFFFFFFFD7D6D6626262B4B4B4FFFFFFFFFFFFFFFFFFFFFFFFFEFCFB
F6E1D1F8E4D5FFFDFBFFFFFDF9E8DAF4DDCBFDFAF7FFFFFFD9D9D96D6D6DB9B9
B9FFFFFFFFFFFFFFFFFFFFFFFFFCF8F4DC9B67D68A4CF2DAC6F5E3D4D99259D7
8C4FFAEFE7FFFFFFDDDDDC797979BFBFBFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFA
E4B188CA6717D07932D27D38C96210DD9D6AFCF6F2FFFFFFE0E0DF858584C4C5
C4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1D6C0CD7024CE7228CF752DC96412EB
C4A5FFFEFEFFFFFFE3E3E2919190CACACAFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
F9EDE3D88F54CF752CD07730D27F3BF5E2D3FFFFFFFFFFFFE6E6E69D9D9DD0D0
D0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFCFAE5B48CC8600CC65B05DD9D6AFC
F8F4FFFFFFFFFFFFE9E9E9A9A9A9D6D6D6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFF0D4BDCF752DCC6B1DEAC3A3FFFFFFFFFFFFFFFFFFECECECB8B8B8DCDC
DCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF5EFEFD2BAEDCCB1FAF0E8FF
FFFFFFFFFFFFFFFFF9F9F9E7E7E7F3F3F3FFFFFFFFFFFFFFFFFF}
Margin = 3
ParentShowHint = False
ParentBiDiMode = False
ShowHint = True
Spacing = 5
OnClick = btnSortClick
end
object btnDefOrder: TSpeedButton
Left = 221
Top = 200
Width = 96
Height = 25
BiDiMode = bdLeftToRight
Caption = 'Default order'
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000C40E0000C40E00000000000000000000FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0864C
B0681FA65400FFFFFFA65400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFC0874BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B1691FFFFFFFFFFFFFFFFFFFFFFFFF0000000000000000000000000000000000
00000000000000000000FFFFFFFFFFFFFFFFFFA65400FFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0864B
B0681EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFC1864CB1691FA65400FFFFFFA65400FFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
B1691FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB1681EFFFFFFFFFFFFFFFFFFFFFFFF00
0000000000000000000000000000000000000000000000000000FFFFFFC1874B
B0681EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB1691FFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}
Margin = 3
ParentShowHint = False
ParentBiDiMode = False
ShowHint = True
Spacing = 5
OnClick = btnDefOrderClick
end
object pnlVarList: TPanel
Left = 8
Top = 8
Width = 200
Height = 320
ShowCaption = False
TabOrder = 0
object VarListView: TListView
Left = 1
Top = 1
Width = 198
Height = 318
Align = alClient
Columns = <
item
Width = 175
end>
ColumnClick = False
DragMode = dmAutomatic
FullDrag = True
HideSelection = False
ReadOnly = True
SmallImages = EditForm.IconsAV
TabOrder = 0
ViewStyle = vsReport
OnChange = VarListViewChange
OnCustomDrawItem = VarListViewCustomDrawItem
OnDragDrop = VarListViewDragDrop
OnDragOver = VarListViewDragOver
end
end
object btnOK: TButton
Left = 142
Top = 338
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&OK'
ModalResult = 1
TabOrder = 1
end
object btnCancel: TButton
Left = 231
Top = 338
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = '&Cancel'
ModalResult = 2
TabOrder = 2
end
end
Forms/VarOrderForm.pas
+340
View File
@@ -0,0 +1,340 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit VarOrderForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, StrUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Editor, Translation, Vcl.StdCtrls,
Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Buttons;
type
TVarOrder = class(TForm)
pnlVarList: TPanel;
VarListView: TListView;
btnOK: TButton;
btnCancel: TButton;
btnTop: TSpeedButton;
btnMoveUp: TSpeedButton;
btnMoveDown: TSpeedButton;
btnBottom: TSpeedButton;
btnSort: TSpeedButton;
btnDefOrder: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnMoveUpClick(Sender: TObject);
procedure VarListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure btnMoveDownClick(Sender: TObject);
procedure btnTopClick(Sender: TObject);
procedure btnBottomClick(Sender: TObject);
procedure btnSortClick(Sender: TObject);
procedure btnDefOrderClick(Sender: TObject);
procedure VarListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure VarListViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure VarListViewCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
totVars: integer;
usedVars: TStringList;
procedure ExchangeVars(const i, j: integer);
procedure SetVarIcon(const s: string; ListItem: TListItem);
procedure ShowSelected(const i: integer);
public
{ Public declarations }
Changed: boolean;
end;
var
VarOrder: TVarOrder;
implementation
uses
XFormMan, Global; // to get default variation order
{$R *.dfm}
procedure TVarOrder.btnBottomClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, totVars);
ShowSelected(totVars);
end;
procedure TVarOrder.btnDefOrderClick(Sender: TObject);
var
i, j: integer;
s, cap: string;
begin
VarListView.Items.BeginUpdate;
if assigned(VarListView.Selected) then
cap := VarListView.Selected.Caption
else
cap := 'linear';
j := 0;
for i := 0 to totVars do
begin
s := Varnames(i);
VarListView.Items[i].Caption := s;
SetVarIcon(s, VarListView.Items[i]);
if s = cap then j := i;
end;
VarListView.Selected := VarListView.Items[j];
ShowSelected(j);
VarListView.Items.EndUpdate;
Changed := True;
end;
procedure TVarOrder.btnMoveDownClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, i + 1);
ShowSelected(i + 1);
end;
procedure TVarOrder.btnMoveUpClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, i - 1);
ShowSelected(i - 1);
end;
procedure TVarOrder.btnSortClick(Sender: TObject);
begin
VarListView.Items.BeginUpdate;
VarListView.SortType := stText;
VarListView.SortType := stNone;
if not assigned(VarListView.Selected) then
VarListView.Selected := VarListView.Items[0];
ShowSelected(VarListView.Selected.Index);
VarListView.Items.EndUpdate;
Changed := True;
end;
procedure TVarOrder.btnTopClick(Sender: TObject);
var i: integer;
begin
if not assigned(VarListView.Selected) then
begin
Application.MessageBox(PChar(TextByKey('varorder-noselected')),
PChar('Apophysis AV'), MB_ICONWARNING);
exit;
end;
i := VarListView.Selected.Index;
ExchangeVars(i, 0);
ShowSelected(0);
end;
procedure TVarOrder.ExchangeVars(const i, j: integer);
var
tmpVarItem: TListItem;
n: integer;
begin
VarListView.Items.BeginUpdate;
tmpVarItem := TListItem.Create(VarListView.Items);
try
if (i < j) then
for n := i to (j - 1) do
begin
tmpVarItem.Assign(VarListView.Items.Item[n]);
VarListView.Items.Item[n] := VarListView.Items.Item[n + 1];
VarListView.Items.Item[n + 1] := tmpVarItem;
end
else // if (i > j) then
for n := i downto (j + 1) do
begin
tmpVarItem.Assign(VarListView.Items.Item[n]);
VarListView.Items.Item[n] := VarListView.Items.Item[n - 1];
VarListView.Items.Item[n - 1] := tmpVarItem;
end;
VarListView.Selected := VarListView.Items[j];
Changed := True;
finally
tmpVarItem.Free;
VarListView.Items.EndUpdate;
end;
end;
procedure TVarOrder.FormCreate(Sender: TObject);
begin
btnOK.Caption := TextByKey('common-ok');
btnCancel.Caption := TextByKey('common-cancel');
btnMoveUp.Caption := TextByKey('favscripts-moveup');
btnMoveDown.Caption := TextByKey('favscripts-movedown');
btnTop.Caption := TextByKey('varorder-totop');
btnBottom.Caption := TextByKey('varorder-tobottom');
btnSort.Caption := TextByKey('varorder-byname');
btnSort.Hint := TextByKey('varorder-bynamehint');
btnDefOrder.Caption := TextByKey('varorder-byindex');
btnDefOrder.Hint := TextByKey('varorder-byindexhint');
self.Caption := TextByKey('varorder-title');
usedVars := TStringList.Create;
end;
procedure TVarOrder.FormDestroy(Sender: TObject);
begin
usedVars.Free;
end;
procedure TVarOrder.FormShow(Sender: TObject);
var
ListItem: TListItem;
i, SelTX: integer;
s: string;
begin
Changed := False;
SelTX := EditForm.cbTransforms.ItemIndex;
if SelTX < EditForm.cp.NumXForms then
begin
s := TextByKey('editor-common-transform') + ' ' + IntToStr(SelTX + 1);
//if (EditForm.txtName.Text <> '') then
// s := s + ' - ' + EditForm.txtName.Text;
end else
s := TextByKey('editor-common-transform') + ' ' +
TextByKey('editor-common-finalxformlistitem');
VarListView.Column[0].Caption := s;
totVars := NrVar - 1;
VarListView.Items.BeginUpdate;
VarListView.Items.Clear;
usedVars.Clear;
for i := 0 to totVars do
begin
ListItem := VarListView.Items.Add;
s := EditForm.cp.xform[SelTX].ifs[i];
ListItem.Caption := s;
SetVarIcon(s, ListItem);
ListItem.Indent := 1;
if EditForm.cp.xform[SelTX].GetVariation(i) <> 0 then
usedVars.Add(Varnames(i));
end;
VarListView.Items.EndUpdate;
VarListView.Selected := VarListView.Items[0];
end;
procedure TVarOrder.SetVarIcon(const s: string; ListItem: TListItem);
begin
if (LeftStr(s, 4) = 'pre_') or (s = 'flatten') then
ListItem.ImageIndex := 7 // red
else if LeftStr(s, 5) = 'post_' then
ListItem.ImageIndex := 4 // blue
else if (s = 'trianglecrop') or (s = 'projective')
or (s = 'affine3D') or (s = 'spherecrop') then
ListItem.ImageIndex := 6 // violet
else
ListItem.ImageIndex := 5 // blue;
end;
procedure TVarOrder.ShowSelected(const i: integer);
begin
try
VarListView.Items[i].MakeVisible(false);
finally
VarListView.SetFocus;
end;
end;
procedure TVarOrder.VarListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
if (Item.Index = totVars) or (Item.Index < 0) then
begin
btnMoveDown.Enabled := False;
btnBottom.Enabled := False;
end else begin
btnMoveDown.Enabled := True;
btnBottom.Enabled := True;
end;
if (Item.Index <= 0) then
begin
btnMoveUp.Enabled := False;
btnTop.Enabled := False;
end else begin
btnMoveUp.Enabled := True;
btnTop.Enabled := True;
end;
end;
procedure TVarOrder.VarListViewCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
vRect: TRect;
begin
DefaultDraw := True;
if (usedVars.Count = 0) then exit;
vRect := Item.DisplayRect(drLabel);
if usedVars.IndexOf(Item.Caption) >= 0 then
with VarListView.Canvas do
begin
if (CurrentStyle = 'Windows') then
Brush.Color := $0002B076
else
Brush.Color := BrightColor;
FillRect(vRect);
if (CurrentStyle = 'Auric') then // make the text more visible
Font.Color := WinColor
else
Font.Color := TextColor;
TextOut(vRect.Left + 2, vRect.Top + 2, Item.Caption);
end;
end;
procedure TVarOrder.VarListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
var
i, j: integer;
begin
if not assigned(VarListView.Selected) then exit;
if Source = VarListView then
begin
try
i := VarListView.Selected.Index;
j := VarListView.GetItemAt(X,Y).Index;
if (j >= 0) and (i >= 0) and (i <> j) then
ExchangeVars(i, j);
except
Beep;
end;
end;
end;
procedure TVarOrder.VarListViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := (Source = VarListView);
end;
end.
Forms/formPostProcess.dfm
+279
View File
@@ -0,0 +1,279 @@
object frmPostProcess: TfrmPostProcess
Left = 421
Top = 359
Caption = 'Post Render'
ClientHeight = 537
ClientWidth = 693
Color = clBtnFace
Constraints.MinHeight = 200
Constraints.MinWidth = 700
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
DesignSize = (
693
537)
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 693
Height = 81
Align = alTop
BevelOuter = bvNone
TabOrder = 0
DesignSize = (
693
81)
object pnlFilter: TPanel
Left = 8
Top = 32
Width = 110
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Filter Radius'
TabOrder = 11
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlVibrancy: TPanel
Left = 337
Top = 32
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Vibrancy'
TabOrder = 10
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlBrightness: TPanel
Left = 180
Top = 32
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Brightness'
TabOrder = 8
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlContrast: TPanel
Left = 337
Top = 8
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Contrast'
TabOrder = 9
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlGamma: TPanel
Left = 180
Top = 8
Width = 95
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Gamma'
TabOrder = 7
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object ProgressBar1: TProgressBar
Left = 8
Top = 61
Width = 682
Height = 20
Anchors = [akLeft, akRight, akBottom]
TabOrder = 15
end
object txtFilterRadius: TEdit
Left = 117
Top = 32
Width = 57
Height = 21
TabOrder = 2
OnKeyPress = EditKeyPress
end
object txtGamma: TEdit
Left = 274
Top = 8
Width = 57
Height = 21
TabOrder = 3
OnKeyPress = EditKeyPress
end
object txtVibrancy: TEdit
Left = 431
Top = 32
Width = 57
Height = 21
TabOrder = 6
OnKeyPress = EditKeyPress
end
object txtContrast: TEdit
Left = 431
Top = 8
Width = 57
Height = 21
TabOrder = 5
OnKeyPress = EditKeyPress
end
object txtBrightness: TEdit
Left = 274
Top = 32
Width = 57
Height = 21
TabOrder = 4
OnKeyPress = EditKeyPress
end
object pnlBackground: TPanel
Left = 495
Top = 8
Width = 100
Height = 21
Cursor = crArrow
BevelOuter = bvLowered
Caption = 'Background'
TabOrder = 12
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object pnlBackColor: TPanel
Left = 600
Top = 8
Width = 57
Height = 21
Cursor = crHandPoint
BevelInner = bvRaised
BevelOuter = bvLowered
BorderStyle = bsSingle
TabOrder = 0
OnClick = pnlBackColorClick
object shBack: TShape
Left = 2
Top = 2
Width = 49
Height = 13
Align = alClient
Brush.Color = clBlack
Pen.Color = clWindow
Pen.Style = psClear
Pen.Width = 0
OnMouseUp = shBackMouseUp
ExplicitLeft = 0
end
end
object btnApply: TButton
Left = 535
Top = 32
Width = 97
Height = 25
Anchors = [akTop, akRight]
Caption = '&Apply'
Default = True
TabOrder = 13
OnClick = btnApplyClick
end
object pnlRelGamma: TPanel
Left = 8
Top = 8
Width = 110
Height = 21
Cursor = crHandPoint
BevelOuter = bvLowered
Caption = 'Gamma Threshold'
TabOrder = 14
OnDblClick = DragPanelDblClick
OnMouseDown = DragPanelMouseDown
OnMouseMove = DragPanelMouseMove
OnMouseUp = DragPanelMouseUp
end
object txtRelGamma: TEdit
Left = 117
Top = 8
Width = 57
Height = 21
TabOrder = 1
OnKeyPress = EditKeyPress
end
end
object ScrollBox1: TScrollBox
Left = 8
Top = 88
Width = 689
Height = 417
Align = alCustom
Anchors = [akLeft, akTop, akRight, akBottom]
BevelInner = bvNone
BevelKind = bkSoft
BorderStyle = bsNone
Color = clAppWorkSpace
ParentColor = False
TabOrder = 1
object Image: TImage
Left = 0
Top = 0
Width = 687
Height = 415
Align = alClient
AutoSize = True
Center = True
Proportional = True
Stretch = True
end
end
object btnSave: TButton
Left = 588
Top = 510
Width = 97
Height = 25
Anchors = [akRight, akBottom]
Caption = '&Save'
TabOrder = 2
OnClick = btnSaveClick
end
object chkFitToWindow: TCheckBox
Left = 8
Top = 512
Width = 490
Height = 17
Anchors = [akLeft, akRight, akBottom]
Caption = 'Fit to window'
Checked = True
State = cbChecked
TabOrder = 3
Visible = False
OnClick = chkFitToWindowClick
end
object ColorDialog: TColorDialog
Left = 612
Top = 76
end
end
Forms/formPostProcess.pas
+568
View File
@@ -0,0 +1,568 @@
{
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 formPostProcess;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, RenderingInterface, controlpoint, StdCtrls, ComCtrls,
Translation;
type
TfrmPostProcess = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
Image: TImage;
pnlBackColor: TPanel;
ColorDialog: TColorDialog;
ProgressBar1: TProgressBar;
txtFilterRadius: TEdit;
txtGamma: TEdit;
txtVibrancy: TEdit;
txtContrast: TEdit;
txtBrightness: TEdit;
pnlGamma: TPanel;
pnlBrightness: TPanel;
pnlContrast: TPanel;
pnlVibrancy: TPanel;
pnlFilter: TPanel;
shBack: TShape;
pnlBackground: TPanel;
btnSave: TButton;
chkFitToWindow: TCheckBox;
btnApply: TButton;
pnlRelGamma: TPanel;
txtRelGamma: TEdit;
procedure chkFitToWindowClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnApplyClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure pnlBackColorClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure DragPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DragPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DragPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DragPanelDblClick(Sender: TObject);
procedure shBackMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EditKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
FRenderer: TBaseRenderer;
FCP: TControlPoint;
FImagename: string;
pnlDragMode, pnlDragged, pnlMM: boolean;
pnlDragPos, pnlDragOld: integer;
pnlDragValue: double;
mousepos: TPoint;
BkgColor: TColor;
Filter,
Gamma, Brightness, RelGamma,
Contrast, Vibrancy: double;
ImCount: shortint; // AV: the number of saved images
NewName: string; // AV
procedure UpdateFlame;
procedure SetDefaultValues;
procedure OnProgress(prog: double);
public
cp : TControlPoint;
procedure SetRenderer(Renderer: TBaseRenderer);
procedure SetControlPoint(CP: TControlPoint);
procedure SetImageName(imagename: string);
end;
var
frmPostProcess: TfrmPostProcess;
implementation
uses
Registry, Global, Main;
{$R *.dfm}
{ TfrmPostProcess }
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.SetRenderer(Renderer: TBaseRenderer);
begin
if assigned(FRenderer) then
FRenderer.Free;
FRenderer := Renderer;
Frenderer.OnProgress := OnProgress;
Image.Picture.Graphic := FRenderer.GetImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.FormShow(Sender: TObject);
var
Registry: TRegistry;
begin
{ Read posution from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\PostProcess', False) then begin
if Registry.ValueExists('Left') then
Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
Top := Registry.ReadInteger('Top');
//if Registry.ValueExists('Width') then
//Width := Registry.ReadInteger('Width');
//if Registry.ValueExists('Height') then
// Height := Registry.ReadInteger('Height');
end;
Registry.CloseKey;
finally
Registry.Free;
end;
ImCount := -1; // AV: reset the counter
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.FormClose(Sender: TObject; var Action: TCloseAction);
var
Registry: TRegistry;
begin
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\PostProcess', True) then
begin
Registry.WriteInteger('Top', Top);
Registry.WriteInteger('Left', Left);
// Registry.WriteInteger('Width', Width);
// Registry.WriteInteger('Height', Height);
end;
finally
Registry.Free;
end;
FRenderer.Free; // weirdness!!! :-/
FRenderer := nil;
Image.Picture.Graphic := nil;
FCP.Free;
FCP := nil;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.SetDefaultValues;
begin
BkgColor := RGB(Fcp.background[0], Fcp.background[1], Fcp.background[2]);
pnlBackColor.Color := BkgColor;
shBack.Brush.Color := BkgColor;
Filter := FCP.spatial_filter_radius;
txtFilterRadius.Text := FloatTostr(Filter);
Gamma := FCP.gamma;
txtGamma.Text := FloatTostr(Gamma);
RelGamma := FCP.gammaThreshRelative; // AV
txtRelGamma.Text := FloatTostr(RelGamma); // AV
Vibrancy := FCP.vibrancy;
txtVibrancy.Text := FloatTostr(Vibrancy);
Contrast := FCP.contrast;
txtContrast.Text := FloatTostr(Contrast);
Brightness := FCP.brightness;
txtBrightness.Text := FloatTostr(brightness);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.SetControlPoint(CP: TControlPoint);
begin
if assigned(FCP) then
FCP.Free;
FCP := cp.Clone;
SetDefaultValues;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.pnlBackColorClick(Sender: TObject);
var
col: Longint;
begin
ColorDialog.Color := shBack.Brush.Color;
if ColorDialog.Execute then begin
pnlBackColor.Color := ColorDialog.Color;
shBack.Brush.Color := ColorDialog.Color;
col := ColorToRGB(ColorDialog.Color);
Fcp.background[0] := col and 255;
Fcp.background[1] := (col shr 8) and 255;
Fcp.background[2] := (col shr 16) and 255;
UpdateFlame;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.UpdateFlame;
begin
Screen.Cursor := crHourGlass;
FRenderer.UpdateImage(FCP);
Image.Picture.Graphic := FRenderer.GetImage;
Screen.Cursor := crDefault;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.FormDestroy(Sender: TObject);
begin
if assigned(FRenderer) then
FRenderer.Free;
if assigned(FCP) then
FCP.Free;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.OnProgress(prog: double);
begin
ProgressBar1.Position := round(100 * prog);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.btnApplyClick(Sender: TObject);
var
temp, tempg: double;
begin
TryStrToFloat(txtFilterRadius.Text, FCP.spatial_filter_radius);
if FCP.spatial_filter_radius > 2 then begin
FCP.spatial_filter_radius := 2;
txtFilterRadius.Text := '2';
end else if FCP.spatial_filter_radius < 0 then begin
FCP.spatial_filter_radius := 0.01;
txtFilterRadius.Text := FloatTostr(0.01);
end;
TryStrToFloat(txtGamma.Text, FCP.gamma);
if FCP.gamma > 10 then begin
FCP.gamma := 10;
txtGamma.Text := '10';
end else if FCP.gamma < 0.01 then begin
FCP.gamma := 0.01;
txtGamma.Text := FloatTostr(0.01);
end;
// AV
if TryStrToFloat(txtRelGamma.Text, tempg) then FCP.gammathreshrelative := tempg;
if FCP.gammathreshrelative < 0 then begin
FCP.gammathreshrelative := 0;
txtRelGamma.Text := '0';
end;
TryStrToFloat(txtVibrancy.Text, FCP.vibrancy);
if FCP.vibrancy > 30 then begin // AV: maximum was 10,
FCP.vibrancy := 30; // but Apo allows to use higher values
txtVibrancy.Text := '30'; // AV
end else if FCP.vibrancy < 0.01 then begin
FCP.vibrancy := 0.01;
txtVibrancy.Text := FloatTostr(0.01);
end;
TryStrToFloat(txtContrast.Text, FCP.contrast);
if FCP.contrast > 10 then begin
FCP.contrast := 10;
txtContrast.Text := '10';
end else if FCP.contrast < 0.01 then begin
FCP.contrast := 0.01;
txtContrast.Text := FloatTostr(0.01);
end;
if TryStrToFloat(txtBrightness.Text, temp) then FCP.brightness := temp;
//TryStrToFloat(txtBrightness.Text, FCP.brightness);
if FCP.brightness > 100 then begin
FCP.brightness := 100;
txtBrightness.Text := '100';
end else if FCP.brightness < 0.01 then begin
FCP.brightness := 0.01;
txtBrightness.Text := FloatTostr(0.01);
end;
UpdateFlame;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.btnSaveClick(Sender: TObject);
begin
inc(ImCount);
if ImCount = 0 then
FRenderer.SaveImage(FImagename)
else begin // AV: enumerating different versions of the image
NewName := FImagename;
Insert(' (' + IntToStr(ImCount) + ')', NewName, length(NewName) - 3);
FRenderer.SaveImage(NewName);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.SetImageName(imagename: string);
begin
FImagename := imagename;
end;
// -----------------------------------------------------------------------------
procedure TfrmPostProcess.DragPanelMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
if (Sender = pnlFilter) then
pnlDragValue := fcp.spatial_filter_radius * 10
else if (Sender = pnlGamma) then
pnlDragValue := fcp.gamma
else if (Sender = pnlRelGamma) then // AV
pnlDragValue := fcp.gammaThreshRelative * 10
else if (Sender = pnlBrightness) then
pnlDragValue := fcp.brightness
else if (Sender = pnlContrast) then
pnlDragValue := fcp.contrast
else if (Sender = pnlVibrancy) then
pnlDragValue := fcp.vibrancy
else exit;//assert(false);
pnlDragMode := true;
pnlDragPos := 0;
pnlDragOld := x;
pnlMM := false;
SetCaptureControl(TControl(Sender));
Screen.Cursor := crHSplit;
GetCursorPos(mousepos); // hmmm
pnlDragged := false;
end;
procedure TfrmPostProcess.DragPanelMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
v: double;
pEdit: ^TEdit;
enableDrag : boolean;
begin
if pnlMM then // hack: to skip MouseMove event
begin
pnlMM:=false;
end
else
if pnlDragMode and (x <> pnlDragOld) then
begin
Inc(pnlDragPos, x - pnlDragOld);
if GetKeyState(VK_MENU) < 0 then v := 100000
else if GetKeyState(VK_CONTROL) < 0 then v := 10000
else if GetKeyState(VK_SHIFT) < 0 then v := 100
else v := 1000;
v := Round6(pnlDragValue + pnlDragPos / v);
SetCursorPos(MousePos.x, MousePos.y); // hmmm
pnlMM:=true;
enableDrag := true;
if (Sender = pnlFilter) then
begin
v := v / 10;
if v > 2 then v := 2
else if v < 0.01 then v := 0.01;
fcp.spatial_filter_radius := v;
pEdit := @txtFilterRadius;
end
else if (Sender = pnlGamma) then
begin
if v > 10 then v := 10
else if v < 0.01 then v := 0.01;
fcp.gamma := v;
pEdit := @txtGamma;
end
else if (Sender = pnlRelGamma) then
begin
v := v * 0.1;
if v < 0 then v := 0;
fcp.gammaThreshRelative := v;
pEdit := @txtRelGamma;
end
else if (Sender = pnlBrightness) then
begin
if v > 100 then v := 100
else if v < 0.01 then v := 0.01;
fcp.brightness := v;
pEdit := @txtBrightness;
end
else if (Sender = pnlContrast) then
begin
if v > 10 then v := 10
else if v < 0.01 then v := 0.01;
fcp.contrast := v;
pEdit := @txtContrast;
end
else if (Sender = pnlVibrancy) then
begin
if v > 30 then v := 30 // AV: was 10, but higher values are allowed
else if v < 0.01 then v := 0.01;
fcp.vibrancy := v;
pEdit := @txtVibrancy;
end else exit;
if enableDrag then begin
pEdit^.Text := FloatToStr(v);
//pEdit.Refresh;
pnlDragged := True;
// TODO: image preview (?)
//DrawPreview;
end;
end;
end;
procedure TfrmPostProcess.DragPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
if pnlDragMode then
begin
SetCaptureControl(nil);
pnlDragMode := false;
Screen.Cursor := crDefault;
if pnlDragged then
begin
//UpdateFlame;
pnlDragged := False;
end;
end;
end;
procedure TfrmPostProcess.EditKeyPress(Sender: TObject; var Key: Char);
begin // AV
if (Key = ',') then Key := '.'; //FormatSettings.DecimalSeparator;
if not CharinSet(Key,['0'..'9', #8, #13, '.'])
then Key:= #0;
end;
procedure TfrmPostProcess.DragPanelDblClick(Sender: TObject);
var
pValue: ^double;
pDefaultValue: ^double;
pEdit: ^TEdit;
begin
if (Sender = pnlFilter) then
begin
pValue := @fcp.spatial_filter_radius;
pDefaultValue := @Filter;
pEdit := @txtFilterRadius;
end
else if (Sender = pnlGamma) then
begin
pValue := @fcp.gamma;
pDefaultValue := @Gamma;
pEdit := @txtGamma;
end
else if (Sender = pnlRelGamma) then
begin
// AV: because it's a property, not a field
if fcp.gammaThreshRelative = RelGamma then exit;
fcp.gammaThreshRelative := RelGamma;
txtRelGamma.Text := FloatToStr(fcp.gammaThreshRelative);
exit;
end
else if (Sender = pnlBrightness) then
begin
if fcp.brightness = Brightness then exit;
fcp.brightness := Brightness;
txtBrightness.Text := FloatToStr(fcp.brightness);
exit;
end
else if (Sender = pnlContrast) then
begin
pValue := @fcp.contrast;
pDefaultValue := @Contrast;
pEdit := @txtContrast
end
else if (Sender = pnlVibrancy) then
begin
pValue := @fcp.vibrancy;
pDefaultValue := @Vibrancy;
pEdit := @txtVibrancy;
end
else exit; //assert(false);
if pValue^ = pDefaultValue^ then exit;
pValue^ := pDefaultValue^;
pEdit^.Text := FloatToStr(pValue^);
//UpdateFlame;
end;
procedure TfrmPostProcess.shBackMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
pnlBackColorClick(sender);
end;
procedure TfrmPostProcess.FormCreate(Sender: TObject);
begin
btnApply.Caption := TextByKey('common-apply');
pnlFilter.Caption := TextByKey('common-filterradius');
pnlGamma.Caption := TextByKey('common-gamma');
pnlRelGamma.Caption := TextByKey('common-gammathreshold');
pnlBrightness.Caption := TextByKey('common-brightness');
pnlContrast.Caption := TextByKey('common-contrast');
pnlVibrancy.Caption := TextByKey('common-vibrancy');
pnlBackground.Caption := TextByKey('common-background');
pnlFilter.Hint := TextByKey('common-dragpanelhint');
pnlGamma.Hint := TextByKey('common-dragpanelhint');
pnlBrightness.Hint := TextByKey('common-dragpanelhint');
pnlVibrancy.Hint := TextByKey('common-dragpanelhint');
pnlContrast.Hint := TextByKey('common-dragpanelhint');
pnlRelGamma.Hint := TextByKey('common-dragpanelhint');
self.Caption := TextByKey('postprocess-title');
btnSave.Caption := TextByKey('postprocess-save');
chkFitToWindow.Caption := TextByKey('postprocess-fittowindow');
end;
procedure TfrmPostProcess.chkFitToWindowClick(Sender: TObject);
begin
{if (chkFitToWindow.Checked) then begin
Image.Stretch := true;
Image.Align := alClient;
end else begin
Image.Stretch := false;
Image.Align := alNone;
end; }
end;
end.
HARLOWSI.TTF
BIN
View File
Binary file not shown.
Licence.txt
+674
View File
@@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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 3 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, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<https://www.gnu.org/licenses/why-not-lgpl.html>.
Rendering/BucketFillerThread.pas
+109
View File
@@ -0,0 +1,109 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit BucketFillerThread;
interface
uses
Classes, Windows, ControlPoint, RenderingInterface, XForm;
type
TBucketFillerThread = class(TThread)
private
fcp: TControlPoint;
points: TPointsArray;
public
nrbatches: integer;
batchcounter: Pinteger;
ColorMap: TColorMapArray;
CriticalSection: TRTLCriticalSection;
AddPointsProc: procedure (const points: TPointsArray) of object;
constructor Create(cp: TControlPoint);
destructor Destroy; override;
procedure Execute; override;
end;
implementation
//uses SysUtils, FormRender;
///////////////////////////////////////////////////////////////////////////////
constructor TBucketFillerThread.Create(cp: TControlPoint);
begin
inherited Create(True);
//Self.FreeOnTerminate := True;
Fcp := cp.Clone;
SetLength(Points, SUB_BATCH_SIZE);
fcp.Prepare;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TBucketFillerThread.Destroy;
begin
FCP.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBucketFillerThread.Execute;
var
bc: integer;
begin
inherited;
//RenderForm.Output.Lines.Add(' . . . > Filler thread #' + IntToStr(ThreadID) + ' Started');
bc := 0;
while (not Terminated) and (bc < Nrbatches) do begin
fcp.iterateXYC(SUB_BATCH_SIZE, points);
try
EnterCriticalSection(CriticalSection);
AddPointsProc(Points);
Inc(batchcounter^);
bc := batchcounter^
finally
LeaveCriticalSection(CriticalSection);
end;
end;
//RenderForm.Output.Lines.Add(' . . . > Filler thread #' + IntToStr(ThreadID) + ' Finished');
end;
///////////////////////////////////////////////////////////////////////////////
{ -- RENDER THREAD MUST *NOT* KNOW ANYTHING ABOUT BUCKETS!!! -- }
end.
Rendering/ImageMaker.pas
+860
View File
@@ -0,0 +1,860 @@
{
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 ImageMaker;
interface
uses
Windows, Graphics, ControlPoint, RenderingCommon, PngImage, Bezier;
type TPalette = record
logpal : TLogPalette;
colors: array[0..255] of TPaletteEntry;
end;
type
TImageMaker = class
private
FOversample: Integer;
FFilterSize: Integer;
FFilter: array of array of double;
FParameters : String;
FBitmap: TBitmap;
FAlphaBitmap: TBitmap;
AlphaPalette: TPalette;
FTransparentImage: TBitmap;
comp_max_radius, comp_min_radius : double;
num_de_filters_d, num_de_filters : double;
de_max_ind, de_count_limit : double;
de_cutoff_val : double;
de_row_size, de_half_size, de_kernel_index : double;
de_filter_coefs, de_filter_widths : array of double;
FCP: TControlPoint;
FBucketHeight: integer;
FBucketWidth: integer;
FBuckets: TBucketArray;
FOnProgress: TOnProgress;
FGetBucket: function(x, y: integer): TBucket of object;
FCommentStr: string; // AV: for xml-params embedding
function GetBucket(x, y: integer): TBucket;
function SafeGetBucket(x, y: integer): TBucket;
procedure CreateFilter;
procedure InitDE;
procedure NormalizeFilter;
public
constructor Create;
destructor Destroy; override;
function GetImage: TBitmap;
procedure GetImageAndDelete(target:tBitmap);
function GetTransparentImage: TPNGObject;
procedure SetCP(CP: TControlPoint);
procedure Init;
procedure SetBucketData(const Buckets: pointer; BucketWidth, BucketHeight: integer; bits: integer);
function GetFilterSize: Integer;
procedure CreateImage(YOffset: integer = 0);
procedure SaveImage(FileName: String);
procedure GetBucketStats(var Stats: TBucketStats);
function EmbedText(CommentStr: String): boolean; //AV
property OnProgress: TOnProgress
// read FOnProgress
write FOnProgress;
end;
implementation
uses
Math, SysUtils, JPEG, Global, Types;
{ TImageMaker }
type
TRGB = packed Record
blue: byte;
green: byte;
red: byte;
end;
PByteArray = ^TByteArray;
TByteArray = array[0..0] of byte;
// PLongintArray = ^TLongintArray;
// TLongintArray = array[0..0] of Longint;
PRGBArray = ^TRGBArray;
TRGBArray = array[0..0] of TRGB;
///////////////////////////////////////////////////////////////////////////////
constructor TImageMaker.Create;
var
i: integer;
begin
AlphaPalette.logpal.palVersion := $300;
AlphaPalette.logpal.palNumEntries := 256;
for i := 0 to 255 do
with AlphaPalette.logpal.palPalEntry[i] do begin
peRed := i;
peGreen := i;
peBlue := i;
end;
FCommentStr := ''; // AV
end;
///////////////////////////////////////////////////////////////////////////////
destructor TImageMaker.Destroy;
begin
if assigned(FBitmap) then
FBitmap.Free;
if assigned(FAlphaBitmap) then
FAlphaBitmap.Free;
if assigned(FTransparentImage) then
FTransparentImage.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.CreateFilter;
var
i, j: integer;
fw: integer;
adjust: double;
ii, jj: double;
begin
FOversample := fcp.spatial_oversample;
fw := Trunc(2.0 * FILTER_CUTOFF * FOversample * fcp.spatial_filter_radius);
FFilterSize := fw + 1;
// make sure it has same parity as oversample
if odd(FFilterSize + FOversample) then
inc(FFilterSize);
if (fw > 0.0) then
adjust := (1.0 * FILTER_CUTOFF * FFilterSize) / fw
else
adjust := 1.0;
setLength(FFilter, FFilterSize, FFilterSize);
if fcp.enable_de and false then InitDE;
for i := 0 to FFilterSize - 1 do begin
for j := 0 to FFilterSize - 1 do begin
ii := ((2.0 * i + 1.0)/ FFilterSize - 1.0) * adjust;
jj := ((2.0 * j + 1.0)/ FFilterSize - 1.0) * adjust;
FFilter[i, j] := exp(-2.0 * (ii * ii + jj * jj));
end;
end;
Normalizefilter;
end;
procedure TImageMaker.InitDE;
var
e, em, ec : double;
filtloop : integer;
de_filt_sum, de_filt_d, de_filt_h : double;
adjloop, sfx : double;
dej,dek, filter_coef_idx : integer;
sl : integer;
begin
de_filt_sum := 0;
if (fcp.estimator < 0.0) then
e := 0
else
e := fcp.estimator;
if (fcp.estimator_min < 0.0) then
em := 0
else
em := fcp.estimator_min;
if (fcp.estimator_curve < 0.0) then
ec := 0
else
ec := fcp.estimator_curve;
if (e <= 0) then exit;
comp_max_radius := e*Foversample + 1;
comp_min_radius := em*Foversample + 1;
num_de_filters_d := power(comp_max_radius/comp_min_radius, (1.0/ec));
num_de_filters := ceil(num_de_filters_d);
if (num_de_filters>100) then begin
de_max_ind := ceil(100 + power(num_de_filters - 100, ec)) + 1;
de_count_limit := power(de_max_ind - 100, 1.0/ec) + 100;
end else begin
de_max_ind := num_de_filters;
de_count_limit := de_max_ind;
end;
de_row_size := 2*ceil(comp_max_radius)-1;
de_half_size := (de_row_size-1)/2;
de_kernel_index := (de_half_size+1)*(2+de_half_size)/2;
sl := Trunc(de_max_ind * de_kernel_index);
//assert(sl >= 0);
if (sl < 0) then sl := 0;
setLength(de_filter_coefs, sl);
sl := Trunc(de_max_ind);
//assert(sl >= 0);
if (sl < 0) then sl := 0;
setLength(de_filter_widths, sl);
de_cutoff_val := 0;
for filtloop := 0 to trunc(de_max_ind)-1 do begin
if (filtloop < 100) then
de_filt_h := (comp_max_radius / power(filtloop+1, ec))
else begin
adjloop := power(filtloop - 100, (1/ec))+100;
de_filt_h := (comp_max_radius / power(adjloop+1, ec))
end;
if (de_filt_h <= comp_min_radius) then begin
de_filt_h := comp_min_radius;
de_cutoff_val := filtloop;
end;
de_filter_widths[filtloop] := de_filt_h;
for dej := -trunc(de_half_size) to trunc(de_half_size) do
for dek := -trunc(de_half_size) to trunc(de_half_size) do begin
de_filt_d := sqrt(dej * dej + dek * dek) / de_filt_h;
if (de_filt_d <= 1.0) then begin
sfx := 1.8 * de_filt_d;
de_filt_sum := de_filt_sum + (exp(-2.0*sfx*sfx)*0.7978845608);
end; // -X- ^^^ sqrt(2/PI)
end;
filter_coef_idx := filtloop * trunc(de_kernel_index);
for dej := 0 to trunc(de_half_size) do
for dek := 0 to dej-1 do begin
de_filt_d := sqrt(dej * dej + dek * dek) / de_filt_h;
if (de_filt_d>1.0) then begin
// -X- TODO fix...
if (filter_coef_idx >= 0) and (filter_coef_idx < Trunc(de_max_ind * de_kernel_index)) then
de_filter_coefs[filter_coef_idx] := 0
end else begin
sfx := 1.8 * de_filt_d;
if (filter_coef_idx >= 0) and (filter_coef_idx < Trunc(de_max_ind * de_kernel_index)) then
de_filter_coefs[filter_coef_idx] := (exp(-2.0*sfx*sfx)*0.7978845608) / de_filt_sum;
end;
Inc(filter_coef_idx);
end;
if (de_cutoff_val > 0) then break;
end;
if (de_cutoff_val=0) then
de_cutoff_val := num_de_filters-1;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.NormalizeFilter;
var
i, j: integer;
t: double;
begin
t := 0;
for i := 0 to FFilterSize - 1 do
for j := 0 to FFilterSize - 1 do
t := t + FFilter[i, j];
for i := 0 to FFilterSize - 1 do
for j := 0 to FFilterSize - 1 do
FFilter[i, j] := FFilter[i, j] / t;
end;
///////////////////////////////////////////////////////////////////////////////
function TImageMaker.GetFilterSize: Integer;
begin
Result := FFiltersize;
end;
///////////////////////////////////////////////////////////////////////////////
function TImageMaker.GetImage: TBitmap;
begin
// if ShowTransparency then
// Result := GetTransparentImage
// else
Result := FBitmap;
end;
procedure TImageMaker.GetImageAndDelete(target:tBitmap);
begin
assert(false);
//target.Assign(FBitmap);
//FBitmap.Free;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.Init;
begin
if not Assigned(FBitmap) then
FBitmap := TBitmap.Create;
FBitmap.PixelFormat := pf24bit;
FBitmap.Width := Fcp.Width;
FBitmap.Height := Fcp.Height;
if not Assigned(FAlphaBitmap) then
FAlphaBitmap := TBitmap.Create;
FAlphaBitmap.PixelFormat := pf8bit;
FAlphaBitmap.Width := Fcp.Width;
FAlphaBitmap.Height := Fcp.Height;
CreateFilter;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SetBucketData(const Buckets: pointer; BucketWidth, BucketHeight: integer; bits: integer);
begin
FBuckets := TBucketArray(Buckets);
FBucketWidth := BucketWidth;
FBucketHeight := BucketHeight;
FGetBucket := GetBucket;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SetCP(CP: TControlPoint);
begin
Fcp := CP;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.CreateImage(YOffset: integer);
var
gamma: double;
i, j: integer;
alpha: double;
ri, gi, bi: Integer;
ai, ia: integer;
bgtot, zero_BG: TRGB;
ls: double;
ii, jj: integer;
fp: array[0..3] of double;
Row: PRGBArray;
AlphaRow: PbyteArray;
vib, notvib: Integer;
bgi: array[0..2] of Integer;
// bucketpos: Integer;
filterValue: double;
// filterpos: Integer;
lsa: array[0..1024] of double;
csa: array[0..3] of array[0..256] of double;
sample_density: extended;
gutter_width: integer;
k1, k2: double;
area: double;
frac, funcval: double;
f_select : double;
f_select_int, f_coef_idx : integer;
arr_filt_width : integer;
c : array of double;
ss : integer;
scf:boolean;
scfact : double;
acc : integer;
avg, fac: double;
curvesSet: boolean;
GetBucket: function(x, y: integer): TBucket of object;
bucket: TBucket;
bx, by: integer;
label zero_alpha;
begin
SetLength(c, 4);
if fcp.gamma = 0 then
gamma := fcp.gamma
else
gamma := 1 / fcp.gamma;
vib := round(fcp.vibrancy * 256.0);
notvib := 256 - vib;
if fcp.gamma_threshold <> 0 then
funcval := power(fcp.gamma_threshold, gamma - 1) { / fcp.gamma_threshold; }
else funcval := 0;
bgi[0] := round(fcp.background[0]);
bgi[1] := round(fcp.background[1]);
bgi[2] := round(fcp.background[2]);
bgtot.red := bgi[0];
bgtot.green := bgi[1];
bgtot.blue := bgi[2];
zero_BG.red := 0;
zero_BG.green := 0;
zero_BG.blue := 0;
curvesSet := true;
for i := 0 to 3 do
curvesSet := curvesSet and (
((fcp.curvePoints[i][0].x = 0) and (fcp.curvePoints[i][0].y = 0)) and
((fcp.curvePoints[i][1].x = 0) and (fcp.curvePoints[i][1].y = 0)) and
((fcp.curvePoints[i][2].x = 1) and (fcp.curvePoints[i][2].y = 1)) and
((fcp.curvePoints[i][3].x = 1) and (fcp.curvePoints[i][3].y = 1))
);
curvesSet := not curvesSet;
gutter_width := FBucketwidth - FOversample * fcp.Width;
// gutter_width := 2 * ((25 - Foversample) div 2);
if(FFilterSize <= gutter_width div 2) then // filter too big when 'post-processing' ?
GetBucket := FGetBucket
else
GetBucket := SafeGetBucket;
FBitmap.PixelFormat := pf24bit;
sample_density := fcp.actual_density * sqr( power(2, fcp.zoom) );
if sample_density = 0 then sample_density := 0.001;
k1 := (fcp.Contrast * BRIGHT_ADJUST * fcp.brightness * 268 * PREFILTER_WHITE) / 256.0;
area := FBitmap.Width * FBitmap.Height / (fcp.ppux * fcp.ppuy);
k2 := (FOversample * FOversample) / (fcp.Contrast * area * fcp.White_level * sample_density);
csa[0][0] := 0; csa[1][0] := 0; csa[2][0] := 0; csa[3][0] := 0;
for i := 0 to 1024 do begin
if i = 0 then lsa[0] := 0
else lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i);
if i <= 256 then begin
csa[0][i] := BezierFunc(i / 256.0, fcp.curvePoints[0], fcp.curveWeights[0]) * 256;
csa[1][i] := BezierFunc(i / 256.0, fcp.curvePoints[1], fcp.curveWeights[1]) * 256;
csa[2][i] := BezierFunc(i / 256.0, fcp.curvePoints[2], fcp.curveWeights[2]) * 256;
csa[3][i] := BezierFunc(i / 256.0, fcp.curvePoints[3], fcp.curveWeights[3]) * 256;
end;
end;
ls := 0;
ai := 0;
ss := Trunc(floor(FOversample / 2));
scf := (trunc(FOversample) mod 2 = 0);
scfact := power(FOversample/(FOversample+1), 2);
//bucketpos := 0;
by := 0;
for i := 0 to fcp.Height - 1 do begin
bx := 0;
if (i and $3f = 0) and assigned(FOnProgress) then FOnProgress(i / fcp.Height);
AlphaRow := PByteArray(FAlphaBitmap.scanline[YOffset + i]);
Row := PRGBArray(FBitmap.scanline[YOffset + i]);
for j := 0 to fcp.Width - 1 do begin
if FFilterSize > 1 then begin
fp[0] := 0;
fp[1] := 0;
fp[2] := 0;
fp[3] := 0;
for ii := 0 to FFilterSize - 1 do begin
for jj := 0 to FFilterSize - 1 do begin
filterValue := FFilter[ii, jj];
bucket := GetBucket(bx + jj, by + ii);
if bucket.count < 1024 then
ls := lsa[Round(bucket.Count)]
else
ls := (k1 * log10(1 + fcp.White_level * bucket.count * k2)) / (fcp.White_level * bucket.count);
fp[0] := fp[0] + filterValue * ls * bucket.Red;
fp[1] := fp[1] + filterValue * ls * bucket.Green;
fp[2] := fp[2] + filterValue * ls * bucket.Blue;
fp[3] := fp[3] + filterValue * ls * bucket.Count;
end;
end;
fp[0] := fp[0] / PREFILTER_WHITE;
fp[1] := fp[1] / PREFILTER_WHITE;
fp[2] := fp[2] / PREFILTER_WHITE;
fp[3] := fcp.white_level * fp[3] / PREFILTER_WHITE;
end else begin
bucket := GetBucket(bx, by);
if bucket.count < 1024 then
ls := lsa[Round(bucket.count)] / PREFILTER_WHITE
else
ls := (k1 * log10(1 + fcp.White_level * bucket.count * k2)) / (fcp.White_level * bucket.count) / PREFILTER_WHITE;
fp[0] := ls * bucket.Red;
fp[1] := ls * bucket.Green;
fp[2] := ls * bucket.Blue;
fp[3] := ls * bucket.Count * fcp.white_level;
end;
if (num_de_filters > 0) and (fp[3] > 0) then begin
f_select := 0;
for ii := -ss to trunc(ss) + 1 do
for jj := -ss to trunc(ss) + 1 do begin
bucket := SafeGetBucket(bx + jj, by + ii);
f_select := f_select + (bucket.Count / 255.0);
end;
if (scf) then f_select := f_select * scfact;
if (f_select > de_count_limit) then
f_select_int := trunc(de_cutoff_val)
else if (f_select <= 100) then
f_select_int := trunc(ceil(f_select)) - 1
else
f_select_int := 100 + trunc(floor(power(f_select - 100, fcp.estimator_curve)));
if (f_select_int >= de_cutoff_val) then
f_select_int := trunc(de_cutoff_val);
f_coef_idx := trunc(f_select_int*de_kernel_index);
if (f_select_int >= 0) and (f_select_int < length(de_filter_widths)) then
arr_filt_width := trunc(floor(de_filter_widths[length(de_filter_widths) - 1 - f_select_int]))
else
arr_filt_width := 1;
fp[0] := 0;
fp[1] := 0;
fp[2] := 0;
fp[3] := 0;
acc := 1;
for jj := 0 to arr_filt_width do
for ii := 0 to arr_filt_width do begin
bucket := SafeGetBucket(bx+ii, by+jj);
if (f_coef_idx < 0) or (f_coef_idx >= length(de_filter_coefs)) then continue;
if (de_filter_coefs[f_coef_idx]= 0) then begin
Inc(f_coef_idx);
continue;
end;
if bucket.count < 1024 then
ls := lsa[Round(bucket.Count)]
else if bucket.count = 0 then
ls := 0
else
ls := (k1 * log10(1 + fcp.White_level * bucket.count * k2)) / (fcp.White_level * bucket.count);
fp[0] := fp[0] + bucket.Red * ls * de_filter_coefs[f_coef_idx];
fp[1] := fp[1] + bucket.Green * ls * de_filter_coefs[f_coef_idx];
fp[2] := fp[2] + bucket.Blue * ls * de_filter_coefs[f_coef_idx];
fp[3] := fp[3] + bucket.Count * ls * de_filter_coefs[f_coef_idx];
Inc(acc);
Inc(f_coef_idx);
end;
fp[0] := fp[0] * acc / PREFILTER_WHITE;
fp[1] := fp[1] * acc / PREFILTER_WHITE;
fp[2] := fp[2] * acc / PREFILTER_WHITE;
fp[3] := fcp.white_level * acc * fp[3] / PREFILTER_WHITE;
end;
Inc(bx, FOversample);
if fcp.Transparency then begin // -------------------------- Transparency
// gamma linearization
if (fp[3] > 0.0) then begin
if fp[3] <= fcp.gamma_threshold then begin
frac := fp[3] / fcp.gamma_threshold;
alpha := (1 - frac) * fp[3] * funcval + frac * power(fp[3], gamma);
end
else
alpha := power(fp[3], gamma);
ls := vib * alpha / fp[3];
ai := round(alpha * 256);
if (ai <= 0) then goto zero_alpha // ignore all if alpha = 0
else if (ai > 255) then ai := 255;
//ia := 255 - ai;
end
else begin
zero_alpha:
Row[j] := zero_BG;
AlphaRow[j] := 0;
continue;
end;
if (notvib > 0) then begin
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma));
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma));
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma));
end
else begin
ri := Round(ls * fp[0]);
gi := Round(ls * fp[1]);
bi := Round(ls * fp[2]);
end;
// ignoring BG color in transparent renders..
if (ri >= 0) and (ri <= 256) and (curvesSet) then ri := Round(csa[1][Round(csa[0][ri])]);
if (gi >= 0) and (gi <= 256) and (curvesSet) then gi := Round(csa[2][Round(csa[0][gi])]);
if (bi >= 0) and (bi <= 256) and (curvesSet) then bi := Round(csa[3][Round(csa[0][bi])]);
ri := (ri * 255) div ai; // ai > 0 !
if (ri < 0) then ri := 0
else if (ri > 255) then ri := 255;
gi := (gi * 255) div ai;
if (gi < 0) then gi := 0
else if (gi > 255) then gi := 255;
bi := (bi * 255) div ai;
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;
AlphaRow[j] := ai;
end
else begin // ------------------------------------------- No transparency
if (fp[3] > 0.0) then begin
// gamma linearization
if fp[3] <= fcp.gamma_threshold then begin
frac := fp[3] / fcp.gamma_threshold;
alpha := (1 - frac) * fp[3] * funcval + frac * power(fp[3], gamma);
end
else
alpha := power(fp[3], gamma);
ls := vib * alpha / fp[3];
ai := round(alpha * 256);
if (ai < 0) then ai := 0
else if (ai > 255) then ai := 255;
ia := 255 - ai;
end
else begin
// no intensity so simply set the BG;
Row[j] := bgtot;
continue;
end;
if (notvib > 0) then begin
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma));
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma));
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma));
end
else begin
ri := Round(ls * fp[0]);
gi := Round(ls * fp[1]);
bi := Round(ls * fp[2]);
end;
if (ri >= 0) and (ri <= 256) and (curvesSet) then ri := Round(csa[1][Round(csa[0][ri])]);
if (gi >= 0) and (gi <= 256) and (curvesSet) then gi := Round(csa[2][Round(csa[0][gi])]);
if (bi >= 0) and (bi <= 256) and (curvesSet) then bi := Round(csa[3][Round(csa[0][bi])]);
ri := ri + (ia * bgi[0]) shr 8;
if (ri < 0) then ri := 0
else if (ri > 255) then ri := 255;
gi := gi + (ia * bgi[1]) shr 8;
if (gi < 0) then gi := 0
else if (gi > 255) then gi := 255;
bi := bi + (ia * 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;
AlphaRow[j] := ai;//?
end
end;
//Inc(bucketpos, gutter_width);
//Inc(bucketpos, (FOversample - 1) * FBucketWidth);
Inc(by, FOversample);
end;
FBitmap.PixelFormat := pf24bit;
if assigned(FOnProgress) then FOnProgress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SaveImage(FileName: String);
var
i,row: integer;
PngObject: TPngObject;
rowbm, rowpng: PByteArray;
JPEGImage: TJPEGImage;
PNGerror: boolean;
label BMPhack;
begin
if UpperCase(ExtractFileExt(FileName)) = '.PNG' then begin
pngError := false;
PngObject := TPngObject.Create;
try
PngObject.Assign(FBitmap);
if fcp.Transparency then // PNGTransparency <> 0
begin
PngObject.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin
rowbm := PByteArray(FAlphaBitmap.scanline[i]);
rowpng := PByteArray(PngObject.AlphaScanline[i]);
for row := 0 to FAlphaBitmap.Width -1 do begin
rowpng[row] := rowbm[row];
end;
end;
end;
//else Exception.CreateFmt('Unexpected value of PNGTransparency [%d]', [PNGTransparency])
if FCommentStr <> '' then
PngObject.AddtEXt('ApoFlame', AnsiString(FCommentStr)); // AV
PngObject.SaveToFile(FileName);
except
pngError := true;
end;
PngObject.Free;
if pngError then begin
FileName := ChangeFileExt(FileName, '.bmp');
goto BMPHack;
end;
end else if UpperCase(ExtractFileExt(FileName)) = '.JPG' then begin
JPEGImage := TJPEGImage.Create;
JPEGImage.Assign(FBitmap);
JPEGImage.CompressionQuality := JPEGQuality;
JPEGImage.SaveToFile(FileName);
JPEGImage.Free;
// with TLinearBitmap.Create do
// try
// Assign(Renderer.GetImage);
// JPEGLoader.Default.Quality := JPEGQuality;
// SaveToFile(RenderForm.FileName);
// finally
// Free;
// end;
end else begin // bitmap
BMPHack:
FBitmap.SaveToFile(FileName);
if fcp.Transparency then begin
FAlphaBitmap.Palette := CreatePalette(AlphaPalette.logpal);
FileName := ChangeFileExt(FileName, '_alpha.bmp');
FAlphaBitmap.SaveToFile(FileName);
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TImageMaker.EmbedText(CommentStr: String): boolean; //AV
begin
FCommentStr := CommentStr;
Result := false;
end;
///////////////////////////////////////////////////////////////////////////////
function TImageMaker.GetTransparentImage: TPngObject;
var
x, y: integer;
i, row: integer;
rowbm, rowpng: PByteArray;
begin
Result := TPngObject.Create;
Result.Assign(FBitmap);
if ((fcp <> nil) and fcp.Transparency) then begin
Result.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin
rowbm := PByteArray(FAlphaBitmap.scanline[i]);
rowpng := PByteArray(Result.AlphaScanline[i]);
for row := 0 to FAlphaBitmap.Width - 1 do begin
rowpng[row] := rowbm[row];
end;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TImageMaker.GetBucket(x, y: integer): TBucket;
begin
with FBuckets[y][x] do begin
Result.Red := Red;
Result.Green := Green;
Result.Blue := Blue;
Result.Count := Count;
end;
end;
function TImageMaker.SafeGetBucket(x, y: integer): TBucket;
begin
if x < 0 then x := 0
else if x >= FBucketWidth then x := FBucketWidth-1;
if y < 0 then y := 0
else if y >= FBucketHeight then y := FBucketHeight-1;
Result := FGetBucket(x, y);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.GetBucketStats(var Stats: TBucketStats);
var
bucketpos: integer;
x, y: integer;
b: TBucket;
begin
with Stats do begin
MaxR := 0;
MaxG := 0;
MaxB := 0;
MaxA := 0;
TotalA := 0;
for y := 0 to FBucketHeight - 1 do
for x := 0 to FBucketWidth - 1 do begin
b := FGetBucket(x, y);
MaxR := max(MaxR, b.Red);
MaxG := max(MaxG, b.Green);
MaxB := max(MaxB, b.Blue);
MaxA := max(MaxA, b.Count);
TotalA := TotalA + b.Count
end;
end;
end;
end.
Rendering/RenderThread.pas
+386
View File
@@ -0,0 +1,386 @@
{
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 RenderThread;
interface
uses
Classes, Windows, Messages, Graphics,
ControlPoint, RenderingInterface,
Global, RenderingCommon, PngImage,
RenderingImplementation;
//Disabled:
//Render64, Render64MT,
//Render48, Render48MT,
//Render32f, Render32fMT;
const
WM_THREAD_COMPLETE = WM_APP + 5437;
WM_THREAD_TERMINATE = WM_APP + 5438;
type
TRenderThread = class(TThread)
private
FRenderer: TBaseRenderer;
FOnProgress: TOnProgress;
FCP: TControlPoint;
FMaxMem: int64;
FNrThreads: Integer;
FBitsPerSample: integer;
FMinDensity: double;
FOutput: TStrings;
FExportBuffer: boolean;
FCommentStr: String; // AV
procedure CreateRenderer;
function GetNrSlices: integer;
function GetSlice: integer;
procedure SetBitsPerSample(const bits: Integer);
function GetExportBuffer: boolean;
procedure SetExportBuffer(value: boolean);
procedure Trace(const str: string);
public
TargetHandle: HWND;
WaitForMore, More: boolean;
constructor Create;
destructor Destroy; override;
procedure SetCP(CP: TControlPoint);
function GetImage: TBitmap;
function GetTransparentImage: TPngObject;
procedure SaveImage(const FileName: String);
procedure Execute; override;
function GetRenderer: TBaseRenderer;
procedure Terminate;
procedure Suspend;
procedure Resume;
procedure BreakRender;
procedure HibernateRender(filePath: string);
procedure ResumeFromHibernation(filePath: string);
function EmbedText(CommentStr: String): boolean; //AV
function DoSnapshot: boolean; // AV: to make mid-render snapshots
// procedure GetBucketStats(var Stats: TBucketStats);
procedure ShowBigStats;
procedure ShowSmallStats;
property OnProgress: TOnProgress
// read FOnProgress
write FOnProgress;
property Slice: integer
read GetSlice;
property NrSlices: integer
read GetNrSlices;
property MaxMem: int64
read FMaxMem
write FMaxMem;
// property compatibility: Integer read Fcompatibility write Fcompatibility;
property NrThreads: Integer
read FNrThreads
write FNrThreads;
property BitsPerSample: Integer
read FBitsPerSample
write SetBitsPerSample;
property Output: TStrings
write FOutput;
property MinDensity: double
write FMinDensity;
property ExportBuffer: boolean
read GetExportBuffer
write SetExportBuffer;
end;
implementation
uses
Math, SysUtils,Tracer;
{ TRenderThread }
///////////////////////////////////////////////////////////////////////////////
destructor TRenderThread.Destroy;
begin
if assigned(FRenderer) then
FRenderer.Free;
FRenderer := nil;
if assigned(FCP) then FCP.Free;
inherited;
end;
function TRenderThread.DoSnapshot: boolean; // AV
begin
Result := false;
if assigned(FRenderer) then
Result := FRenderer.DoSnapshot;
end;
function TRenderThread.GetExportBuffer: boolean;
begin
if assigned(FRenderer) then
Result := FRenderer.ExportBuffer
else Result := FExportBuffer;
end;
procedure TRenderThread.SetExportBuffer(value: boolean);
begin
if assigned(FRenderer) then
FRenderer.ExportBuffer := value;
FExportBuffer := value;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetImage: TBitmap;
begin
Result := nil;
if assigned(FRenderer) then
Result := FRenderer.GetImage;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetTransparentImage: TPngObject;
begin
Result := nil;
if assigned(FRenderer) then
Result := FRenderer.GetTransparentImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetCP(CP: TControlPoint);
begin
FCP := CP.Clone;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TRenderThread.Create;
begin
MaxMem := 0;
// BitsPerSample := InternalBitsPerSample; // AV: now unused
FreeOnTerminate := false;
WaitForMore := false;
inherited Create(True); // Create Suspended;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.CreateRenderer;
begin
if assigned(FRenderer) then begin
Trace('Destroying previous renderer (?)');
FRenderer.Free;
end;
Trace('Creating renderer');
if NrThreads <= 1 then begin
if MaxMem = 0 then begin
FRenderer := TRenderWorkerST.Create;
end else begin
FRenderer := TRenderWorkerST_MM.Create;
FRenderer.MaxMem := MaxMem;
end;
end
else begin
if MaxMem = 0 then begin
FRenderer := TRenderWorkerMT.Create;
end else begin
FRenderer := TRenderWorkerMT_MM.Create;
FRenderer.MaxMem := MaxMem;
end;
FRenderer.NumThreads := NrThreads;
end;
FRenderer.ExportBuffer := FExportbuffer;
FRenderer.SetCP(FCP);
FRenderer.MinDensity := FMinDensity;
FRenderer.OnProgress := FOnProgress;
FRenderer.Output := FOutput;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Execute;
label RenderMore;
begin
CreateRenderer;
RenderMore:
assert(assigned(FRenderer));
Trace('Rendering');
FRenderer.Render;
if Terminated or FRenderer.Failed then begin
Trace('Sending WM_THREAD_TERMINATE');
PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, ThreadID);
Trace('Terminated');
exit;
end
else begin
Trace('Sending WM_THREAD_COMPLETE');
PostMessage(TargetHandle, WM_THREAD_COMPLETE, 0, ThreadID);
end;
if WaitForMore and (FRenderer <> nil) then begin
FRenderer.RenderMore := true;
Trace('Waiting for more');
inherited Suspend;
if WaitForMore then goto RenderMore;
end;
Trace('Finished');
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Terminate;
begin
try
if assigned(FRenderer) then
FRenderer.Stop;
except on EAccessViolation do
// nothing
end;
WaitForMore := false;
inherited Terminate;
end;
procedure TRenderThread.Suspend;
begin
if assigned(FRenderer) then FRenderer.Pause;
inherited;
end;
procedure TRenderThread.Resume;
begin
if assigned(FRenderer) then FRenderer.UnPause;
inherited;
end;
procedure TRenderThread.BreakRender;
begin
if assigned(FRenderer) then
FRenderer.BreakRender;
end;
procedure TRenderThread.HibernateRender(filePath: string);
begin
if assigned(FRenderer) then
FRenderer.Hibernate(filePath);
end;
procedure TRenderThread.ResumeFromHibernation(filePath: string);
begin
if assigned(FRenderer) then
FRenderer.Stop;
FRenderer.Resume(filePath);
FRenderer.UnPause;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetNrSlices: integer;
begin
if assigned(FRenderer) then
Result := FRenderer.NrSlices
else
Result := 1;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetSlice: integer;
begin
if assigned(FRenderer) then
Result := FRenderer.Slice
else
Result := 1;
end;
//////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetRenderer: TBaseRenderer;
begin
Result := FRenderer;
FRenderer := nil;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetBitsPerSample(const bits: Integer);
begin
if FRenderer = nil then FBitsPerSample := bits
else assert(false);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SaveImage(const FileName: String);
begin
if assigned(FRenderer) then
begin
if FCommentStr <> '' then
FRenderer.EmbedText(FCommentStr);
FRenderer.SaveImage(FileName);
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderThread.EmbedText(CommentStr: String): boolean; // AV: for parameters embedding
begin
Result := False;
FCommentStr := CommentStr;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Trace(const str: string);
begin
if assigned(FOutput) and (TraceLevel >= 2) then
FOutput.Add('. . > RenderThread #' + IntToStr(ThreadID) + ': ' + str);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.ShowBigStats;
begin
if assigned(FRenderer) then
FRenderer.ShowBigStats;
end;
procedure TRenderThread.ShowSmallStats;
begin
if assigned(FRenderer) then
FRenderer.ShowSmallStats;
end;
///////////////////////////////////////////////////////////////////////////////
end.
Rendering/RenderingCommon.pas
+71
View File
@@ -0,0 +1,71 @@
{
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 RenderingCommon;
interface
type
TOnFinish = procedure of object;
TOnProgress = procedure(prog: double) of object;
{$ifdef Apo7X64}
TBucket = Record
Red,
Green,
Blue,
Count: Double;
end;
{$else}
TBucket = Record
Red,
Green,
Blue,
Count: Single;
end;
{$endif}
PBucket = ^TBucket;
TBucketArray = array of array of TBucket;
// TZBuffer = array of array of double;
TBucketStats = record
MaxR, MaxG, MaxB, MaxA,
TotalA: double;
end;
procedure TrimWorkingSet;
implementation
uses Windows;
procedure TrimWorkingSet;
var
hProcess: THandle;
begin
hProcess := OpenProcess(PROCESS_SET_QUOTA, false, GetCurrentProcessId);
try SetProcessWorkingSetSize(hProcess, $FFFFFFFF, $FFFFFFFF);
finally CloseHandle(hProcess);
end;
end;
end.
Rendering/RenderingImplementation.pas
+792
View File
@@ -0,0 +1,792 @@
{
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 RenderingImplementation;
{$ifdef Apo7X64}
{$else}
{$define _ASM_}
{$endif}
interface
uses
{$ifndef _ASM_}
{$else}
AsmRandom,
{$endif}
Windows, Classes, Forms, Graphics, Global,
RenderingInterface, Xform, Math, Translation,
Binary, RenderingCommon, ControlPoint, Sysutils,
BucketFillerThread;
type
TBatchProc = procedure of object;
TRenderWorkerST = class(TBaseRenderer)
protected
PropTable: array[0..PROP_TABLE_SIZE] of TXform;
finalXform: TXform;
UseFinalXform: boolean;
procedure Prepare; override;
procedure SetPixels; override;
protected
procedure IterateBatch;
procedure IterateBatchAngle;
procedure IterateBatchFX;
procedure IterateBatchAngleFX;
end;
type
TRenderWorkerMT = class(TBaseRenderer)
protected
batchcounter: Integer;
WorkingThreads: array of TBucketFillerThread;
CriticalSection: TRTLCriticalSection;
function NewThread: TBucketFillerThread;
procedure Prepare; override;
procedure SetPixels; override;
protected
procedure AddPointsToBuckets(const points: TPointsArray);
procedure AddPointsToBucketsAngle(const points: TPointsArray);
public
procedure Stop; override;
procedure BreakRender; override;
procedure Pause; override;
procedure UnPause; override;
procedure SetThreadPriority(p: TThreadPriority); override; // AV
end;
type
TRenderWorkerST_MM = class(TRenderWorkerST)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
type
TRenderWorkerMT_MM = class(TRenderWorkerMT)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
// ----------------------------------------------------------------------------
implementation
////////////////////////////////////////////////////////////////////////////////
// PREPARE
////////////////////////////////////////////////////////////////////////////////
procedure TRenderWorkerST.Prepare;
var
i, n: Integer;
propsum: double;
LoopValue: double;
j: integer;
TotValue: double;
begin
totValue := 0;
n := fcp.NumXforms;
assert(n > 0);
finalXform := fcp.xform[n];
finalXform.Prepare;
useFinalXform := fcp.FinalXformEnabled and fcp.HasFinalXform;
fcp.Prepare;
end;
procedure TRenderWorkerMT.Prepare;
begin
fcp.Prepare;
end;
////////////////////////////////////////////////////////////////////////////////
// SETPIXELS
////////////////////////////////////////////////////////////////////////////////
procedure TRenderWorkerST.SetPixels;
var
i: integer;
nsamples: int64;
IterateBatchProc: procedure of object;
begin
if FNumSlices > 1 then
TimeTrace(Format(TextByKey('common-trace-rendering-multipleslices'), [FSlice + 1, FNumSlices]))
else
TimeTrace(TextByKey('common-trace-rendering-oneslice'));
Randomize;
if FCP.FAngle = 0 then begin
if UseFinalXform then
IterateBatchProc := IterateBatchFX
else
IterateBatchProc := IterateBatch;
end
else begin
if UseFinalXform then
IterateBatchProc := IterateBatchAngleFX
else
IterateBatchProc := IterateBatchAngle;
end;
NSamples := Round(sample_density * NrSlices * bucketSize / (oversample * oversample));
FNumBatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
if FNumBatches = 0 then FNumBatches := 1;
FMinBatches := Round(FNumBatches * FMinDensity / fcp.sample_density);
if FMinBatches = 0 then FMinBatches := 1;
for i := 0 to FNumBatches-1 do
begin
if FStop <> 0 then begin
{ AV: moved below to update running quality estimate for mid-render snapshots
fcp.actual_density := fcp.actual_density + fcp.sample_density * i / FNumBatches;
}
FNumBatches := i;
exit;
end;
if ((i and $1F) = 0) then Progress(i / FNumBatches);
IterateBatchProc;
// AV: update running quality estimate (for mid-render snapshots)
fcp.actual_density := fcp.actual_density + fcp.sample_density / FNumBatches; // AV
Inc(FBatch);
end;
fcp.actual_density := {fcp.actual_density +} fcp.sample_density; // AV
Progress(1);
end;
procedure TRenderWorkerMT.SetPixels;
var
i: integer;
nSamples: Int64;
bc : integer;
begin
if FNumSlices > 1 then
TimeTrace(Format(TextByKey('common-trace-rendering-multipleslices'), [FSlice + 1, FNumSlices]))
else
TimeTrace(TextByKey('common-trace-rendering-oneslice'));
nSamples := Round(sample_density * NrSlices * BucketSize / (oversample * oversample));
FNumBatches := Round(nSamples / (fcp.nbatches * SUB_BATCH_SIZE));
if FNumBatches = 0 then FNumBatches := 1;
FMinBatches := Round(FNumBatches * FMinDensity / fcp.sample_density);
if FMinBatches = 0 then FMinBatches := 1; // AV
batchcounter := 1;
Randomize;
InitializeCriticalSection(CriticalSection);
SetLength(WorkingThreads, NumThreads);
for i := 0 to NumThreads - 1 do
WorkingThreads[i] := NewThread;
for i := 0 to NumThreads - 1 do
WorkingThreads[i].Resume;
bc := 1;
while (FStop = 0) and (bc <= FNumBatches) do begin
sleep(250);
try
EnterCriticalSection(CriticalSection);
Progress(batchcounter / FNumBatches);
if (bc < batchcounter) then
begin
// AV: update running quality estimate for mid-render snapshots
fcp.actual_density := fcp.actual_density +
fcp.sample_density * (BatchCounter - bc) / FNumBatches; // actual quality of incomplete render
bc := batchcounter;
end;
finally
LeaveCriticalSection(CriticalSection);
end;
end;
for i := 0 to High(WorkingThreads) do begin
WorkingThreads[i].Terminate;
WorkingThreads[i].WaitFor;
WorkingThreads[i].Free;
end;
SetLength(WorkingThreads, 0);
// AV: running quality estimate is updated above; tidy up remaining counts
fcp.actual_density := fcp.actual_density +
fcp.sample_density * (BatchCounter - bc + 1) / FNumBatches; // AV: actual quality of incomplete render
// fcp.sample_density * BatchCounter / FNumBatches; // actual quality of incomplete render
FNumBatches := BatchCounter;
DeleteCriticalSection(CriticalSection);
Progress(1);
end;
////////////////////////////////////////////////////////////////////////////////
// MM OVERRIDES
////////////////////////////////////////////////////////////////////////////////
procedure TRenderWorkerST_MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderWorkerST_MM.Render;
begin
RenderMM;
end;
procedure TRenderWorkerMT_MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderWorkerMT_MM.Render;
begin
RenderMM;
end;
////////////////////////////////////////////////////////////////////////////////
// BATCH ITERATION
////////////////////////////////////////////////////////////////////////////////
procedure TRenderWorkerST.IterateBatch;
var
i: integer;
px, py: double;
Bucket: PBucket;
// ZBufPos: PDouble;
MapColor: PColorMapColor;
ix, iy: integer;
BmpColor: TColor;
p, q: TCPPoint;
xf: TXForm;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
// AV: fixed - Apo renderer crashes if z-value is not initialized
p.z := 0; // AV
p.c := random;
{$else}
asm
fld1
call AsmRandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call AsmRandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call AsmRandExt
fstp qword ptr [p.c]
fldz // AV
fstp qword ptr [p.z] // AV
end;
{$endif}
try
xf := fcp.xform[0];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
end;
for i := 0 to SUB_BATCH_SIZE-1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
// if random >= xf.transOpacity then continue;
if (xf.transOpacity = 0) then continue // AV
else if ((xf.transOpacity < 1) and (random > xf.transOpacity)) then continue;
q := p;
fcp.ProjectionFunc(@q); // 3d hack
px := q.x - camX0;
if (px < 0) or (px > camW) then continue;
py := q.y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
{$ifdef ENABLEZBUF}
ZBufPos := @zbuffer[Round(bhs * py)][Round(bws * px)];
if (q.z < ZBufPos^) then
begin
ZBufPos^ := q.z;
Bucket.Red := Bucket.Red + MapColor.Red;
Bucket.Green := Bucket.Green + MapColor.Green;
Bucket.Blue := Bucket.Blue + MapColor.Blue;
Bucket.Count := Bucket.Count + 1;
end;
{$else}
with Bucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderWorkerST.IterateBatchAngle;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
// ZBufPos: PDouble;
ix, iy: integer;
BmpColor: TColor;
p, q: TCPPoint;
xf: TXForm;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.z := 0; // AV: fixed - Apo renderer crashes if z-value is not initialized
p.c := random;
{$else}
asm
fld1
call AsmRandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call AsmRandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call AsmRandExt
fstp qword ptr [p.c]
fldz // AV
fstp qword ptr [p.z] // AV
end;
{$endif}
try
xf := fcp.xform[0];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
end;
for i := 0 to SUB_BATCH_SIZE-1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
// if random >= xf.transOpacity then continue;
if (xf.transOpacity = 0) then continue // AV
else if ((xf.transOpacity < 1) and (random > xf.transOpacity)) then continue;
q := p;
fcp.ProjectionFunc(@q);
px := q.x * cosa + q.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
{$ifdef ENABLEZBUF}
ZBufPos := @zbuffer[Round(bhs * py)][Round(bws * px)];
if (q.z < ZBufPos^) then
begin
ZBufPos^ := q.z;
Bucket.Red := Bucket.Red + MapColor.Red;
Bucket.Green := Bucket.Green + MapColor.Green;
Bucket.Blue := Bucket.Blue + MapColor.Blue;
Bucket.Count := Bucket.Count + 1;
end;
{$else}
with Bucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderWorkerST.IterateBatchFX;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
// ZbufPos: PDouble;
ix, iy: integer;
BmpColor: TColor;
p, q: TCPPoint;
xf: TXForm;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.z := 0; // AV: fixed - Apo renderer crashes if z-value is not initialized
p.c := random;
{$else}
asm
fld1
call AsmRandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call AsmRandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call AsmRandExt
fstp qword ptr [p.c]
fldz // AV
fstp qword ptr [p.z] // AV
end;
{$endif}
try
xf := fcp.xform[0];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
end;
for i := 0 to SUB_BATCH_SIZE-1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
if (xf.transOpacity = 0) then continue // AV
else if ((xf.transOpacity < 1) and (random > xf.transOpacity)) then continue;
finalXform.NextPointTo(p, q);
fcp.ProjectionFunc(@q);
px := q.x - camX0;
if (px < 0) or (px > camW) then continue;
py := q.y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
{$ifdef ENABLEZBUF}
ZBufPos := @zbuffer[Round(bhs * py)][Round(bws * px)];
if (q.z < ZBufPos^) then
begin
ZBufPos^ := q.z;
Bucket.Red := Bucket.Red + MapColor.Red;
Bucket.Green := Bucket.Green + MapColor.Green;
Bucket.Blue := Bucket.Blue + MapColor.Blue;
Bucket.Count := Bucket.Count + 1;
end;
{$else}
with Bucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderWorkerST.IterateBatchAngleFX;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
// ZBufPos: PDouble;
ix, iy: integer;
BmpColor: TColor;
p, q: TCPPoint;
xf: TXForm;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.z := 0; // AV: fixed - Apo renderer crashes if z-value is not initialized
p.c := random;
{$else}
asm
fld1
call AsmRandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call AsmRandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call AsmRandExt
fstp qword ptr [p.c]
fldz // AV
fstp qword ptr [p.z] // AV
end;
{$endif}
try
xf := fcp.xform[0];
for i := 0 to FUSE do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
end;
for i := 0 to SUB_BATCH_SIZE-1 do begin
xf := xf.PropTable[Random(PROP_TABLE_SIZE)];
xf.NextPoint(p);
if (xf.transOpacity = 0) then continue // AV
else if ((xf.transOpacity < 1) and (random > xf.transOpacity)) then continue;
finalXform.NextPointTo(p, q);
fcp.ProjectionFunc(@q);
px := q.x * cosa + q.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
{$ifdef ENABLEZBUF}
ZBufPos := @zbuffer[Round(bhs * py)][Round(bws * px)];
if (q.z < ZBufPos^) then
begin
ZBufPos^ := q.z;
Bucket.Red := Bucket.Red + MapColor.Red;
Bucket.Green := Bucket.Green + MapColor.Green;
Bucket.Blue := Bucket.Blue + MapColor.Blue;
Bucket.Count := Bucket.Count + 1;
end;
{$else}
with Bucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderWorkerMT.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
Bucket: PBucket;
// ZBufPos: PDouble;
MapColor: PColorMapColor;
begin
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
px := points[i].x - camX0;
if (px < 0) or (px > camW) then continue;
py := points[i].y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(points[i].c * 255)];
{$ifdef ENABLEZBUF}
ZBufPos := @zbuffer[Round(bhs * py)][Round(bws * px)];
if (points[i].z < ZBufPos^) then
begin
ZBufPos^ := points[i].z;
Bucket.Red := Bucket.Red + MapColor.Red;
Bucket.Green := Bucket.Green + MapColor.Green;
Bucket.Blue := Bucket.Blue + MapColor.Blue;
Bucket.Count := Bucket.Count + 1;
end;
{$else}
with Bucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
{$endif}
end;
end;
procedure TRenderWorkerMT.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
//ZBufPos: PDouble;
begin
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
px := points[i].x * cosa + points[i].y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := points[i].y * cosa - points[i].x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(points[i].c * 255)];
{$ifdef ENABLEZBUF}
ZBufPos := @zbuffer[Round(bhs * py)][Round(bws * px)];
if (points[i].z < ZBufPos^) then
begin
ZBufPos^ := points[i].z;
Bucket.Red := Bucket.Red + MapColor.Red;
Bucket.Green := Bucket.Green + MapColor.Green;
Bucket.Blue := Bucket.Blue + MapColor.Blue;
Bucket.Count := Bucket.Count + 1;
end;
{$else}
with Bucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
{$endif}
end;
end;
////////////////////////////////////////////////////////////////////////////////
// THREADING
////////////////////////////////////////////////////////////////////////////////
procedure TRenderWorkerMT.Stop;
var
i: integer;
begin
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Terminate;
inherited;
end;
procedure TRenderWorkerMT.BreakRender;
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Terminate;
end;
procedure TRenderWorkerMT.Pause;
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Suspend;
end;
procedure TRenderWorkerMT.UnPause;
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Resume;
end;
procedure TRenderWorkerMT.SetThreadPriority(p: TThreadPriority); // AV
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Priority := p;
end;
function TRenderWorkerMT.NewThread: TBucketFillerThread;
begin
Result := TBucketFillerThread.Create(fcp);
assert(Result <> nil);
if FThreadPriority <> tpNormal then // AV
Result.Priority := {tpLower;} FThreadPriority;
if FCP.FAngle = 0 then
Result.AddPointsProc := self.AddPointsToBuckets
else
Result.AddPointsProc := self.AddPointsToBucketsAngle;
Result.CriticalSection := CriticalSection;
Result.Nrbatches := FNumBatches;
Result.batchcounter := @batchcounter;
end;
end.
Rendering/RenderingInterface.pas
+1136
View File
File diff suppressed because it is too large Load Diff
System/AsmRandom.pas
+95
View File
@@ -0,0 +1,95 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
This module is (c) Jed Kelsey and originally created for Apophysis JK 2.10.
}
unit AsmRandom;
interface
procedure AsmRandInt;
procedure AsmRandExt;
procedure AsmRandomize;
var
RandSeed: Longint = 0; { Base for random number generator }
implementation
const
advapi32 = 'advapi32.dll';
kernel = 'kernel32.dll';
function QueryPerformanceCounter(var lpPerformanceCount: Int64): LongBool; stdcall;
external kernel name 'QueryPerformanceCounter';
function GetTickCount: Cardinal;
external kernel name 'GetTickCount';
procedure AsmRandomize;
{$IFDEF LINUX}
begin
RandSeed := _time(nil);
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
var
Counter: Int64;
begin
if QueryPerformanceCounter(Counter) then
RandSeed := Counter
else
RandSeed := GetTickCount;
end;
{$ENDIF}
procedure AsmRandInt;
asm
{ ->EAX Range }
{ <-EAX Result }
IMUL EDX,RandSeed,08088405H
INC EDX
MOV RandSeed,EDX
MUL EDX
MOV EAX,EDX
end;
procedure AsmRandExt;
const two2neg32: double = ((1.0/$10000) / $10000); // 2^-32
asm
{ FUNCTION _RandExt: Extended; }
IMUL EDX,RandSeed,08088405H
INC EDX
MOV RandSeed,EDX
FLD two2neg32
PUSH 0
PUSH EDX
FILD qword ptr [ESP]
ADD ESP,8
FMULP ST(1), ST(0)
end;
end.
System/CurvesControl.dfm
+23
View File
@@ -0,0 +1,23 @@
object CurvesControl: TCurvesControl
Left = 0
Top = 0
Width = 542
Height = 440
DoubleBuffered = True
Color = clBlack
ParentBackground = False
ParentColor = False
ParentDoubleBuffered = False
TabOrder = 0
object Host: TPanel
Left = 0
Top = 0
Width = 542
Height = 440
Align = alClient
BevelOuter = bvNone
Color = clBlack
ParentBackground = False
TabOrder = 0
end
end
System/CurvesControl.pas
+384
View File
@@ -0,0 +1,384 @@
unit CurvesControl;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Math, ControlPoint,
Graphics, Controls, Forms, Bezier, CustomDrawControl, Vcl.ExtCtrls;
const
point_size: double = 8;
accurancy: double = 3;
channel_count: integer = 4;
padding = 3;
const
MAX_CHANNEL = 3;
type
TCurvesChannel = (ccAll = 0, ccRed = 1, ccGreen = 2, ccBlue = 3);
TCurvesControl = class(TFrame)
Host: TPanel;
private
FRect: BezierRect;
FPoints: array [0..3] of BezierPoints;
FWeights: array [0..3] of BezierWeights;
FDragging: boolean;
FDragIndex: integer;
FActiveChannel : TCurvesChannel;
FChannelIndex : integer;
FFrame : TCustomDrawControl;
FCP: TControlPoint;
p: array [0..MAX_CHANNEL] of BezierPoints;
w: array [0..MAX_CHANNEL] of BezierWeights;
wsum: array [0..MAX_CHANNEL] of double;
procedure SetChannel(value: TCurvesChannel);
procedure SetWeightLeft(value: double);
procedure SetWeightRight(value: double);
function GetChannel: TCurvesChannel;
function GetWeightLeft: double;
function GetWeightRight: double;
procedure FrameMouseLeave(Sender: TObject);
procedure FrameMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FrameMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FrameMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FrameResize(Sender: TObject);
procedure FramePaint(Sender: TObject);
procedure FrameCreate;
procedure PaintCurve(Bitmap: TBitmap; c: integer; p: BezierPoints; w: BezierWeights; widgets: boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property WeightLeft : double read GetWeightLeft write SetWeightLeft;
property WeightRight : double read GetWeightRight write SetWeightRight;
property ActiveChannel : TCurvesChannel read GetChannel write SetChannel;
procedure SetCp(cp: TControlPoint);
procedure UpdateFlame;
end;
implementation
{$R *.DFM}
uses Main, Editor, Mutate, Adjust;
constructor TCurvesControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFrame := TCustomDrawControl.Create(self);
FFrame.TabStop := True;
FFrame.TabOrder := 0;
FFrame.Parent := Host;
FFrame.Align := alClient;
FFrame.Visible := True;
FFrame.OnPaint := FramePaint;
FFrame.OnMouseDown := FrameMouseDown;
FFrame.OnMouseMove := FrameMouseMove;
FFrame.OnMouseUp := FrameMouseUp;
FFrame.OnMouseLeave := FrameMouseLeave;
FCP := TControlPoint.Create;
FrameCreate;
end;
destructor TCurvesControl.Destroy;
begin
FCP.Destroy;
inherited Destroy;
end;
procedure TCurvesControl.SetCp(cp: TControlPoint);
var i, j: integer;
begin
FCP.Copy(cp, true);
for i := 0 to 3 do
for j := 0 to 3 do begin
FWeights[i,j] := FCP.curveWeights[i,j];
FPoints[i,j].x := FCP.curvePoints[i,j].x;
FPoints[i,j].y := FCP.curvePoints[i,j].y;
end;
Invalidate;
FFrame.Invalidate;
end;
procedure TCurvesControl.UpdateFlame;
begin
MainForm.StopThread;
MainForm.UpdateUndo;
MainCp.Copy(FCP, true);
if EditForm.Visible then EditForm.UpdateDisplay;
if MutateForm.Visible then MutateForm.UpdateDisplay;
if AdjustForm.Visible then AdjustForm.UpdateDisplay(true);
MainForm.RedrawTimer.enabled := true;
end;
procedure TCurvesControl.FrameMouseLeave(Sender: TObject);
begin
FrameMouseUp(nil, mbLeft, [], 0, 0);
end;
procedure TCurvesControl.FrameMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
ps_half: double;
i, n: integer;
p: BezierPoints;
begin
BezierCopy(FPoints[FChannelIndex], p);
BezierSetRect(p, true, FRect);
FDragIndex := -1;
FDragging := false;
n := Length(p);
for i := 1 to n - 2 do if
(X >= p[i].x - point_size) and (X <= p[i].x + point_size) and
(Y >= p[i].y - point_size) and (Y <= p[i].y + point_size) then
begin
FDragging := true;
FDragIndex := i;
Break;
end;
end;
procedure TCurvesControl.FrameMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
m: BezierPoints;
tmp: BezierPoint;
i: Integer;
j: Integer;
begin
if (y < 0) then Exit;
if (x < 0) then Exit;
m[0].x := x; m[0].y := y;
BezierUnsetRect(m, true, FRect);
if FDragging then
begin
FPoints[FChannelIndex][FDragIndex] := m[0];
if (FPoints[FChannelIndex][FDragIndex].x <= 0)
then FPoints[FChannelIndex][FDragIndex].x := 0;
if (FPoints[FChannelIndex][FDragIndex].y <= 0)
then FPoints[FChannelIndex][FDragIndex].y := 0;
if (FPoints[FChannelIndex][FDragIndex].x >= 1)
then FPoints[FChannelIndex][FDragIndex].x := 1;
if (FPoints[FChannelIndex][FDragIndex].y >= 1)
then FPoints[FChannelIndex][FDragIndex].y := 1;
if (FPoints[FChannelIndex][1].x > FPoints[FChannelIndex][2].x) then
begin
tmp := FPoints[FChannelIndex][1];
FPoints[FChannelIndex][1] := FPoints[FChannelIndex][2];
FPoints[FChannelIndex][2] := tmp;
if (FDragIndex = 1) then FDragIndex := 2
else FDragIndex := 1;
end;
for i := 0 to 3 do
for j := 0 to 3 do begin
FCP.curveWeights[i,j] := FWeights[i,j];
FCP.curvePoints[i,j].x := FPoints[i,j].x;
FCP.curvePoints[i,j].y := FPoints[i,j].y;
end;
FFrame.Refresh;
end;
end;
procedure TCurvesControl.FrameMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FDragIndex := -1;
FDragging := false;
if (sender <> nil) then UpdateFlame;
end;
procedure TCurvesControl.FrameCreate;
var i: integer;
begin
for i := 0 to channel_count - 1 do
begin
FPoints[i][0].x := 0.00; FPoints[i][0].y := 0.00; FWeights[i][0] := 1;
FPoints[i][1].x := 0.00; FPoints[i][1].y := 0.00; FWeights[i][1] := 1;
FPoints[i][2].x := 1.00; FPoints[i][2].y := 1.00; FWeights[i][2] := 1;
FPoints[i][3].x := 1.00; FPoints[i][3].y := 1.00; FWeights[i][3] := 1;
end;
FDragIndex := -1;
FDragging := false;
end;
procedure TCurvesControl.FrameResize(Sender: TObject);
begin
FRect.x0 := 0; FRect.y0 := 0;
FRect.x1 := self.Width - 1;
FRect.y1 := self.Height - 1;
end;
procedure TCurvesControl.FramePaint(Sender: TObject);
var
clientRect: TRect;
i, j, x, y, sx, sy: integer;
bitmap: TBitMap;
begin
if (FFrame.Width <= 0) or (FFrame.Height <= 0) then Exit;
FrameResize(Sender);
Bitmap := TBitmap.Create;
Bitmap.Width := FFrame.Width;
Bitmap.Height := FFrame.Height;
sx := Bitmap.Width;
sy := Bitmap.Height;
try
with Bitmap.Canvas do
begin
Brush.Color := $000000;
FillRect(Rect(0, 0, sx, sy));
Pen.Color := $555555;
Pen.Style := psSolid;
Pen.Width := 1;
for x := 1 to 7 do begin
MoveTo(Round(0.125 * x * FRect.x1), Round(FRect.y0));
LineTo(Round(0.125 * x * FRect.x1), Round(FRect.y1));
end;
for y := 1 to 3 do begin
MoveTo(Round(FRect.x0), Round(0.25 * y * FRect.y1));
LineTo(Round(FRect.x1), Round(0.25 * y * FRect.y1));
end;
for i := 0 to channel_count - 1 do begin
for j := 0 to 3 do
wsum[i] := wsum[i] + FWeights[i][j];
for j := 0 to 3 do
w[i][j] := FWeights[i][j] / wsum[i];
BezierCopy(FPoints[i], p[i]);
BezierSetRect(p[i], true, FRect);
if i <> FChannelIndex then PaintCurve(Bitmap, i, p[i], w[i], false);
end;
PaintCurve(Bitmap, FChannelIndex, p[FChannelIndex], w[FChannelIndex], true);
FFrame.Canvas.Draw(0, 0, Bitmap);
end;
finally
Bitmap.Free;
end;
end;
procedure TCurvesControl.PaintCurve(Bitmap: TBitmap; c: integer; p: BezierPoints; w: BezierWeights; widgets: boolean);
var
pos0, pos1: BezierPoint;
t, step: Double;
r, g, b: array [0 .. MAX_CHANNEL] of integer;
rgbv: integer;
begin
with Bitmap.Canvas do
begin
if c <> FChannelIndex then begin
r[0] := $aa; r[1] := $aa; r[2] := $40; r[3] := $40;
g[0] := $aa; g[1] := $40; g[2] := $aa; g[3] := $40;
b[0] := $aa; b[1] := $40; b[2] := $40; b[3] := $aa;
end else begin
r[0] := $ff; r[1] := $ff; r[2] := $80; r[3] := $80;
g[0] := $ff; g[1] := $80; g[2] := $ff; g[3] := $80;
b[0] := $ff; b[1] := $80; b[2] := $80; b[3] := $ff;
end;
rgbv := RGB(r[c], g[c], b[c]);
t := 0;
step := 0.001;
BezierSolve(0, p, w, pos1);
pos0.x := 0; pos0.y := pos1.y;
if widgets then begin
Pen.Color := $808080; Pen.Width := 1;
MoveTo(Round(p[1].x), Round(p[1].y));
LineTo(Round(p[2].x), Round(p[2].y));
MoveTo(Round(FRect.x0), Round(FRect.y1));
LineTo(Round(p[1].x), Round(p[1].y));
MoveTo(Round(FRect.x1), Round(FRect.y0));
LineTo(Round(p[2].x), Round(p[2].y));
end;
while t < 1 do begin
BezierSolve(t, p, w, pos1);
Pen.Color := rgbv;
Pen.Width := 1;
MoveTo(Round(pos0.x), Round(pos0.y));
LineTo(Round(pos1.x), Round(pos1.y));
t := t + step;
pos0 := pos1;
end;
MoveTo(Round(pos0.x), Round(pos0.y));
LineTo(Round(FRect.x1), Round(pos0.y));
if widgets then begin
Brush.Color := rgbv;
Ellipse(
Round(p[1].x - point_size / 2.0),
Round(p[1].y - point_size / 2.0),
Round(p[1].x + point_size / 2.0),
Round(p[1].y + point_size / 2.0)
);
Ellipse(
Round(p[2].x - point_size / 2.0),
Round(p[2].y - point_size / 2.0),
Round(p[2].x + point_size / 2.0),
Round(p[2].y + point_size / 2.0)
);
end;
end;
end;
procedure TCurvesControl.SetChannel(value: TCurvesChannel);
begin
FActiveChannel := value;
FChannelIndex := Integer(value);
FFrame.Refresh;
end;
procedure TCurvesControl.SetWeightLeft(value: double);
begin
FWeights[FChannelIndex][1] := value;
FCP.curveWeights[FChannelIndex][1] := value;
FFrame.Refresh;
end;
procedure TCurvesControl.SetWeightRight(value: double);
begin
FWeights[FChannelIndex][2] := value;
FCP.curveWeights[FChannelIndex][2] := value;
FFrame.Refresh;
end;
function TCurvesControl.GetChannel: TCurvesChannel;
begin
Result := FActiveChannel;
end;
function TCurvesControl.GetWeightLeft: double;
begin
Result := FWeights[FChannelIndex][1];
end;
function TCurvesControl.GetWeightRight: double;
begin
Result := FWeights[FChannelIndex][2];
end;
end.
System/CustomDrawControl.pas
+99
View File
@@ -0,0 +1,99 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit CustomDrawControl;
interface
uses
Classes, Controls, Messages, Windows, Graphics;
type
TCustomDrawControl = class(TCustomControl)
private
FOnPaint: TNotifyEvent;
FOnLeave: TNotifyEvent;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
public
procedure Paint; override;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property Canvas;
property OnDblClick;
property OnKeyDown;
// property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
// property OnMouseWheelDown;
// property OnMouseWheelUp;
property OnEnter;
property OnExit;
property OnMouseLeave: TNotifyEvent read FOnLeave write FOnLeave;
end;
implementation
procedure TCustomDrawControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TCustomDrawControl.WMSetFocus(var Message: TWMSetFocus);
begin
Invalidate;
end;
procedure TCustomDrawControl.WMKillFocus(var Message: TWMKillFocus);
begin
if assigned(OnExit) then OnExit(self);
Invalidate;
end;
procedure TCustomDrawControl.WMGetDlgCode(var Message: TMessage);
begin
inherited;
Message.Result := Message.Result or DLGC_WANTARROWS;
end;
procedure TCustomDrawControl.CMMouseLeave(var Message: TMessage);
begin
if Assigned(FOnLeave) then FOnLeave(Self);
end;
procedure TCustomDrawControl.Paint;
begin
if Assigned(FOnPaint) then FOnPaint(Self);
end;
end.
System/LibXmlComps.dcr
BIN
View File
Binary file not shown.
System/LibXmlComps.pas
+122
View File
@@ -0,0 +1,122 @@
(**
===============================================================================================
Name : LibXmlComps
===============================================================================================
Project : All Projects processing XML documents
===============================================================================================
Subject : XML parser for Delphi's VCL toolbar
===============================================================================================
Dipl.-Ing. (FH) Stefan Heymann, Softwaresysteme, Tübingen, Germany
===============================================================================================
Date Author Changes
-----------------------------------------------------------------------------------------------
2000-03-31 HeySt 1.0.0 Start
2000-07-27 HeySt 1.0.1 Added "TAttr" declaration
Moved GetNormalize/SetNormalize to PROTECTED section
2001-02-03 HeySt Changed prototype for the TExternalEvent callback function type
so that C++Builder users should get it compiled better.
2001-02-28 HeySt 1.0.2 Introduced the "StopParser" property. When you set this property to
TRUE in one of the Parser Events, parsing is stopped and the Execute
method returns.
Introduced Version numbers
2001-07-10 HeySt 1.0.3 Fixed a bug in TScannerXmlParser.DtdElementFound so that the
OnAttList event is correctly fired
2001-07-11 HeySt 1.1.0 Derived from the new TCustomXmlScanner class from LibXmlParser
2005-07-07 HeySt 1.1.1 Published new TranslateCharacter event property
*)
UNIT LibXmlComps;
INTERFACE
USES
Classes,
LibXmlParser;
TYPE
TXmlScanner = CLASS (TCustomXmlScanner)
PUBLIC
PROPERTY XmlParser;
PROPERTY StopParser;
PUBLISHED
PROPERTY Filename;
PROPERTY Normalize;
PROPERTY OnXmlProlog;
PROPERTY OnComment;
PROPERTY OnPI;
PROPERTY OnDtdRead;
PROPERTY OnStartTag;
PROPERTY OnEmptyTag;
PROPERTY OnEndTag;
PROPERTY OnContent;
PROPERTY OnCData;
PROPERTY OnElement;
PROPERTY OnAttList;
PROPERTY OnEntity;
PROPERTY OnNotation;
PROPERTY OnDtdError;
PROPERTY OnLoadExternal;
PROPERTY OnTranslateEncoding;
PROPERTY OnTranslateCharacter;
END;
// The "Easy" XML Scanner leaves out events and properties which you are unlikely to use
// for "normal" XML files.
// CDATA sections trigger "OnContent" events
TEasyXmlScanner = CLASS (TCustomXmlScanner)
PROTECTED
PROCEDURE WhenCData (Content : string); OVERRIDE;
PUBLIC
PROPERTY XmlParser;
PROPERTY StopParser;
PUBLISHED
PROPERTY Filename;
PROPERTY Normalize;
PROPERTY OnComment;
PROPERTY OnPI;
PROPERTY OnStartTag;
PROPERTY OnEmptyTag;
PROPERTY OnEndTag;
PROPERTY OnContent;
PROPERTY OnLoadExternal;
PROPERTY OnTranslateEncoding;
END;
PROCEDURE Register;
(*
===============================================================================================
IMPLEMENTATION
===============================================================================================
*)
IMPLEMENTATION
PROCEDURE Register;
BEGIN
RegisterComponents ('XML', [TXmlScanner, TEasyXmlScanner]);
END;
(*
===============================================================================================
TEasyXmlScanner
===============================================================================================
*)
PROCEDURE TEasyXmlScanner.WhenCData (Content : string);
BEGIN
INHERITED WhenContent (Content);
END;
(*
===============================================================================================
INITIALIZATION
===============================================================================================
*)
END.
System/LibXmlParser.pas
+2719
View File
File diff suppressed because it is too large Load Diff
System/RegexHelper.pas
+90
View File
@@ -0,0 +1,90 @@
unit RegexHelper;
interface
uses Global, SysUtils, StrUtils, RegularExpressionsCore;
type T2Int = record
i1, i2: integer;
end;
type T2Float = record
f1, f2: extended;
end;
type TRgb = record
r, g, b: integer;
end;
function GetStringPart(text, expression: string; group: integer; def: string): string;
function GetBoolPart(text, expression: string; group: integer; def: boolean): boolean;
function GetIntPart(text, expression: string; group: integer; def: integer): integer;
function GetFloatPart(text, expression: string; group: integer; def: extended): extended;
function Get2IntPart(text, expression: string; group: integer; def: integer): T2Int;
function Get2FloatPart(text, expression: string; group: integer; def: extended): T2Float;
function GetRGBPart(text, expression: string; group: integer; def: integer): TRGB;
implementation
(* ***************************** Extract functions ******************************* *)
function GetStringPart(text, expression: string; group: integer; def: string): string;
var Regex: TPerlRegEx;
begin
Regex := TPerlRegEx.Create;
Regex.RegEx := expression;
Regex.Options := [preSingleLine, preCaseless];
Regex.Subject := text;
if Regex.Match and (Regex.GroupCount >= group) then
Result := String(Regex.Groups[group])
else Result := def;
Regex.Free;
end;
function GetBoolPart(text, expression: string; group: integer; def: boolean): boolean;
begin
Result := GetFloatPart(text, expression, group, StrToFloat(IfThen(def, '1', '0'))) <> 0;
end;
function GetIntPart(text, expression: string; group: integer; def: integer): integer;
var str: string;
begin
str := GetStringPart(text, expression, group, '');
Result := StrToIntDef(str, def);
end;
function GetFloatPart(text, expression: string; group: integer; def: extended): extended;
var str: string;
begin
str := GetStringPart(text, expression, group, '');
Result := StrToFloatDef(str, def);
end;
function Get2IntPart(text, expression: string; group: integer; def: integer): T2Int;
const expr : string = '(\d+)\s+(\d+)';
var str, s1, s2: string;
begin
str := GetStringPart(text, expression, group, IntToStr(def) + ' ' + IntToStr(def));
s1 := GetStringPart(str, expr, 1, IntToStr(def));
s2 := GetStringPart(str, expr, 2, IntToStr(def));
Result.i1 := StrToIntDef(s1, def);
Result.i2 := StrToIntDef(s2, def);
end;
function Get2FloatPart(text, expression: string; group: integer; def: extended): T2Float;
const expr : string = '([\d.eE+-]+)\s+([\d.eE+-]+)';
var str, s1, s2: string;
begin
str := GetStringPart(text, expression, group, FloatToStr(def) + ' ' + FloatToStr(def));
s1 := GetStringPart(str, expr, 1, FloatToStr(def));
s2 := GetStringPart(str, expr, 2, FloatToStr(def));
Result.f1 := StrToFloatDef(s1, def);
Result.f2 := StrToFloatDef(s2, def);
end;
function GetRGBPart(text, expression: string; group: integer; def: integer): TRGB;
const expr : string = '(\d+)\s+(\d+)\s+(\d+)';
var str, s1, s2, s3: string;
begin
str := GetStringPart(text, expression, group, IntToStr(def) + ' ' + IntToStr(def) + ' ' + IntToStr(def));
s1 := GetStringPart(str, expr, 1, IntToStr(def));
s2 := GetStringPart(str, expr, 2, IntToStr(def));
s3 := GetStringPart(str, expr, 3, IntToStr(def));
Result.r := StrToIntDef(s1, def);
Result.g := StrToIntDef(s2, def);
Result.b := StrToIntDef(s3, def);
end;
end.
System/sdStringTable.pas
+633
View File
@@ -0,0 +1,633 @@
{ unit sdStringTable
Author: Nils Haeck M.Sc. (n.haeck@simdesign.nl)
Original Date: 28 May 2007
Version: 1.1
Copyright (c) 2007 - 2010 Simdesign BV
It is NOT allowed under ANY circumstances to publish or copy this code
without accepting the license conditions in accompanying LICENSE.txt
first!
This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
ANY KIND, either express or implied.
Please visit http://www.simdesign.nl/xml.html for more information.
}
unit sdStringTable;
interface
{$i NativeXml.inc}
uses
Classes, SysUtils, Contnrs;
type
// A record describing a string by its first position and length (Count)
TsdStringRec = record
First: Pbyte;
Count: integer;
end;
// A string reference item used in string reference lists (do not use directly)
TsdRefString = class
private
FID: integer;
FFrequency: integer;
FFirst: Pbyte;
FCharCount: integer;
protected
procedure SetString(const SR: TsdStringRec);
function CompareToSR(const SR: TsdStringRec): integer;
function StringRec: TsdStringRec;
public
destructor Destroy; override;
function AsString: UTF8String;
property CharCount: integer read FCharCount;
property Frequency: integer read FFrequency;
end;
// A list of string reference items (do not use directly)
TsdRefStringList = class(TObjectList)
private
function GetItems(Index: integer): TsdRefString;
protected
// Assumes list is sorted by StringID
function IndexOfID(AID: integer; var Index: integer): boolean;
// Assumes list is sorted by string rec
function IndexOfSR(const AStringRec: TsdStringRec; var Index: integer): boolean;
public
property Items[Index: integer]: TsdRefString read GetItems; default;
end;
// A string table, holding a collection of unique strings, sorted in 2 ways
// for fast access. Strings can be added with AddString or AddStringRec,
// and should be updated with SetString. When a string is added or updated,
// an ID is returned which the application can use to retrieve the string,
// using GetString.
TsdStringTable = class(TPersistent)
private
FByID: TsdRefStringList;
FBySR: TsdRefStringList;
protected
procedure DecFrequency(AItem: TsdRefString; ByIdIndex: integer);
function NextUniqueID: integer;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
// Add a new string rec, return fresh ID or ID of existing item, and increase
// the existing item's ref count
function AddStringRec(const SR: TsdStringRec): integer;
// Add a new string S to the table, the function returns its ID.
function AddString(const S: UTF8String): integer;
// Get the refstring by ID
function ById(index: integer): TsdRefString;
// Delete refstring by ID
procedure Delete(ByIdIndex: integer);
// determine if the stringrec exists
function ExistStringRec(const SR: TsdStringRec): boolean;
// Get the string of refstring with ID
function GetString(ID: integer): UTF8String;
// Set the string value of refstring with ID.
procedure SetString(var ID: integer; const S: UTF8String);
// Number of refstrings
function StringCount: integer;
procedure SaveToFile(const AFileName: string);
procedure SaveToStream(S: TStream);
end;
{utility functions}
// convert a string into a string rec
function sdStringToSR(const S: Utf8String): TsdStringRec;
// convert a string rec into a string
function sdSRToString(const SR: TsdStringRec): Utf8String;
// compare two string recs. This is NOT an alphabetic compare. SRs are first
// compared by length, then by first byte, then last byte then second, then
// N-1, until all bytes are compared.
function sdCompareSR(const SR1, SR2: TsdStringRec): integer;
// compare 2 bytes
function sdCompareByte(Byte1, Byte2: byte): integer;
// compare 2 integers
function sdCompareInteger(Int1, Int2: integer): integer;
function sdUtf16ToUtf8Mem(Src: Pword; Dst: Pbyte; Count: integer): integer;
function sdUtf8ToUtf16Mem(var Src: Pbyte; Dst: Pword; Count: integer): integer;
procedure sdStreamWrite(S: TStream; const AString: AnsiString);
procedure sdStreamWriteStringRec(S: TStream; const AStringRec: TsdStringRec);
procedure sdStreamWriteRefString(S: TStream; ARefString: TsdRefString);
implementation
{ TsdRefString }
function TsdRefString.AsString: UTF8String;
begin
Result := sdSRToString(StringRec);
end;
function TsdRefString.CompareToSR(const SR: TsdStringRec): integer;
begin
if SR.Count = 0 then
begin
// shortcut
Result := 1;
exit;
end;
Result := sdCompareSR(StringRec, SR);
end;
destructor TsdRefString.Destroy;
begin
FreeMem(FFirst);
inherited;
end;
procedure TsdRefString.SetString(const SR: TsdStringRec);
begin
FCharCount := SR.Count;
ReallocMem(FFirst, FCharCount);
Move(SR.First^, FFirst^, FCharCount);
end;
function TsdRefString.StringRec: TsdStringRec;
begin
Result.First := FFirst;
Result.Count := FCharCount;
end;
{ TsdRefStringList }
function TsdRefStringList.GetItems(Index: integer): TsdRefString;
begin
Result := Get(Index);
end;
function TsdRefStringList.IndexOfID(AID: integer; var Index: integer): boolean;
var
Min, Max: integer;
begin
Result := False;
// Find position - binary method
Index := 0;
Min := 0;
Max := Count;
while Min < Max do
begin
Index := (Min + Max) div 2;
case sdCompareInteger(Items[Index].FID, AID) of
-1: Min := Index + 1;
0: begin
Result := True;
exit;
end;
1: Max := Index;
end;
end;
Index := Min;
end;
function TsdRefStringList.IndexOfSR(const AStringRec: TsdStringRec; var Index: integer): boolean;
var
Min, Max: integer;
SR: TsdStringRec;
begin
Result := False;
// Find position - binary method
Index := 0;
Min := 0;
Max := Count;
while Min < Max do
begin
Index := (Min + Max) div 2;
SR := TsdRefString(Get(Index)).StringRec;
case sdCompareSR(SR, AStringRec) of
-1: Min := Index + 1;
0: begin
Result := True;
exit;
end;
1: Max := Index;
end;
end;
Index := Min;
end;
{ TsdStringTable }
function TsdStringTable.AddString(const S: UTF8String): integer;
var
SR: TsdStringRec;
begin
SR := sdStringToSR(S);
Result := AddStringRec(SR);
end;
function TsdStringTable.AddStringRec(const SR: TsdStringRec): integer;
var
BySRIndex: integer;
Item: TsdRefString;
NewSR: TsdStringRec;
Res: boolean;
begin
// zero-length string
if SR.Count = 0 then
begin
Result := 0;
exit;
end;
// Try to find the new string
if FBySR.IndexOfSR(SR, BySRIndex) then
begin
Item := FBySR.Items[BySRIndex];
inc(Item.FFrequency);
Result := Item.FID;
exit;
end;
// Not found.. must make new item
Item := TsdRefString.Create;
Item.SetString(SR);
NewSR := Item.StringRec;
Item.FID := NextUniqueID;
FById.Add(Item);
Item.FFrequency := 1;
// debug:
//SetLength(Item.FValue, Item.FCount);
//Move(Item.FirstPtr(FBase)^, Item.FValue[1], Item.FCount);
// Insert in BySR lists
Res := FBySR.IndexOfSR(NewSR, BySRIndex);
assert(Res = False);
FBySR.Insert(BySRIndex, Item);
Result := Item.FID;
end;
function TsdStringTable.ById(index: integer): TsdRefString;
begin
Result := FById[Index];
end;
procedure TsdStringTable.Clear;
begin
FByID.Clear;
FBySR.Clear;
end;
constructor TsdStringTable.Create;
begin
inherited Create;
FByID := TsdRefStringList.Create(False);
FBySR := TsdRefStringList.Create(True);
end;
procedure TsdStringTable.DecFrequency(AItem: TsdRefString; ByIdIndex: integer);
var
BySRIndex: integer;
Res: boolean;
begin
dec(AItem.FFrequency);
assert(AItem.FFrequency >= 0);
if AItem.FFrequency = 0 then
begin
// We must remove it
FById.Delete(ByIdIndex);
Res := FBySR.IndexOfSR(AItem.StringRec, BySRIndex);
assert(Res = True);
FBySR.Delete(BySRIndex);
end;
end;
procedure TsdStringTable.Delete(ByIdIndex: integer);
var
Item: TsdRefString;
BySRIndex: integer;
Res: boolean;
begin
Item := FById[ByIdIndex];
if Item = nil then
exit;
FById.Delete(ByIdIndex);
Res := FBySR.IndexOfSR(Item.StringRec, BySRIndex);
assert(Res = True);
FBySR.Delete(BySRIndex);
end;
destructor TsdStringTable.Destroy;
begin
FreeAndNil(FByID);
FreeAndNil(FBySR);
inherited;
end;
function TsdStringTable.ExistStringRec(const SR: TsdStringRec): boolean;
var
BySRIndex: integer;
begin
// zero-length string
if SR.Count = 0 then
begin
Result := False;
exit;
end;
// Try to find the new string
Result := FBySR.IndexOfSR(SR, BySRIndex);
end;
function TsdStringTable.GetString(ID: integer): UTF8String;
var
Index, Count: integer;
Item: TsdRefString;
begin
if ID = 0 then
begin
Result := '';
exit;
end;
// Find the ID
if FByID.IndexOfID(ID, Index) then
begin
Item := FById[Index];
Count := Item.FCharCount;
SetLength(Result, Count);
Move(Item.FFirst^, Result[1], Count);
exit;
end;
Result := '';
end;
function TsdStringTable.NextUniqueID: integer;
begin
if FById.Count = 0 then
Result := 1
else
Result := FByID[FByID.Count - 1].FID + 1;
end;
procedure TsdStringTable.SaveToFile(const AFileName: string);
var
F: TFileStream;
begin
F := TFileStream.Create(AFileName, fmCreate);
try
SaveToStream(F);
finally
F.Free;
end;
end;
procedure TsdStringTable.SaveToStream(S: TStream);
var
i: integer;
R: UTF8String;
begin
for i := 0 to FBySR.Count - 1 do
begin
R := FBySR[i].AsString + #13#10;
S.Write(R[1], length(R));
end;
end;
procedure TsdStringTable.SetString(var ID: integer; const S: UTF8String);
var
ByIdIndex: integer;
Item: TsdRefString;
SR: TsdStringRec;
begin
// Make temp string record
SR := sdStringtoSR(S);
// Do we have a ref string with this ID?
if (ID > 0) and FByID.IndexOfID(ID, ByIdIndex) then
begin
// Is the string still the same?
Item := FById[ByIdIndex];
if Item.CompareToSR(SR) = 0 then
exit;
// The string changed..
DecFrequency(Item, ByIdIndex);
end;
ID := AddStringRec(SR);
end;
{utility functions}
function TsdStringTable.StringCount: integer;
begin
Result := FBySR.Count;
end;
function sdStringToSR(const S: UTF8String): TsdStringRec;
begin
Result.Count := length(S);
if Result.Count = 0 then
Result.First := nil
else
Result.First := @S[1];
end;
function sdSRToString(const SR: TsdStringRec): UTF8String;
begin
SetLength(Result, SR.Count);
if SR.Count > 0 then
Move(SR.First^, Result[1], SR.Count);
end;
function sdCompareByte(Byte1, Byte2: byte): integer;
begin
if Byte1 < Byte2 then
Result := -1
else
if Byte1 > Byte2 then
Result := 1
else
Result := 0;
end;
function sdCompareInteger(Int1, Int2: integer): integer;
begin
if Int1 < Int2 then
Result := -1
else
if Int1 > Int2 then
Result := 1
else
Result := 0;
end;
function sdCompareSR(const SR1, SR2: TsdStringRec): integer;
var
Count: integer;
First1, First2, Last1, Last2: Pbyte;
begin
// Compare string length first
Result := sdCompareInteger(SR1.Count, SR2.Count);
if Result <> 0 then
exit;
// Compare first
Result := sdCompareByte(SR1.First^, SR2.First^);
if Result <> 0 then
exit;
Count := SR1.Count;
// Setup First & Last pointers
First1 := SR1.First;
First2 := SR2.First;
Last1 := First1; inc(Last1, Count);
Last2 := First2; inc(Last2, Count);
// Compare each time last ptrs then first ptrs, until they meet in the middle
repeat
dec(Last1);
dec(Last2);
if First1 = Last1 then
exit;
Result := sdCompareByte(Last1^, Last2^);
if Result <> 0 then
exit;
inc(First1); inc(First2);
if First1 = Last1 then
exit;
Result := sdCompareByte(First1^, First2^);
if Result <> 0 then
exit;
until False;
end;
function sdUtf16ToUtf8Mem(Src: Pword; Dst: Pbyte; Count: integer): integer;
// Convert an Unicode (UTF16 LE) memory block to UTF8. This routine will process
// Count wide characters (2 bytes size) to Count UTF8 characters (1-3 bytes).
// Therefore, the block at Dst must be at least 1.5 the size of the source block.
// The function returns the number of *bytes* written.
var
W: word;
DStart: Pbyte;
begin
DStart := Dst;
while Count > 0 do
begin
W := Src^;
inc(Src);
if W <= $7F then
begin
Dst^ := byte(W);
inc(Dst);
end else
begin
if W > $7FF then
begin
Dst^ := byte($E0 or (W shr 12));
inc(Dst);
Dst^ := byte($80 or ((W shr 6) and $3F));
inc(Dst);
Dst^ := byte($80 or (W and $3F));
inc(Dst);
end else
begin // $7F < W <= $7FF
Dst^ := byte($C0 or (W shr 6));
inc(Dst);
Dst^ := byte($80 or (W and $3F));
inc(Dst);
end;
end;
dec(Count);
end;
Result := integer(Dst) - integer(DStart);
end;
function sdUtf8ToUtf16Mem(var Src: Pbyte; Dst: Pword; Count: integer): integer;
// Convert an UTF8 memory block to Unicode (UTF16 LE). This routine will process
// Count *bytes* of UTF8 (each character 1-3 bytes) into UTF16 (each char 2 bytes).
// Therefore, the block at Dst must be at least 2 times the size of Count, since
// many UTF8 characters consist of just one byte, and are mapped to 2 bytes. The
// function returns the number of *wide chars* written. Note that the Src block must
// have an exact number of UTF8 characters in it, if Count doesn't match then
// the last character will be converted anyway (going past the block boundary!)
var
W: word;
C: byte;
DStart: Pword;
SClose: Pbyte;
begin
DStart := Dst;
SClose := Src;
inc(SClose, Count);
while integer(Src) < integer(SClose) do
begin
// 1st byte
W := Src^;
inc(Src);
if W and $80 <> 0 then
begin
W := W and $3F;
if W and $20 <> 0 then
begin
// 2nd byte
C := Src^;
inc(Src);
if C and $C0 <> $80 then
// malformed trail byte or out of range char
Continue;
W := (W shl 6) or (C and $3F);
end;
// 2nd or 3rd byte
C := Src^;
inc(Src);
if C and $C0 <> $80 then
// malformed trail byte
Continue;
Dst^ := (W shl 6) or (C and $3F);
inc(Dst);
end else
begin
Dst^ := W;
inc(Dst);
end;
end;
Result := (integer(Dst) - integer(DStart)) div 2;
end;
procedure sdStreamWrite(S: TStream; const AString: AnsiString);
var
L: integer;
begin
L := Length(AString);
if L > 0 then
begin
S.Write(AString[1], L);
end;
end;
procedure sdStreamWriteStringRec(S: TStream; const AStringRec: TsdStringRec);
begin
S.Write(PAnsiChar(AStringRec.First)^, AStringRec.Count);
end;
procedure sdStreamWriteRefString(S: TStream; ARefString: TsdRefString);
begin
if ARefString = nil then
exit;
S.Write(PAnsiChar(ARefString.FFirst)^, ARefString.FCharCount);
end;
end.
Variations/varAffine3D.pas
+325
View File
@@ -0,0 +1,325 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varAffine3D;
interface
uses
BaseVariation, XFormMan;
type
TVariationAffine3D = class(TBaseVariation)
private
affine3D_a00, affine3D_a01, affine3D_a02,
affine3D_a10, affine3D_a11, affine3D_a12,
affine3D_a20, affine3D_a21, affine3D_a22,
affine3D_bx, affine3D_by, affine3D_bz: double;
x0, y0, z0: double;
affine3D_mode: byte;
procedure CalcPre;
procedure CalcPost;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure GetCalcFunction(var f: TCalcFunction); override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationAffine3D.GetCalcFunction(var f: TCalcFunction);
begin
case affine3D_mode of
0: f := CalcPre;
1: f := CalcFunction;
else f := CalcPost;
end;
end;
procedure TVariationAffine3D.CalcPre;
var x, y, z, dn: double;
begin
x := affine3D_a00 * FTx^ - affine3D_a01 * FTy^ + affine3D_a02 * FTz^ + affine3D_bx;
y := -(affine3D_a10 * FTx^ - affine3D_a11 * FTy^ + affine3D_a12 * FTz^ + affine3D_by);
z := affine3D_a20 * FTx^ - affine3D_a21 * FTy^ + affine3D_a22 * FTz^ + affine3D_bz;
FTx^ := VVAR * x;
FTy^ := VVAR * y;
FTz^ := VVAR * z;
dn := hypot(x - x0, y - y0, z - z0);
if (dn <> 0) then color^ := abs(cos(hypot(x - x0, y - y0) / dn))
else color^ := 0;
end;
procedure TVariationAffine3D.CalcFunction;
var x, y, z, dn: double;
begin
x := affine3D_a00 * FTx^ - affine3D_a01 * FTy^ + affine3D_a02 * FTz^ + affine3D_bx;
y := -(affine3D_a10 * FTx^ - affine3D_a11 * FTy^ + affine3D_a12 * FTz^ + affine3D_by);
z := affine3D_a20 * FTx^ - affine3D_a21 * FTy^ + affine3D_a22 * FTz^ + affine3D_bz;
FPx^ := FPx^ + VVAR * x;
FPy^ := FPy^ + VVAR * y;
FPz^ := FPz^ + VVAR * z;
dn := hypot(x - x0, y - y0, z - z0);
if (dn <> 0) then color^ := abs(cos(hypot(x - x0, y - y0) / dn))
else color^ := 0;
end;
procedure TVariationAffine3D.CalcPost;
var x, y, z, dn: double;
begin
x := affine3D_a00 * FPx^ - affine3D_a01 * FPy^ + affine3D_a02 * FPz^ + affine3D_bx;
y := -(affine3D_a10 * FPx^ - affine3D_a11 * FPy^ + affine3D_a12 * FPz^ + affine3D_by);
z := affine3D_a20 * FPx^ - affine3D_a21 * FPy^ + affine3D_a22 * FPz^ + affine3D_bz;
FPx^ := VVAR * x;
FPy^ := VVAR * y;
FPz^ := VVAR * z;
dn := hypot(x - x0, y - y0, z - z0);
if (dn <> 0) then color^ := abs(cos(hypot(x - x0, y - y0) / dn))
else color^ := 0;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationAffine3D.Create;
begin
affine3D_a00 := 1; affine3D_a01 := 0; affine3D_a02 := 0;
affine3D_a10 := 0; affine3D_a11 := 1; affine3D_a12 := 0;
affine3D_a20 := 0; affine3D_a21 := 0; affine3D_a22 := 1;
affine3D_bx := 0; affine3D_by := 0; affine3D_bz := 0;
x0 := 0; y0 := 0; z0 := 0;
affine3D_mode := 1; // order of applying
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationAffine3D.GetInstance: TBaseVariation;
begin
Result := TVariationAffine3D.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationAffine3D.GetName: string;
begin
Result := 'affine3D';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAffine3D.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'affine3D_a00';
1: Result := 'affine3D_a01';
2: Result := 'affine3D_a02';
3: Result := 'affine3D_a10';
4: Result := 'affine3D_a11';
5: Result := 'affine3D_a12';
6: Result := 'affine3D_a20';
7: Result := 'affine3D_a21';
8: Result := 'affine3D_a22';
9: Result := 'affine3D_bx';
10: Result := 'affine3D_by';
11: Result := 'affine3D_bz';
12: Result := 'affine3D_dc_x0';
13: Result := 'affine3D_dc_y0';
14: Result := 'affine3D_dc_z0';
15: Result := 'affine3D_mode';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAffine3D.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'affine3D_a00' then begin
affine3D_a00 := Value;
Result := True;
end else if Name = 'affine3D_a01' then begin
affine3D_a01 := Value;
Result := True;
end else if Name = 'affine3D_a02' then begin
affine3D_a02 := Value;
Result := True;
end else if Name = 'affine3D_a10' then begin
affine3D_a10 := Value;
Result := True;
end else if Name = 'affine3D_a11' then begin
affine3D_a11 := Value;
Result := True;
end else if Name = 'affine3D_a12' then begin
affine3D_a12 := Value;
Result := True;
end else if Name = 'affine3D_a20' then begin
affine3D_a20 := Value;
Result := True;
end else if Name = 'affine3D_a21' then begin
affine3D_a21 := Value;
Result := True;
end else if Name = 'affine3D_a22' then begin
affine3D_a22 := Value;
Result := True;
end else if Name = 'affine3D_bx' then begin
affine3D_bx := Value;
Result := True;
end else if Name = 'affine3D_by' then begin
affine3D_by := Value;
Result := True;
end else if Name = 'affine3D_bz' then begin
affine3D_bz := Value;
Result := True;
end else if Name = 'affine3D_dc_x0' then begin
x0 := Value;
Result := True;
end else if Name = 'affine3D_dc_y0' then begin
y0 := Value;
Result := True;
end else if Name = 'affine3D_dc_z0' then begin
z0 := Value;
Result := True;
end else if Name = 'affine3D_mode' then begin
if (Value < 0) then Value := 0;
if (Value > 2) then Value := 2;
affine3D_mode := Round(Value);
Result := True;
end
end;
function TVariationAffine3D.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'affine3D_a00' then begin
affine3D_a00 := 1;
Result := True;
end else if Name = 'affine3D_a01' then begin
affine3D_a01 := 0;
Result := True;
end else if Name = 'affine3D_a02' then begin
affine3D_a02 := 0;
Result := True;
end else if Name = 'affine3D_a10' then begin
affine3D_a10 := 0;
Result := True;
end else if Name = 'affine3D_a11' then begin
affine3D_a11 := 1;
Result := True;
end else if Name = 'affine3D_a12' then begin
affine3D_a12 := 0;
Result := True;
end else if Name = 'affine3D_a20' then begin
affine3D_a20 := 0;
Result := True;
end else if Name = 'affine3D_a21' then begin
affine3D_a21:= 0;
Result := True;
end else if Name = 'affine3D_a22' then begin
affine3D_a22 := 1;
Result := True;
end else if Name = 'affine3D_bx' then begin
affine3D_bx := 0;
Result := True;
end else if Name = 'affine3D_by' then begin
affine3D_by := 0;
Result := True;
end else if Name = 'affine3D_bz' then begin
affine3D_bz := 0;
Result := True;
end else if Name = 'affine3D_dc_x0' then begin
x0 := 0;
Result := True;
end else if Name = 'affine3D_dc_y0' then begin
y0 := 0;
Result := True;
end else if Name = 'affine3D_dc_z0' then begin
z0 := 0;
Result := True;
end else if Name = 'affine3D_mode' then begin
affine3D_mode := 1;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAffine3D.GetNrVariables: integer;
begin
Result := 16
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAffine3D.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'affine3D_a00' then begin
Value := affine3D_a00;
Result := True;
end else if Name = 'affine3D_a01' then begin
Value := affine3D_a01;
Result := True;
end else if Name = 'affine3D_a02' then begin
Value := affine3D_a02;
Result := True;
end else if Name = 'affine3D_a10' then begin
Value := affine3D_a10;
Result := True;
end else if Name = 'affine3D_a11' then begin
Value := affine3D_a11;
Result := True;
end else if Name = 'affine3D_a12' then begin
Value := affine3D_a12;
Result := True;
end else if Name = 'affine3D_a20' then begin
Value := affine3D_a20;
Result := True;
end else if Name = 'affine3D_a21' then begin
Value := affine3D_a21;
Result := True;
end else if Name = 'affine3D_a22' then begin
Value := affine3D_a22;
Result := True;
end else if Name = 'affine3D_bx' then begin
Value := affine3D_bx;
Result := True;
end else if Name = 'affine3D_by' then begin
Value := affine3D_by;
Result := True;
end else if Name = 'affine3D_bz' then begin
Value := affine3D_bz;
Result := True;
end else if Name = 'affine3D_dc_x0' then begin
Value:= x0;
Result := True;
end else if Name = 'affine3D_dc_y0' then begin
Value := y0;
Result := True;
end else if Name = 'affine3D_dc_z0' then begin
Value := z0;
Result := True;
end else if Name = 'affine3D_mode' then begin
Value := affine3D_mode;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationAffine3D), true, true);
end.
Variations/varArch.pas
+119
View File
@@ -0,0 +1,119 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varArch;
interface
uses
BaseVariation, XFormMan;
const
sweight = 'Z_arch_weight';
type
TVariationArch = class(TBaseVariation)
private
vpi, weight: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
////////////////////////
procedure TVariationArch.Prepare;
begin
vpi := pi * weight; // arch behavior
end;
procedure TVariationArch.CalcFunction;
var
sinr, cosr: double;
begin
SinCos(random * vpi, sinr, cosr);
if cosr = 0 then exit;
FPx^ := FPx^ + vvar * sinr;
FPy^ := FPy^ + sqr(sinr) / cosr * vvar;
end;
constructor TVariationArch.Create;
begin
inherited Create;
weight := 1;
end;
class function TVariationArch.GetInstance: TBaseVariation;
begin
Result := TVariationArch.Create;
end;
class function TVariationArch.GetName: string;
begin
Result := 'Z_arch';
end;
{ ////////////////////////////////////////////////////////////////////// }
function TVariationArch.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := sweight;
else
Result := '';
end;
end;
function TVariationArch.GetNrVariables: integer;
begin
Result := 1;
end;
function TVariationArch.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = sweight then begin
Value := weight;
Result := True;
end;
end;
function TVariationArch.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = sweight then begin
weight := Value;
Result := True;
end;
end;
function TVariationArch.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = sweight then begin
weight := 1;
Result := True;
end;
end;
{ ///////////////////////////////////////////////////////////////////////////// }
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationArch), false, false);
end.
Variations/varAuger.pas
+176
View File
@@ -0,0 +1,176 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit varAuger;
interface
uses
BaseVariation, XFormMan;
type
TVariationAuger = class(TBaseVariation)
private
auger_freq, auger_weight, auger_scale, auger_sym: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationAuger.Prepare;
begin
end;
procedure TVariationAuger.CalcFunction;
var x, y, s, t, dx, dy: double;
begin
x := FTx^;
y := FTy^;
s := sin(auger_freq * x);
t := sin(auger_freq * y);
dx := x + auger_weight * (0.5 * auger_scale * t + abs(x) * t);
dy := y + auger_weight * (0.5 * auger_scale * s + abs(y) * s);
FPx^ := FPx^ + VVAR * (x + auger_sym * (dx - x));
FPy^ := FPy^ + VVAR * dy;
FPz^ := FPz^ + VVAR * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationAuger.Create;
begin
auger_freq := 5; auger_weight := 0.5;
auger_scale := 0.1; auger_sym := 0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationAuger.GetInstance: TBaseVariation;
begin
Result := TVariationAuger.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationAuger.GetName: string;
begin
Result := 'auger';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAuger.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'auger_freq';
1: Result := 'auger_weight';
2: Result := 'auger_scale';
3: Result := 'auger_sym';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAuger.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'auger_freq' then begin
auger_freq := Value;
Result := True;
end else if Name = 'auger_weight' then begin
auger_weight := Value;
Result := True;
end else if Name = 'auger_scale' then begin
auger_scale := Value;
Result := True;
end else if Name = 'auger_sym' then begin
auger_sym := Value;
Result := True;
end
end;
function TVariationAuger.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'auger_freq' then begin
auger_freq := 5;
Result := True;
end else if Name = 'auger_weight' then begin
auger_weight := 0.5;
Result := True;
end else if Name = 'auger_scale' then begin
auger_scale := 0.1;
Result := True;
end else if Name = 'auger_sym' then begin
auger_sym := 0;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAuger.GetNrVariables: integer;
begin
Result := 4
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationAuger.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'auger_freq' then begin
Value := auger_freq;
Result := True;
end else if Name = 'auger_weight' then begin
Value := auger_weight;
Result := True;
end else if Name = 'auger_scale' then begin
Value := auger_scale;
Result := True;
end else if Name = 'auger_sym' then begin
Value := auger_sym;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationAuger), true, false);
end.
Variations/varBent2.pas
+152
View File
@@ -0,0 +1,152 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varBent2;
interface
uses
BaseVariation, XFormMan;
type
TVariationBent2 = class(TBaseVariation)
private
b2x, b2y, b2z, vvarx, vvary, vvarz: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationBent2 }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBent2.Prepare;
begin
vvarx := vvar * b2x;
vvary := vvar * b2y;
vvarz := vvar * b2z;
end;
procedure TVariationBent2.CalcFunction;
begin
if(FTx^ < 0.0) then
FPx^ := FPx^ + vvarx * FTx^
else
FPx^ := FPx^ + vvar * FTx^;
if (FTy^ < 0) then
FPy^ := FPy^ + vvary * FTy^
else
FPy^ := FPy^ + vvar * FTy^;
// AV: added 3D-support
if (FTz^ < 0) then
FPz^ := FPz^ + vvarz * FTz^
else
FPz^ := FPz^ + vvar * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBent2.GetName: string;
begin
Result := 'bent2';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBent2.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'bent2_x';
1: Result := 'bent2_y';
2: Result := 'bent2_z';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBent2.GetNrVariables: integer;
begin
Result := 3;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBent2.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'bent2_x' then begin
b2x := Value;
Result := True;
end else if Name = 'bent2_y' then begin
b2y := Value;
Result := True;
end else if Name = 'bent2_z' then begin
b2z := Value;
Result := True;
end;
end;
function TVariationBent2.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'bent2_x' then begin
b2x := 1;
Result := True;
end else if Name = 'bent2_y' then begin
b2y := 1;
Result := True;
end else if Name = 'bent2_z' then begin
b2z := 1;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBent2.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'bent2_x' then begin
Value := b2x;
Result := True;
end else if Name = 'bent2_y' then begin
Value := b2y;
Result := True;
end else if Name = 'bent2_z' then begin
Value := b2z;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBent2.Create;
begin
b2x := 2;
b2y := 0.5;
b2z := 1;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBent2.GetInstance: TBaseVariation;
begin
Result := TVariationBent2.Create;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBent2), true, false);
end.
Variations/varBipolar.pas
+163
View File
@@ -0,0 +1,163 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit varBipolar;
interface
uses
BaseVariation, XFormMan;
type
TVariationBipolar = class(TBaseVariation)
private
bipolar_shift, v_4, v, s: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBipolar.Prepare;
begin
v_4 := VVAR * 0.15915494309189533576888376337251; // AV: 1/(2*PI)
v := VVAR * 0.636619772367581343075535053490061; // AV: 2/PI
s := -1.57079632679489661923 * (bipolar_shift); // AV: -PI/2
end;
procedure TVariationBipolar.CalcFunction;
var x2y2, y, t, x2, f, g : double;
begin
x2y2 := sqr(FTx^) + sqr(FTy^);
y := 0.5 * ArcTan2(2.0 * FTy^, x2y2 - 1.0) + (s);
if (y > 1.57079632679489661923) then
y := -1.57079632679489661923 + fmod(y + 1.57079632679489661923, PI)
else if (y < -1.57079632679489661923) then
y := 1.57079632679489661923 - fmod(1.57079632679489661923 - y, PI);
t := x2y2 + 1.0;
x2 := 2.0 * FTx^;
f := t + x2;
g := t - x2;
if (g = 0) or (f/g <= 0) then
Exit;
FPx^ := FPx^ + (v_4) * Ln((t+x2) / (t-x2));
FPy^ := FPy^ + (v) * y;
FPz^ := FPz^ + vvar * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBipolar.Create;
begin
bipolar_shift := 0;
v_4 := 0;
v := 0;
s := 0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBipolar.GetInstance: TBaseVariation;
begin
Result := TVariationBipolar.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBipolar.GetName: string;
begin
Result := 'bipolar';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBipolar.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'bipolar_shift';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBipolar.SetVariable(const Name: string; var value: double): boolean;
var temp: double;
begin
Result := False;
if Name = 'bipolar_shift' then begin
temp := frac(0.5 * (value + 1.0));
value := 2.0 * temp - 1.0;
bipolar_shift := Value;
Result := True;
end
end;
function TVariationBipolar.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'bipolar_shift' then begin
bipolar_shift := 0;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBipolar.GetNrVariables: integer;
begin
Result := 1
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBipolar.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'bipolar_shift' then begin
Value := bipolar_shift;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBipolar), true, false);
end.
Variations/varBlade.pas
+61
View File
@@ -0,0 +1,61 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varBlade;
interface
uses
BaseVariation, XFormMan;
type
TVariationBlade = class(TBaseVariation)
private
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
////////////////////////
procedure TVariationBlade.CalcFunction;
var
r, sinr, cosr: double;
begin
r := sqrt(sqr(FTx^) + sqr(FTy^)) * vvar;
SinCos(r * random, sinr, cosr);
r := vvar * FTx^;
FPx^ := FPx^ + r * (cosr + sinr);
FPy^ := FPy^ + r * (cosr - sinr);
// AV: added real 3D support
FPz^ := FPz^ + vvar * FTy^ * (sinr - cosr);
end;
constructor TVariationBlade.Create;
begin
inherited Create;
end;
class function TVariationBlade.GetInstance: TBaseVariation;
begin
Result := TVariationBlade.Create;
end;
class function TVariationBlade.GetName: string;
begin
Result := 'blade';
end;
//////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBlade), true, false);
end.
Variations/varBlob.pas
+131
View File
@@ -0,0 +1,131 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varBlob;
interface
uses
BaseVariation, XFormMan;
type
TVariationBlob = class(TBaseVariation)
private
FLow, FHigh, FWaves: double;
VLow, VHeight: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationBlob }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBlob.Prepare;
begin
VHeight := vvar * (FHigh - FLow) / 2;
VLow := vvar * FLow + VHeight;
end;
procedure TVariationBlob.CalcFunction;
var
r : double;
begin
r := VLow + VHeight * sin(FWaves * arctan2(FTx^, FTy^));
FPx^ := FPx^ + r * FTx^;
FPy^ := FPy^ + r * FTy^;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlob.GetName: string;
begin
Result := 'blob';
end;
///////////////////////////////////////////////////////////////////////////////
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;
///////////////////////////////////////////////////////////////////////////////
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(TVariationClassLoader.Create(TVariationBlob), false, false);
end.
Variations/varBlurCircle.pas
+154
View File
@@ -0,0 +1,154 @@
{
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 varBlurCircle;
interface
uses
BaseVariation, XFormMan;
type
TVariationBlurCircle = class(TBaseVariation)
private
PI_4, hole: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBlurCircle.Prepare;
begin
//VVAR4_PI := VVAR * 4.0 / PI; // AV: it's useless
PI_4 := PI / 4.0;
end;
procedure TVariationBlurCircle.CalcFunction;
var
x, y, absx, absy, side, perimeter, r, sina, cosa: double;
begin
x := 2.0 * random - 1.0;
y := 2.0 * random - 1.0;
absx := abs(x); //if absx < 0 then absx := absx * -1.0;
absy := abs(y); //if absy < 0 then absy := absy * -1.0;
if (absx >= absy) then
begin
if (x >= absy) then
perimeter := absx + y
else perimeter := 5.0 * absx - y;
side := absx;
end else
begin
if (y >= absx) then
perimeter := 3.0 * absy - x
else perimeter := 7.0 * absy + x;
side := absy;
end;
r := VVAR * (side + hole);
SinCos(PI_4 * perimeter / side - PI_4, sina, cosa);
FPx^ := FPx^ + r * cosa;
FPy^ := FPy^ + r * sina;
FPz^ := FPz^ + vvar * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBlurCircle.Create;
begin
hole := 0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlurCircle.GetInstance: TBaseVariation;
begin
Result := TVariationBlurCircle.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlurCircle.GetName: string;
begin
Result := 'blur_circle';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurCircle.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'blur_circle_hole';
else
Result := '';
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurCircle.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blur_circle_hole' then begin
hole := Value;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurCircle.GetNrVariables: integer;
begin
Result := 1;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurCircle.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blur_circle_hole' then begin
Value := hole;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBlurCircle), true, false);
end.
Variations/varBlurPixelize.pas
+153
View File
@@ -0,0 +1,153 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit varBlurPixelize;
interface
uses
BaseVariation, XFormMan;
type
TVariationBlurPixelize = class(TBaseVariation)
private
blur_pixelize_size, blur_pixelize_scale: double;
inv_size, v: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBlurPixelize.Prepare;
begin
inv_size := 1.0 / blur_pixelize_size;
v := vvar * blur_pixelize_size;
end;
procedure TVariationBlurPixelize.CalcFunction;
var x, y: double;
begin
x := floor(FTx^*(inv_size));
y := floor(FTy^*(inv_size));
FPx^ := FPx^ + (v) * (x + (blur_pixelize_scale) * (random - 0.5) + 0.5);
FPy^ := FPy^ + (v) * (y + (blur_pixelize_scale) * (random - 0.5) + 0.5);
FPz^ := FPz^ + vvar * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBlurPixelize.Create;
begin
blur_pixelize_size := 0.1;
blur_pixelize_scale := 1;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlurPixelize.GetInstance: TBaseVariation;
begin
Result := TVariationBlurPixelize.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlurPixelize.GetName: string;
begin
Result := 'blur_pixelize';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurPixelize.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'blur_pixelize_size';
1: Result := 'blur_pixelize_scale';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurPixelize.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blur_pixelize_size' then begin
if (value < 1e-6) then value := 1e-6;
blur_pixelize_size := Value;
Result := True;
end else if Name = 'blur_pixelize_scale' then begin
blur_pixelize_scale := Value;
Result := True;
end
end;
function TVariationBlurPixelize.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'blur_pixelize_size' then begin
blur_pixelize_size := 0.1;
Result := True;
end else if Name = 'blur_pixelize_scale' then begin
blur_pixelize_size := 1;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurPixelize.GetNrVariables: integer;
begin
Result := 2
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurPixelize.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blur_pixelize_size' then begin
Value := blur_pixelize_size;
Result := True;
end else if Name = 'blur_pixelize_scale' then begin
Value := blur_pixelize_scale;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBlurPixelize), true, false);
end.
Variations/varBlurZoom.pas
+144
View File
@@ -0,0 +1,144 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit varBlurZoom;
interface
uses
BaseVariation, XFormMan;
type
TVariationBlurZoom = class(TBaseVariation)
private
blur_zoom_length, blur_zoom_x, blur_zoom_y: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBlurZoom.Prepare;
begin
end;
procedure TVariationBlurZoom.CalcFunction;
var z: double;
begin
z := 1.0 + blur_zoom_length * random;
FPx^ := FPx^ + vvar * ((FTx^ - blur_zoom_x) * z + blur_zoom_x);
FPy^ := FPy^ + vvar * ((FTy^ - blur_zoom_y) * z - blur_zoom_y);
FPz^ := FPz^ + vvar * FTz^;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBlurZoom.Create;
begin
blur_zoom_length := 0;
blur_zoom_x := 0;
blur_zoom_y := 0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlurZoom.GetInstance: TBaseVariation;
begin
Result := TVariationBlurZoom.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBlurZoom.GetName: string;
begin
Result := 'blur_zoom';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurZoom.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'blur_zoom_length';
1: Result := 'blur_zoom_x';
2: Result := 'blur_zoom_y';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurZoom.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blur_zoom_length' then begin
blur_zoom_length := Value;
Result := True;
end else if Name = 'blur_zoom_x' then begin
blur_zoom_y := Value;
Result := True;
end else if Name = 'blur_zoom_y' then begin
blur_zoom_y := Value;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurZoom.GetNrVariables: integer;
begin
Result := 3
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBlurZoom.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'blur_zoom_length' then begin
Value := blur_zoom_length;
Result := True;
end else if Name = 'blur_zoom_x' then begin
Value := blur_zoom_x;
Result := True;
end else if Name = 'blur_zoom_y' then begin
Value := blur_zoom_y;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBlurZoom), true, false);
end.
Variations/varBoarders2.pas
+188
View File
@@ -0,0 +1,188 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varBoarders2;
interface
uses
BaseVariation, XFormMan;
const
sb2c = 'boarders2_c';
sleft = 'boarders2_left';
sright = 'boarders2_right';
eps: double = 1e-30;
type
TVariationBoarders2 = class(TBaseVariation)
private
b2c, left, right, cc, cl, cr: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationBoarders2 }
//////////////////////////////////////////
procedure TVariationBoarders2.Prepare;
begin
cc := abs(b2c);
cl := cc * abs(left);
cr := cc + (cc * abs(right));
end;
//////////////////////////////////////////
procedure TVariationBoarders2.CalcFunction;
var
roundX, roundY, offsetX, offsetY: double;
begin
roundX := round(FTx^);
roundY := round(FTy^);
offsetX := FTx^ - roundX;
offsetY := FTy^ - roundY;
if (random >= cr) then
begin
FPx^ := FPx^ + VVAR * (offsetX * cc + roundX);
FPy^ := FPy^ + VVAR * (offsetY * cc + roundY);
end
else begin
if (abs(offsetX) >= abs(offsetY)) then
begin
if(offsetX >= 0.0) then
begin
FPx^ := FPx^ + VVAR * (offsetX * cc + roundX + cl);
FPy^ := FPy^ + VVAR * (offsetY * cc + roundY + cl * offsetY / offsetX);
end
else begin
FPx^ := FPx^ + VVAR * (offsetX * cc + roundX - cl);
FPy^ := FPy^ + VVAR * (offsetY * cc + roundY - cl * offsetY / offsetX);
end;
end
else begin
if(offsetY >= 0.0) then
begin
FPy^ := FPy^ + VVAR * (offsetY * cc + roundY + cl);
FPx^ := FPx^ + VVAR * (offsetX * cc + roundX + offsetX / offsetY * cl);
end
else begin
FPy^ := FPy^ + VVAR * (offsetY * cc + roundY - cl);
FPx^ := FPx^ + VVAR * (offsetX * cc + roundX - offsetX / offsetY * cl);
end;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBoarders2.Create;
begin
b2c := 0.5;
left := 0.5;
right := 0.5;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBoarders2.GetInstance: TBaseVariation;
begin
Result := TVariationBoarders2.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBoarders2.GetName: string;
begin
Result := 'boarders2';
end;
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
function TVariationBoarders2.GetVariableNameAt(const Index: integer): string;
begin
case Index of
0: Result := sb2c;
1: Result := sleft;
2: Result := sright;
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBoarders2.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = sb2c then begin
if abs(value) = 0 then value := eps;
b2c := value;
Result := True;
end else if Name = sleft then begin
if abs(value) = 0 then value := eps;
left := Value;
Result := True;
end else if Name = sright then begin
if abs(value) = 0 then value := eps;
right := Value;
Result := True;
end;
end;
function TVariationBoarders2.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = sb2c then begin
b2c := 0.5;
Result := True;
end else if Name = sleft then begin
left := 0.5;
Result := True;
end else if Name = sright then begin
right := 0.5;
Result := True;
end;
end;
/////////////////////////////////////////////////////////////////////
function TVariationBoarders2.GetNrVariables: integer;
begin
Result := 3;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBoarders2.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = sb2c then begin
Value := b2c;
Result := True;
end else if Name = sleft then begin
Value := left;
Result := True;
end else if Name = sright then begin
Value := right;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBoarders2), false, false);
end.
Variations/varButterfly.pas
+160
View File
@@ -0,0 +1,160 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varButterfly;
interface
uses
BaseVariation, XFormMan;
type
TVariationButterfly = class(TBaseVariation)
const
str_sx: string = 'butterfly_scale_negX';
str_sy: string = 'butterfly_scale_negY';
str_sz: string = 'butterfly_3D_shift';
private
sx, sy, sz, vpi: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationButterfly }
///////////////////////////////////////////////////////////////////////////////
procedure TVariationButterfly.Prepare;
begin
vpi := vvar * 4.0 / sqrt(3.0 * pi);
end;
procedure TVariationButterfly.CalcFunction;
var r, y2: double;
begin
y2 := FTy^ * 2.0;
r := vpi * sqrt(abs(FTy^ * FTx^)/(sqr(FTx^) + sqr(y2) + 1E-20));
if (FTy^ < 0) then begin
FPx^ := FPx^ + FTx^ * r;
FPy^ := FPy^ + r * y2;
end else begin
FPx^ := FPx^ + sx * FTx^ * r;
FPy^ := FPy^ + sy * r * y2;
end;
if (sz <> 0) then
FPz^ := FPz^ + sz * r * abs(FTx^); //* Hypot(FTx^, FTy^);
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationButterfly.Create;
begin
sx := 1;
sy := 1;
sz := 0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationButterfly.GetInstance: TBaseVariation;
begin
Result := TVariationButterfly.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationButterfly.GetName: string;
begin
Result := 'butterfly';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationButterfly.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := str_sx;
1: Result := str_sy;
2: Result := str_sz;
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationButterfly.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = str_sx then begin
if (value < 0) then value := abs(value);
sx := Value;
Result := True;
end else if Name = str_sy then begin
if (value < 0) then value := abs(value);
sy := Value;
Result := True;
end else if Name = str_sz then begin
if (value < -0.1) then value := -0.1;
sz := Value;
Result := True;
end;
end;
function TVariationButterfly.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = str_sx then begin
sx := 1;
Result := True;
end else if Name = str_sy then begin
sy := 1;
Result := True;
end else if Name = str_sz then begin
sz := 0;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationButterfly.GetNrVariables: integer;
begin
Result := 3;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationButterfly.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = str_sx then begin
Value := sx;
Result := True;
end else if Name = str_sy then begin
Value := sy;
Result := True;
end else if Name = str_sz then begin
Value := sz;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationButterfly), true, false);
end.
Variations/varBwraps.pas
+238
View File
@@ -0,0 +1,238 @@
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit varBwraps;
interface
uses
BaseVariation, XFormMan;
type
TVariationBwraps = class(TBaseVariation)
private
bwraps_cellsize, bwraps_space, bwraps_gain,
bwraps_inner_twist, bwraps_outer_twist,
g2, r2, rfactor: double;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
///////////////////////////////////////////////////////////////////////////////
procedure TVariationBwraps.Prepare;
var
max_bubble, radius: double;
begin
radius := 0.5 * (bwraps_cellsize / (1.0 + sqr(bwraps_space)));
g2 := sqr(bwraps_gain) / (radius + 1e-6) + 1e-6;
max_bubble := g2 * radius;
if (max_bubble > 2.0) then max_bubble := 1.0
else max_bubble := max_bubble * (1.0 / (sqr(max_bubble)/4.0 + 1.0));
r2 := sqr(radius);
rfactor := radius / max_bubble;
end;
procedure TVariationBwraps.CalcFunction;
var
Vx, Vy,
Cx, Cy,
Lx, Ly,
r, theta, s, c : double;
begin
Vx := FTx^;
Vy := FTy^;
if (bwraps_cellsize = 0.0) then
begin
FPx^ := FPx^ + VVAR * FTx^;
FPy^ := FPy^ + VVAR * FTy^;
FPz^ := FPz^ + VVAR * FTz^;
end else
begin
Cx := (floor(Vx / bwraps_cellsize) + 0.5) * bwraps_cellsize;
Cy := (floor(Vy / bwraps_cellsize) + 0.5) * bwraps_cellsize;
Lx := Vx - Cx;
Ly := Vy - Cy;
if ((sqr(Lx) + sqr(Ly)) > r2) then
begin
FPx^ := FPx^ + VVAR * FTx^;
FPy^ := FPy^ + VVAR * FTy^;
FPz^ := FPz^ + VVAR * FTz^;
end else
begin
Lx := Lx * g2;
Ly := Ly * g2;
r := rfactor / ((sqr(Lx) + sqr(Ly)) / 4.0 + 1);
Lx := Lx * r;
Ly := Ly * r;
r := (sqr(Lx) + sqr(Ly)) / r2;
theta := bwraps_inner_twist * (1.0 - r) + bwraps_outer_twist * r;
SinCos(theta, s, c);
Vx := Cx + c * Lx + s * Ly;
Vy := Cy - s * Lx + c * Ly;
FPx^ := FPx^ + VVAR * Vx;
FPy^ := FPy^ + VVAR * Vy;
FPz^ := FPz^ + VVAR * FTz^;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TVariationBwraps.Create;
begin
bwraps_cellsize := 1;
bwraps_space := 0;
bwraps_gain := 1;
bwraps_inner_twist := 0;
bwraps_outer_twist := 0;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBwraps.GetInstance: TBaseVariation;
begin
Result := TVariationBwraps.Create;
end;
///////////////////////////////////////////////////////////////////////////////
class function TVariationBwraps.GetName: string;
begin
Result := 'bwraps';
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBwraps.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := 'bwraps_cellsize';
1: Result := 'bwraps_space';
2: Result := 'bwraps_gain';
3: Result := 'bwraps_inner_twist';
4: Result := 'bwraps_outer_twist';
else
Result := '';
end
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBwraps.SetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'bwraps_cellsize' then begin
bwraps_cellsize := Value;
Result := True;
end else if Name = 'bwraps_space' then begin
bwraps_space := Value;
Result := True;
end else if Name = 'bwraps_gain' then begin
bwraps_gain := Value;
Result := True;
end else if Name = 'bwraps_inner_twist' then begin
bwraps_inner_twist := Value;
Result := True;
end else if Name = 'bwraps_outer_twist' then begin
bwraps_outer_twist := Value;
Result := True;
end
end;
function TVariationBwraps.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = 'bwraps_cellsize' then begin
bwraps_cellsize := 1;
Result := True;
end else if Name = 'bwraps_space' then begin
bwraps_space := 0;
Result := True;
end else if Name = 'bwraps_gain' then begin
bwraps_gain := 1;
Result := True;
end else if Name = 'bwraps_inner_twist' then begin
bwraps_inner_twist := 0;
Result := True;
end else if Name = 'bwraps_outer_twist' then begin
bwraps_outer_twist := 0;
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBwraps.GetNrVariables: integer;
begin
Result := 5
end;
///////////////////////////////////////////////////////////////////////////////
function TVariationBwraps.GetVariable(const Name: string; var value: double): boolean;
begin
Result := False;
if Name = 'bwraps_cellsize' then begin
if Value = 0 then Value := 1e-6;
Value := bwraps_cellsize;
Result := True;
end else if Name = 'bwraps_space' then begin
Value := bwraps_space;
Result := True;
end else if Name = 'bwraps_gain' then begin
Value := bwraps_gain;
Result := True;
end else if Name = 'bwraps_inner_twist' then begin
Value := bwraps_inner_twist;
Result := True;
end else if Name = 'bwraps_outer_twist' then begin
Value := bwraps_outer_twist;
Result := True;
end
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationBwraps), true, false);
end.
Variations/varCircleCrop.pas
+233
View File
@@ -0,0 +1,233 @@
{ Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina }
unit varCircleCrop;
interface
uses
BaseVariation, XFormMan;
type
TVariationCircleCrop = class(TBaseVariation)
const
sx : string = 'circlecrop_x';
sy : string = 'circlecrop_y';
sradius : string = 'circlecrop_radius';
szero : string = 'circlecrop_zero';
sarea : string = 'circlecrop_scatter_area';
srewrite: string = 'circlecrop_rewrite_xy'; // AV
private
x0, y0, radius, scatter_area, ca: double;
zero, rewrite: byte;
resetpoint: boolean;
public
constructor Create;
class function GetName: string; override;
class function GetInstance: TBaseVariation; override;
function GetNrVariables: integer; override;
function GetVariableNameAt(const Index: integer): string; override;
function SetVariable(const Name: string; var value: double): boolean; override;
function GetVariable(const Name: string; var value: double): boolean; override;
function ResetVariable(const Name: string): boolean; override;
procedure Prepare; override;
procedure CalcFunction; override;
end;
implementation
uses
Math;
{ TVariationCircleCrop }
//////////////////////////////////////////
procedure TVariationCircleCrop.Prepare;
begin
ca := max(-1.0, min(scatter_area, 1.0));
resetpoint := (rewrite = 1);
end;
procedure TVariationCircleCrop.CalcFunction;
var
x, y, rad, ang, rdc, sn, cn: double;
begin
x := FTx^ - x0;
y := FTy^ - y0;
rad := Hypot(x, y);
if resetpoint then
begin
FTx^ := x;
FTy^ := y;
end;
if (rad > radius) then
begin
if (zero = 1) then
begin
if resetpoint then
begin
FPx^ := 0;
FPy^ := 0;
end else
begin
FPx^ := FPx^;
FPy^ := FPy^;
end;
end else
begin
ang := arctan2(y, x);
SinCos(ang, sn, cn);
rdc := radius + (random * 0.5 * ca);
FPx^ := FPx^ + vvar * rdc * cn + x0;
FPy^ := FPy^ + vvar * rdc * sn + y0;
end;
end else
begin
FPx^ := FPx^ + vvar * x + x0;
FPy^ := FPy^ + vvar * y + y0;
end;
FPz^ := FPz^ + vvar * FTz^;
end;
constructor TVariationCircleCrop.Create;
begin
x0 := 0;
y0 := 0;
radius := 1;
scatter_area := 0;
zero := 0;
rewrite := 1;
end;
class function TVariationCircleCrop.GetInstance: TBaseVariation;
begin
Result := TVariationCircleCrop.Create;
end;
class function TVariationCircleCrop.GetName: string;
begin
Result := 'circlecrop';
end;
function TVariationCircleCrop.GetNrVariables: integer;
begin
Result := 6;
end;
function TVariationCircleCrop.GetVariable(const Name: string;
var value: double): boolean;
begin
Result := False;
if Name = sx then begin
Value := x0;
Result := True;
end
else if Name = sy then begin
Value := y0;
Result := True;
end
else if Name = sradius then begin
Value := radius;
Result := True;
end
else if Name = sarea then begin
Value := scatter_area;
Result := True;
end
else if Name = szero then begin
Value := zero;
Result := True;
end else if Name = srewrite then begin
Value := rewrite;
Result := True;
end;
end;
function TVariationCircleCrop.GetVariableNameAt(const Index: integer): string;
begin
case Index Of
0: Result := sradius;
1: Result := sx;
2: Result := sy;
3: Result := sarea;
4: Result := szero;
5: Result := srewrite;
else
Result := '';
end;
end;
function TVariationCircleCrop.ResetVariable(const Name: string): boolean;
begin
Result := False;
if Name = sx then begin
x0 := 0;
Result := True;
end
else if Name = sy then begin
y0 := 0;
Result := True;
end
else if Name = sradius then begin
radius := 1;
Result := True;
end
else if Name = sarea then begin
scatter_area := 0;
Result := True;
end
else if Name = szero then begin
zero := 0;
Result := True;
end else if Name = srewrite then begin
rewrite := 1;
Result := True;
end;
end;
function TVariationCircleCrop.SetVariable(const Name: string;
var value: double): boolean;
begin
Result := False;
if Name = sx then begin
x0 := Value;
Result := True;
end
else if Name = sy then begin
y0 := Value;
Result := True;
end
else if Name = sradius then begin
radius := Value;
Result := True;
end
else if Name = sarea then begin
scatter_area := Value;
Result := True;
end
else if Name = szero then begin
if Value < 0 then Value := 0;
if Value > 1 then Value := 1;
zero := Round(Value);
Result := True;
end else if Name = srewrite then begin
if Value < 0 then Value := 0;
if Value > 1 then Value := 1;
rewrite := Round(Value);
Result := True;
end;
end;
///////////////////////////////////////////////////////////////////////////////
initialization
RegisterVariation(TVariationClassLoader.Create(TVariationCircleCrop), true, false);
end.

Some files were not shown because too many files have changed in this diff Show More