Initial commit
This commit is contained in:
commit
25a72c3c86
BIN
Apophysis.res
Normal file
BIN
Apophysis.res
Normal file
Binary file not shown.
238
ApophysisAV.dpr
Normal file
238
ApophysisAV.dpr
Normal 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.
|
||||
|
||||
|
1277
ApophysisAV.dproj
Normal file
1277
ApophysisAV.dproj
Normal file
File diff suppressed because it is too large
Load Diff
BIN
ApophysisAV.res
Normal file
BIN
ApophysisAV.res
Normal file
Binary file not shown.
BIN
ApophysisAV_Icon.ico
Normal file
BIN
ApophysisAV_Icon.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 13 KiB |
190
ColorMap/GradientHlpr.pas
Normal file
190
ColorMap/GradientHlpr.pas
Normal 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.
|
426
ColorMap/cmap.pas
Normal file
426
ColorMap/cmap.pas
Normal 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.
|
||||
|
47946
ColorMap/cmapdata.pas
Normal file
47946
ColorMap/cmapdata.pas
Normal file
File diff suppressed because it is too large
Load Diff
226
Core/BaseVariation.pas
Normal file
226
Core/BaseVariation.pas
Normal 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.
|
94
Core/Bezier.pas
Normal file
94
Core/Bezier.pas
Normal 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.
|
300
Core/Chaotica.pas
Normal file
300
Core/Chaotica.pas
Normal 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.
|
764
Core/Global.pas
Normal file
764
Core/Global.pas
Normal 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.
|
||||
|
1127
Core/Translation.pas
Normal file
1127
Core/Translation.pas
Normal file
File diff suppressed because it is too large
Load Diff
356
Core/XFormMan.pas
Normal file
356
Core/XFormMan.pas
Normal 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.
|
3158
Flame/ControlPoint.pas
Normal file
3158
Flame/ControlPoint.pas
Normal file
File diff suppressed because it is too large
Load Diff
638
Flame/RndFlame.pas
Normal file
638
Flame/RndFlame.pas
Normal 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.
|
2084
Flame/XForm.pas
Normal file
2084
Flame/XForm.pas
Normal file
File diff suppressed because it is too large
Load Diff
5367
Forms/About.dfm
Normal file
5367
Forms/About.dfm
Normal file
File diff suppressed because it is too large
Load Diff
163
Forms/About.pas
Normal file
163
Forms/About.pas
Normal 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.
|
2113
Forms/Adjust.dfm
Normal file
2113
Forms/Adjust.dfm
Normal file
File diff suppressed because it is too large
Load Diff
3526
Forms/Adjust.pas
Normal file
3526
Forms/Adjust.pas
Normal file
File diff suppressed because it is too large
Load Diff
374
Forms/Browser.dfm
Normal file
374
Forms/Browser.dfm
Normal 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
|
602
Forms/Browser.pas
Normal file
602
Forms/Browser.pas
Normal 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.
|
||||
|
131
Forms/Chaos.dfm
Normal file
131
Forms/Chaos.dfm
Normal 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
|
168
Forms/Chaos.pas
Normal file
168
Forms/Chaos.pas
Normal 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.
|
133
Forms/ColorRangeForm.dfm
Normal file
133
Forms/ColorRangeForm.dfm
Normal 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
|
91
Forms/ColorRangeForm.pas
Normal file
91
Forms/ColorRangeForm.pas
Normal 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.
|
125
Forms/Curves.dfm
Normal file
125
Forms/Curves.dfm
Normal 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
|
123
Forms/Curves.pas
Normal file
123
Forms/Curves.pas
Normal 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.
|
5937
Forms/Editor.dfm
Normal file
5937
Forms/Editor.dfm
Normal file
File diff suppressed because it is too large
Load Diff
7659
Forms/Editor.pas
Normal file
7659
Forms/Editor.pas
Normal file
File diff suppressed because it is too large
Load Diff
713
Forms/FormExport.dfm
Normal file
713
Forms/FormExport.dfm
Normal 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
|
302
Forms/FormExport.pas
Normal file
302
Forms/FormExport.pas
Normal 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.
|
||||
|
553
Forms/FormExportC.dfm
Normal file
553
Forms/FormExportC.dfm
Normal 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
|
257
Forms/FormExportC.pas
Normal file
257
Forms/FormExportC.pas
Normal 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.
|
||||
|
338
Forms/FormFavorites.dfm
Normal file
338
Forms/FormFavorites.dfm
Normal 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
|
273
Forms/FormFavorites.pas
Normal file
273
Forms/FormFavorites.pas
Normal 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.
|
||||
|
971
Forms/FormRender.dfm
Normal file
971
Forms/FormRender.dfm
Normal 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
|
1501
Forms/FormRender.pas
Normal file
1501
Forms/FormRender.pas
Normal file
File diff suppressed because it is too large
Load Diff
58
Forms/Fullscreen.dfm
Normal file
58
Forms/Fullscreen.dfm
Normal 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
|
344
Forms/Fullscreen.pas
Normal file
344
Forms/Fullscreen.pas
Normal 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.
|
||||
|
120
Forms/LoadTracker.dfm
Normal file
120
Forms/LoadTracker.dfm
Normal 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
|
105
Forms/LoadTracker.pas
Normal file
105
Forms/LoadTracker.pas
Normal 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.
|
4009
Forms/Main.dfm
Normal file
4009
Forms/Main.dfm
Normal file
File diff suppressed because it is too large
Load Diff
8306
Forms/Main.pas
Normal file
8306
Forms/Main.pas
Normal file
File diff suppressed because it is too large
Load Diff
383
Forms/Mutate.dfm
Normal file
383
Forms/Mutate.dfm
Normal 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
|
634
Forms/Mutate.pas
Normal file
634
Forms/Mutate.pas
Normal 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.
|
||||
|
||||
|
4308
Forms/Options.dfm
Normal file
4308
Forms/Options.dfm
Normal file
File diff suppressed because it is too large
Load Diff
1796
Forms/Options.pas
Normal file
1796
Forms/Options.pas
Normal file
File diff suppressed because it is too large
Load Diff
66
Forms/Preview.dfm
Normal file
66
Forms/Preview.dfm
Normal 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
|
151
Forms/Preview.pas
Normal file
151
Forms/Preview.pas
Normal 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.
|
||||
|
153
Forms/Save.dfm
Normal file
153
Forms/Save.dfm
Normal 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
|
243
Forms/Save.pas
Normal file
243
Forms/Save.pas
Normal 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.
|
||||
|
63
Forms/SavePreset.dfm
Normal file
63
Forms/SavePreset.dfm
Normal 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
|
70
Forms/SavePreset.pas
Normal file
70
Forms/SavePreset.pas
Normal 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.
|
1482
Forms/ScriptForm.dfm
Normal file
1482
Forms/ScriptForm.dfm
Normal file
File diff suppressed because it is too large
Load Diff
5913
Forms/ScriptForm.pas
Normal file
5913
Forms/ScriptForm.pas
Normal file
File diff suppressed because it is too large
Load Diff
40
Forms/ScriptRender.dfm
Normal file
40
Forms/ScriptRender.dfm
Normal 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
|
178
Forms/ScriptRender.pas
Normal file
178
Forms/ScriptRender.pas
Normal 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.
|
||||
|
3638
Forms/SplashForm.dfm
Normal file
3638
Forms/SplashForm.dfm
Normal file
File diff suppressed because it is too large
Load Diff
60
Forms/SplashForm.pas
Normal file
60
Forms/SplashForm.pas
Normal 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.
|
110
Forms/Template.dfm
Normal file
110
Forms/Template.dfm
Normal 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
|
347
Forms/Template.pas
Normal file
347
Forms/Template.pas
Normal 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.
|
132
Forms/Tracer.dfm
Normal file
132
Forms/Tracer.dfm
Normal 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
|
156
Forms/Tracer.pas
Normal file
156
Forms/Tracer.pas
Normal 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.
|
381
Forms/VarOrderForm.dfm
Normal file
381
Forms/VarOrderForm.dfm
Normal 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
|
340
Forms/VarOrderForm.pas
Normal file
340
Forms/VarOrderForm.pas
Normal 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.
|
279
Forms/formPostProcess.dfm
Normal file
279
Forms/formPostProcess.dfm
Normal 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
|
568
Forms/formPostProcess.pas
Normal file
568
Forms/formPostProcess.pas
Normal 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.
|
BIN
HARLOWSI.TTF
Normal file
BIN
HARLOWSI.TTF
Normal file
Binary file not shown.
674
Licence.txt
Normal file
674
Licence.txt
Normal 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>.
|
109
Rendering/BucketFillerThread.pas
Normal file
109
Rendering/BucketFillerThread.pas
Normal 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.
|
860
Rendering/ImageMaker.pas
Normal file
860
Rendering/ImageMaker.pas
Normal 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.
|
386
Rendering/RenderThread.pas
Normal file
386
Rendering/RenderThread.pas
Normal 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.
|
71
Rendering/RenderingCommon.pas
Normal file
71
Rendering/RenderingCommon.pas
Normal 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.
|
792
Rendering/RenderingImplementation.pas
Normal file
792
Rendering/RenderingImplementation.pas
Normal 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.
|
||||
|
1136
Rendering/RenderingInterface.pas
Normal file
1136
Rendering/RenderingInterface.pas
Normal file
File diff suppressed because it is too large
Load Diff
95
System/AsmRandom.pas
Normal file
95
System/AsmRandom.pas
Normal 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.
|
23
System/CurvesControl.dfm
Normal file
23
System/CurvesControl.dfm
Normal 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
|
384
System/CurvesControl.pas
Normal file
384
System/CurvesControl.pas
Normal 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.
|
99
System/CustomDrawControl.pas
Normal file
99
System/CustomDrawControl.pas
Normal 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.
|
BIN
System/LibXmlComps.dcr
Normal file
BIN
System/LibXmlComps.dcr
Normal file
Binary file not shown.
122
System/LibXmlComps.pas
Normal file
122
System/LibXmlComps.pas
Normal 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.
|
||||
|
2719
System/LibXmlParser.pas
Normal file
2719
System/LibXmlParser.pas
Normal file
File diff suppressed because it is too large
Load Diff
90
System/RegexHelper.pas
Normal file
90
System/RegexHelper.pas
Normal 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.
|
633
System/sdStringTable.pas
Normal file
633
System/sdStringTable.pas
Normal 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.
|
325
Variations/varAffine3D.pas
Normal file
325
Variations/varAffine3D.pas
Normal 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.
|
119
Variations/varArch.pas
Normal file
119
Variations/varArch.pas
Normal 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.
|
176
Variations/varAuger.pas
Normal file
176
Variations/varAuger.pas
Normal 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.
|
152
Variations/varBent2.pas
Normal file
152
Variations/varBent2.pas
Normal 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.
|
163
Variations/varBipolar.pas
Normal file
163
Variations/varBipolar.pas
Normal 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.
|
61
Variations/varBlade.pas
Normal file
61
Variations/varBlade.pas
Normal 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.
|
131
Variations/varBlob.pas
Normal file
131
Variations/varBlob.pas
Normal 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.
|
154
Variations/varBlurCircle.pas
Normal file
154
Variations/varBlurCircle.pas
Normal 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.
|
153
Variations/varBlurPixelize.pas
Normal file
153
Variations/varBlurPixelize.pas
Normal 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.
|
144
Variations/varBlurZoom.pas
Normal file
144
Variations/varBlurZoom.pas
Normal 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.
|
188
Variations/varBoarders2.pas
Normal file
188
Variations/varBoarders2.pas
Normal 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.
|
160
Variations/varButterfly.pas
Normal file
160
Variations/varButterfly.pas
Normal 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.
|
238
Variations/varBwraps.pas
Normal file
238
Variations/varBwraps.pas
Normal 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.
|
233
Variations/varCircleCrop.pas
Normal file
233
Variations/varCircleCrop.pas
Normal 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
Loading…
Reference in New Issue
Block a user