Apophysis-AV/Forms/Main.pas

8307 lines
253 KiB
ObjectPascal
Raw Normal View History

2022-03-08 12:25:51 -05:00
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
//{$D-,L-,O+,Q-,R-,Y-,S-}
unit Main;
//{$define VAR_STR}
interface
uses
Windows, Forms, Dialogs, Menus, Controls, ComCtrls,
ToolWin, StdCtrls, Classes, Messages, ExtCtrls, ImgList,
Jpeg, SyncObjs, SysUtils, Graphics, Math,
ExtDlgs, AppEvnts, ShellAPI, Registry, Curves,
Global, Xform, XFormMan, ControlPoint, CMap,
RenderThread, RenderingCommon, RenderingInterface,
LibXmlParser, LibXmlComps, Vcl.Imaging.PngImage, XPMan,
StrUtils, LoadTracker, CheckLst,
CommandLine, RegularExpressionsCore, Translation,
RegexHelper, System.ImageList, Vcl.Themes, Vcl.Styles; // AV
const
PixelCountMax = 32768;
RS_A1 = 0;
RS_DR = 1;
RS_XO = 2;
RS_VO = 3;
{$ifndef Apo7X64}
randFilename = 'ApophysisAV.rand';
undoFilename = 'ApophysisAV.undo';
{$else}
randFilename = 'ApophysisAV_64.rand'; // AV
undoFilename = 'ApophysisAV_64.undo'; // AV
{$endif}
templateFilename = 'ApophysisAV.temp';
templatePath = '\templates';
scriptPath = '\scripts';
type
TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove,
msZoomOutWindowMove, msDrag, msDragMove, msRotate, msRotateMove, msPitchYaw, msHeight);
type
TWin32Version = (wvUnknown, wvWin95, wvWin98, wvWinNT, wvWin2000, wvWinXP,
wvWinVista, wvWin7, wvWinFutureFromOuterSpace);
type
TThumbnailThread = class(TThread)
private
FCount: integer;
class var
FPreviewDensity: double; // AV
FThumbnailSize : integer; // AV: added F to avoid of name conflicts
public
constructor Create;
procedure Execute; override;
destructor Destroy; override;
end;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
TMainForm = class(TForm)
Buttons: TImageList;
MainMenu: TMainMenu;
MainFile: TMenuItem;
mnuSaveUPR: TMenuItem;
N1: TMenuItem;
mnuRandomBatch: TMenuItem;
FileExitSep: TMenuItem;
mnuExit: TMenuItem;
MainEdit: TMenuItem;
mnuCopyUPR: TMenuItem;
mnuEditor: TMenuItem;
mnuRandom: TMenuItem;
mnuNormalWeights: TMenuItem;
mnuEqualize: TMenuItem;
mnuRWeights: TMenuItem;
mnuOptions: TMenuItem;
MainHelp: TMenuItem;
mnuHelpTopics: TMenuItem;
OpenDialog: TOpenDialog;
ListPopUp: TPopupMenu;
mnuItemDelete: TMenuItem;
mnuListRename: TMenuItem;
DisplayPopup: TPopupMenu;
mnuPopFullscreen: TMenuItem;
RedrawTimer: TTimer;
mnuVar: TMenuItem;
mnuVRandom: TMenuItem;
N3: TMenuItem;
mnuOpen: TMenuItem;
mnuSaveAs: TMenuItem;
N8: TMenuItem;
mnuGrad: TMenuItem;
mnuSmoothGradient: TMenuItem;
mnuView: TMenuItem;
mnuToolbar: TMenuItem;
mnuStatusBar: TMenuItem;
BackPanel: TPanel;
mnuFileContents: TMenuItem;
mnuUndo: TMenuItem;
mnuRedo: TMenuItem;
N5: TMenuItem;
SaveDialog: TSaveDialog;
MainFlame: TMenuItem;
N11: TMenuItem;
mnuAbout: TMenuItem;
mnuFullScreen: TMenuItem;
mnuRender: TMenuItem;
mnuMutate: TMenuItem;
mnuAdjust: TMenuItem;
mnuOpenGradient: TMenuItem;
mnuResetLocation: TMenuItem;
N4: TMenuItem;
N14: TMenuItem;
mnuSaveUndo: TMenuItem;
N2: TMenuItem;
mnuPopResetLocation: TMenuItem;
N6: TMenuItem;
mnuPopUndo: TMenuItem;
N16: TMenuItem;
mnuPopRedo: TMenuItem;
mnuCalculateColors: TMenuItem;
mnuRandomizeColorValues: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
mnuScript: TMenuItem;
mnuRun: TMenuItem;
mnuEditScript: TMenuItem;
N15: TMenuItem;
mnuStop: TMenuItem;
mnuOpenScript: TMenuItem;
mnuImportGimp: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
mnuManageFavorites: TMenuItem;
mnuImageSize: TMenuItem;
N13: TMenuItem;
ApplicationEvents: TApplicationEvents;
mnuPaste: TMenuItem;
mnuCopy: TMenuItem;
N20: TMenuItem;
mnuExportFLame: TMenuItem;
mnuFlamepdf: TMenuItem;
mnuSaveAllAs: TMenuItem;
View1: TMenuItem;
mnuRenderAll: TMenuItem;
mnuBuiltinVars: TMenuItem;
mnuPluginVars: TMenuItem;
UsedThumbnails: TImageList;
Image1: TImage;
Splitter: TSplitter;
ListBackPanel: TPanel;
Shape1: TShape;
ListView1: TListView;
cbMain: TCoolBar;
ToolBar: TToolBar;
btNew: TToolButton;
btnOpen: TToolButton;
btnSave: TToolButton;
ToolButton10: TToolButton;
btnRender: TToolButton;
tbRenderAll: TToolButton;
ToolButton9: TToolButton;
btnViewList: TToolButton;
btnViewIcons: TToolButton;
ToolButton2: TToolButton;
btnUndo: TToolButton;
btnRedo: TToolButton;
ToolButton1: TToolButton;
btnReset: TToolButton;
btnFullScreen: TToolButton;
ToolButton3: TToolButton;
tbQualityBox: TComboBoxEx;
New1: TMenuItem;
ColorDialog: TColorDialog;
mnuResetUI: TMenuItem;
ToolButton4: TToolButton;
tbEditor: TToolButton;
tbAdjust: TToolButton;
tbPalette: TToolButton;
tbMutate: TToolButton;
tbImageSize: TToolButton;
tbMessages: TToolButton;
tbOptions: TToolButton;
ToolButton15: TToolButton;
tbShowAlpha: TToolButton;
ToolButton16: TToolButton;
tbEditScript: TToolButton;
btnRunScript: TToolButton;
btnStopScript: TToolButton;
ToolButton18: TToolButton;
tbDrag: TToolButton;
tbRotate: TToolButton;
tbZoomIn: TToolButton;
tbZoomOut: TToolButton;
AutoSaveTimer: TTimer;
Restorelastautosave1: TMenuItem;
tbGuides: TToolButton;
mnuTurnFlameToScript: TMenuItem;
N12: TMenuItem;
mnuReportFlame: TMenuItem;
mnuMessages: TMenuItem;
BottomDock: TPanel;
StatusBar: TStatusBar;
Image: TImage;
pnlLSPFrame: TPanel;
LoadSaveProgress: TProgressBar;
mnuExportChaotica: TMenuItem;
mnuResumeRender: TMenuItem;
mnuManual: TMenuItem;
tbCurves: TToolButton;
mnuCurves: TMenuItem;
N17: TMenuItem;
mnuTrace: TMenuItem;
CalculateWeights: TMenuItem;
FavouriteScripts1: TMenuItem;
Directory1: TMenuItem;
Randomizecolorspeed1: TMenuItem;
Calculatecolorspeed1: TMenuItem;
Changecolordistribution1: TMenuItem;
Changeweightdistribution1: TMenuItem;
ResetColorSpeed: TMenuItem;
mnuApoStyle: TMenuItem; // AV
N7: TMenuItem;
N22: TMenuItem;
AddSymmetry: TMenuItem;
BilateralSym: TMenuItem;
RotationalSym: TMenuItem;
DihedralSym: TMenuItem;
rot2: TMenuItem;
rot3: TMenuItem;
rot4: TMenuItem;
rot5: TMenuItem;
rot6: TMenuItem;
rot8: TMenuItem;
dih2: TMenuItem;
dih3: TMenuItem;
dih4: TMenuItem;
dih5: TMenuItem;
dih6: TMenuItem;
dih8: TMenuItem;
AddTile: TMenuItem; // AV
Square1: TMenuItem;
Rhombic1: TMenuItem;
Hexagonal1: TMenuItem;
ImportFromPNG: TMenuItem;
ToolButton23: TToolButton;
mnuScreenShot: TMenuItem;
N23: TMenuItem;
rot7: TMenuItem;
dih7: TMenuItem;
AddTemplate: TMenuItem;
N21: TMenuItem;
ResetColorValues: TMenuItem;
mnuExportBitmap: TMenuItem;
N24: TMenuItem;
mnuUnflatten: TMenuItem; // AV
mnuFlatten: TMenuItem;
N25: TMenuItem;
SortFlames: TMenuItem;
N26: TMenuItem;
mnuLowQuality: TMenuItem;
mnuMediumQuality: TMenuItem;
mnuHighQuality: TMenuItem;
mnuRefreshThumb: TMenuItem;
EnumerateFlames: TMenuItem;
DownloadPlugins: TMenuItem;
N27: TMenuItem;
mnuRefreshAllThumbs: TMenuItem; // AV
procedure mnuManualClick(Sender: TObject);
procedure mnuReportFlameClick(Sender: TObject);
procedure mnuTurnFlameToScriptClick(Sender: TObject);
procedure tbzoomoutwindowClick(Sender: TObject);
procedure mnuExitClick(Sender: TObject);
procedure mnuSaveUPRClick(Sender: TObject);
procedure ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormCreate(Sender: TObject);
procedure mnuRandomClick(Sender: TObject);
procedure mnuEqualizeClick(Sender: TObject);
procedure mnuEditorClick(Sender: TObject);
procedure mnuRWeightsClick(Sender: TObject);
procedure mnuRandomBatchClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormKeyUpDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure mnuOptionsClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mnuHelpTopicsClick(Sender: TObject);
procedure mnuRefreshClick(Sender: TObject);
procedure mnuNormalWeightsClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mnuCopyUPRClick(Sender: TObject);
procedure mnuItemDeleteClick(Sender: TObject);
procedure ListViewEdited(Sender: TObject; Item: TListItem;
var S: string);
procedure mnuListRenameClick(Sender: TObject);
procedure BackPanelResize(Sender: TObject);
procedure mnuNextClick(Sender: TObject);
procedure mnuPreviousClick(Sender: TObject);
procedure RedrawTimerTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ShowStyledWindows(Sender: TObject);
procedure MainMenuClick(Sender: TObject);
procedure mnuVRandomClick(Sender: TObject);
procedure mnuSaveAsClick(Sender: TObject);
procedure mnuOpenClick(Sender: TObject);
procedure mnuGradClick(Sender: TObject);
procedure mnuSmoothGradientClick(Sender: TObject);
procedure mnuToolbarClick(Sender: TObject);
procedure mnuStatusBarClick(Sender: TObject);
procedure mnuFileContentsClick(Sender: TObject);
procedure mnuUndoClick(Sender: TObject);
procedure mnuRedoClick(Sender: TObject);
procedure Undo;
procedure Redo;
procedure mnuSaveUndoClick(Sender: TObject); // AV: restored and works
procedure mnuExportBitmapClick(Sender: TObject); // AV: to fast save params in PNG
procedure mnuFullScreenClick(Sender: TObject);
procedure mnuRenderClick(Sender: TObject);
procedure mnuMutateClick(Sender: TObject);
procedure mnuAdjustClick(Sender: TObject);
procedure mnuResetLocationClick(Sender: TObject);
procedure mnuAboutClick(Sender: TObject);
procedure mnuOpenGradientClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormActivate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure mnuCalculateColorsClick(Sender: TObject);
procedure mnuRandomizeColorValuesClick(Sender: TObject);
procedure mnuEditScriptClick(Sender: TObject);
procedure mnuRunClick(Sender: TObject);
procedure mnuOpenScriptClick(Sender: TObject);
procedure mnuStopClick(Sender: TObject);
// procedure mnuImportGimpClick(Sender: TObject); // AV: rudiment from Apo 2.02
procedure mnuManageFavoritesClick(Sender: TObject);
procedure mnuShowFullClick(Sender: TObject);
procedure mnuImageSizeClick(Sender: TObject);
procedure ApplicationEventsActivate(Sender: TObject);
procedure mnuPasteClick(Sender: TObject);
procedure mnuCopyClick(Sender: TObject);
procedure mnuExportFlameClick(Sender: TObject);
procedure mnuExportChaoticaClick(Sender: TObject);
procedure ListXmlScannerStartTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
procedure XMLScannerStartTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
procedure XMLScannerEmptyTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
procedure mnuFlamepdfClick(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure tbzoomwindowClick(Sender: TObject);
procedure tbDragClick(Sender: TObject);
procedure tbRotateClick(Sender: TObject);
procedure mnuSaveAllAsClick(Sender: TObject);
procedure tbQualityBoxKeyPress(Sender: TObject; var Key: Char);
procedure tbQualityBoxSet(Sender: TObject);
procedure ImageDblClick(Sender: TObject);
procedure tbShowAlphaClick(Sender: TObject);
procedure tbShowTraceClick(Sender: TObject);
procedure XmlScannerContent(Sender: TObject; Content: String);
procedure mnuRenderAllClick(Sender: TObject);
{ procedure ListViewChanging(Sender: TObject; Item: TListItem;
Change: TItemChange; var AllowChange: Boolean); }
procedure btnViewIconsClick(Sender: TObject);
procedure btnViewListClick(Sender: TObject);
procedure XmlScannerEndTag(Sender: TObject; TagName: String);
procedure tbMessagesClick(Sender: TObject);
procedure btNewClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure mnuResetUIClick(Sender: TObject);
procedure AutoSaveTimerTimer(Sender: TObject);
procedure Restorelastautosave1Click(Sender: TObject);
procedure tbGuidesClick(Sender: TObject);
procedure tbCurvesClick(Sender: TObject);
procedure mnuTraceClick(Sender: TObject);
procedure CalculateWeightsClick(Sender: TObject);
procedure Randomizecolorspeed1Click(Sender: TObject);
procedure Calculatecolorspeed1Click(Sender: TObject);
procedure ResetColorSpeedClick(Sender: TObject);
procedure AddSymmetryClick(Sender: TObject); //AV
procedure AddTileClick(Sender: TObject); // AV
procedure ImportFromPNGClick(Sender: TObject); // AV
procedure mnuScreenShotClick(Sender: TObject); // AV
procedure ExtSysMenu(var Msg: TMessage); message WM_SysCommand; // AV
procedure AddTemplateClick(Sender: TObject);
procedure ResetColorValuesClick(Sender: TObject);
procedure mnuUnflattenClick(Sender: TObject);
procedure mnuFlattenClick(Sender: TObject);
procedure SortFlamesClick(Sender: TObject);
procedure ListViewColumnClick(Sender: TObject; Column: TListColumn);
procedure mnuThumbnailQualityClick(Sender: TObject);
procedure ListPopUpPopup(Sender: TObject);
procedure mnuRefreshThumbClick(Sender: TObject);
procedure EnumerateFlamesClick(Sender: TObject);
procedure ListViewDblClick(Sender: TObject);
procedure DownloadPluginsClick(Sender: TObject);
private
SubstSource: TStringList;
SubstTarget: TStringList;
Renderer: TRenderThread;
FMouseMoveState: TMouseMoveState;
FSelectRect, FClickRect: TRect;
DrawSelection: boolean;
FRotateAngle: double;
FClickAngle: double;
FViewImage: TPngObject;
FViewPos, FViewOldPos: TSPoint;
FViewScale: double;
// FClickPitch, FNewPitch: double;
// FClickYaw, FNewYaw: double;
FShiftState: TShiftState;
// For parsing:
FinalXformLoaded: boolean;
ActiveXformSet: integer;
XMLPaletteFormat: string;
XMLPaletteCount: integer;
camDragMode, camDragged, camMM: boolean;
camDragPos, camDragOld: TPoint;
camDragValueX, camDragValueY: double;
oldApo: boolean; // AV: to check relict variations
defKB: HKL; // AV: for non-English users :)
procedure CreateSubstMap;
procedure InsertStrings;
procedure DrawImageView;
procedure DrawZoomWindow;
procedure DrawRotatelines(Angle: double);
// procedure DrawPitchYawLines(YawAngle: double; PitchAngle:double);
procedure FillVariantMenu;
procedure VariantMenuClick(Sender: TObject);
procedure FavoriteClick(Sender: TObject);
procedure ScriptItemClick(Sender: TObject);
// AV: for Apo GUI themes
procedure CreateStyleList;
procedure StyleItemClick(Sender: TObject);
procedure HandleThreadCompletion(var Message: TMessage);
message WM_THREAD_COMPLETE;
procedure HandleThreadTermination(var Message: TMessage);
message WM_THREAD_TERMINATE;
public
{ Public declarations }
UndoIndex, UndoMax: integer;
Center: array[0..1] of double;
//MainZoom: double;
StartTime: TDateTime;
CurrentFileName: string;
ParseLoadingBatch : boolean;
SurpressHandleMissingPlugins : boolean;
VarMenus: array of TMenuItem;
ListXmlScanner : TEasyXmlScanner;
XmlScanner : TXmlScanner;
function ReadWithSubst(Attributes: TAttrList; attrname: string): string;
procedure InvokeLoadXML(xmltext:string);
// AV: added 3-rd parameter to be able to discard multiple updates
procedure LoadXMLFlame(filename, name: string; upd: boolean = true);
procedure DisableFavorites;
procedure EnableFavorites;
procedure ParseXML(var cp1: TControlPoint; const params: string; const ignoreErrors : boolean);
function SaveFlame(cp1: TControlPoint; title, filename: string): boolean;
function SaveXMLFlame(const cp1: TControlPoint; title, filename: string): boolean;
procedure DisplayHint(Sender: TObject);
procedure OnProgress(prog: double);
procedure ResizeImage;
procedure DrawPreview;
procedure DrawFlame;
procedure UpdateUndo;
procedure LoadUndoFlame(index: integer; filename: string);
procedure SmoothPalette;
procedure Smoothize(const oldpal: TColorMap; const a, b: byte);
procedure RandomizeCP(var cp1: TControlPoint; alg: integer = 0);
function UPRString(cp1: TControlPoint; Entry: string): string;
function SaveGradient(Gradient, Title, FileName: string): boolean;
function GradientFromPalette(const pal: TColorMap; const title: string): string;
procedure StopThread;
procedure UpdateWindows;
procedure ResetLocation;
procedure RandomBatch;
procedure GetScripts;
function ApplicationOnHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
function SystemErrorMessage: string;
function SystemErrorMessage2(errno: cardinal): string;
function RetrieveXML(cp : TControlPoint):string;
procedure ApplyThemedColors;
// AV: for reading / writing embedded parameters
procedure PasteFlameXML(flameXML: string);
procedure ImportThumbnailPNG(Filename: string);
function LoadXMLFlameTextPNG(FileName: string): string;
// AV: for updating the list with flame previews
procedure SetThumbnailProperties;
procedure RefreshThumbnail;
procedure UpdateThumbnails;
end;
procedure ListXML(FileName: string; sel: integer; selname: string = ''); // AV
function EntryExists(En, Fl: string): boolean;
function XMLEntryExists(title, filename: string): boolean;
function DeleteEntry(Entry, FileName: string): boolean;
function CleanIdentifier(ident: string): string;
function CleanUPRTitle(ident: string): string;
function GradientString(c: TColorMap): string;
procedure ListFlames(FileName: string; sel: integer); // AV: outdated, for affine coefs only
procedure ListIFS(FileName: string; sel: integer); // AV: for loading Undo flame files
procedure NormalizeVariations(var cp1: TControlPoint);
function GetWinVersion: TWin32Version;
function LoadXMLFlameText(filename, name: string) : string;
function FindFlameXML(const FlameStr: string; const Title: string) : Integer; // AV
function FlameInClipboard: boolean; // AV
function RemoveExt(filename: string): string; // AV
// AV: for making window screenshots
procedure GetFormScreenShot(const AFileName: string);
procedure SaveScreenShot(const AFormName: string);
var
MainForm: TMainForm;
pname, ptime: String;
//pversion: string;
nxform: integer;
TbBreakWidth: integer;
MainCp: TControlPoint;
ParseCp: TControlPoint;
MemCp: TControlPoint;
CurrentFlame, FlameString: string;
ThumbnailSize: integer;
AboutToExit: boolean;
GeneratingThumbs: boolean; // AV
ApophysisSVN: string; //APP_VERSION;
AppVersionString: string; //APP_NAME+'.'+ APP_VERSION;
implementation
uses
ClipBrd, Editor, Options, Settings, Template, MissingPlugin, Base64, Chaotica,
FullScreen, FormRender, Mutate, Adjust, Browser, Save, About, CmapData,
ScriptForm, FormFavorites, FormExport, RndFlame, Tracer, Types, SplashForm;
{$R *.DFM}
procedure AssignBitmapProperly(var Bitmap:TBitmap; Source:TBitmap);
begin
Bitmap.Dormant;
Bitmap.FreeImage;
Bitmap.Width := 0;
Bitmap.Assign(Source);
end;
procedure FreeBitmapProperly(var Bitmap:TBitmap);
begin
try
Bitmap.Dormant;
Bitmap.FreeImage;
finally
Bitmap.Free;
end;
end;
{//////////////// Screenshot utils ////////////////////////}
procedure GetFormScreenShot(const AFileName: string); // AV
var
ScreenShot: TBitmap;
WindowRect: TRect;
begin
ScreenShot := TBitmap.Create;
try
ScreenShot.PixelFormat := pf32bit;
try
WindowRect := Screen.ActiveForm.BoundsRect;
ScreenShot.Width := WindowRect.Width;
ScreenShot.Height := WindowRect.Height;
BitBlt(ScreenShot.Canvas.Handle, 0, 0, WindowRect.Width, WindowRect.Height,
GetWindowDC(Screen.ActiveForm.Handle), 0, 0, SRCCOPY);
except
ScreenShot := nil;
end;
if ScreenShot <> nil then
ScreenShot.SaveToFile(AFileName);
finally
ScreenShot.Free;
end;
end;
procedure SaveScreenShot(const AFormName: string); // AV
var
s: string;
begin
if not DirectoryExists(ScreenShotPath) then
begin
CreateDir(AppPath + 'ScreenShots\');
ScreenShotPath := AppPath + 'ScreenShots\';
end;
s := ScreenShotPath + AFormName + FormatDateTime(' (MM-dd-yyyy hh-mm-ss)', Now) + '.bmp';
try
GetFormScreenShot(s);
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 NormalizeVariations(var cp1: TControlPoint);
var
totvar, v: double;
i, j: integer;
begin
for i := 0 to NXFORMS - 1 do
begin
totvar := 0;
for j := 0 to NRVAR - 1 do
begin
v := cp1.xform[i].GetVariation(j); // AV
if v < 0 then
cp1.xform[i].SetVariation(j, -v);
totvar := totvar + v;
end;
if totVar = 0 then
begin
cp1.xform[i].SetVariation(0, 1)
end
else
for j := 0 to NRVAR - 1 do begin
if totVar <> 0 then
cp1.xform[i].SetVariation(j, cp1.xform[i].GetVariation(j) / totvar);
end;
end;
end;
function FlameInClipboard: boolean;
var
flamestr: string;
isstart, isend: integer;
begin
{ returns true if a flame in clipboard - can be tricked }
result := false;
if Clipboard.HasFormat(CF_TEXT) then
begin
flamestr := Clipboard.AsText;
isstart := Pos('<flame', flamestr);
isend := Pos('</flame>', flamestr);
if (isstart > 0) and (isend > 0) and (isstart < isend) then
Result := true;
end;
end;
function GetWinVersion: TWin32Version;
{ Returns current version of a host Win32 platform }
begin
Result := wvUnknown;
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
if (Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)) then
Result := wvWin98
else
Result := wvWin95
else
if Win32MajorVersion <= 4 then
Result := wvWinNT
else if Win32MajorVersion = 5 then
begin // AV
if Win32MinorVersion = 0 then
Result := wvWin2000
else if Win32MinorVersion >= 1 then
Result := wvWinXP
end
else if Win32MajorVersion = 6 then
begin // AV
if Win32MinorVersion = 0 then
Result := wvWinVista
else if Win32MinorVersion >= 1 then
Result := wvWin7
end
else if Win32MajorVersion >= 7 then
Result := wvWinFutureFromOuterSpace;
end;
{ ************************************* Help ********************************* }
procedure ShowHelp(Pt: TPoint; ContextId: Integer);
//var
//Popup: THHPopup;
begin
(* -X- context help not longer supported
FillChar(Popup, SizeOf(Popup), 0);
Popup.cbStruct := SizeOf(Popup);
Popup.hinst := 0;
Popup.idString := ContextId;
Popup.pszText := nil;
GetCursorPos(Pt);
Popup.pt := Pt;
Popup.clrForeGround := TColorRef(-1);
Popup.clrBackground := TColorRef(-1);
Popup.rcMargins := Rect(-1, -1, -1, -1);
Popup.pszFont := '';
HtmlHelp(0, PChar(AppPath + 'Apophysis7x.chm::/Popups.txt'), HH_DISPLAY_TEXT_POPUP, DWORD(@Popup));
*)
end;
procedure TMainForm.ExtSysMenu(var Msg: TMessage);
begin
if Msg.WParam = $C0 then mnuScreenShot.Click;
inherited;
end;
(*
procedure TMainForm.RebuildListView;
var
i: integer;
item: TListItem;
begin
ListView.Items.Clear;
/// backup in old lv
for i := 0 to ListView1.Items.Count-1 do begin
item := ListView.Items.Add;
item.Caption := ListView1.Items[i].Caption;
end;
// rebuild new lv
ListView1.Items.Clear;
for i := 0 to ListView.Items.Count-1 do begin
item := ListView1.Items.Add;
item.Caption := ListView.Items[i].Caption;
if (not ClassicListMode) then item.ImageIndex := i;
end;
ListView.Items.Clear;
end;
*)
procedure TMainForm.InsertStrings;
begin
mnuCopy.Caption := TextByKey('common-copy');
mnuPaste.Caption := TextByKey('common-paste');
mnuCopy.Hint := TextByKey('main-menu-edit-copy');
mnuPaste.Hint := TextByKey('main-menu-edit-paste');
mnuItemDelete.Caption := TextByKey('common-delete');
mnuListRename.Caption := TextByKey('common-rename');
mnuItemDelete.Hint := TextByKey('main-menu-deletehint'); // AV
mnuListRename.Hint := TextByKey('main-menu-renamehint'); // AV
mnuRefreshThumb.Caption := TextByKey('main-menu-updatethumb');
mnuRefreshAllThumbs.Caption := TextByKey('main-menu-updateallthumbs');
mnuLowQuality.Caption := TextByKey('common-lowquality'); // AV
mnuMediumQuality.Caption := TextByKey('common-mediumquality'); // AV
mnuHighQuality.Caption := TextByKey('common-highquality'); // AV
mnuUndo.Caption := TextByKey('common-undo');
mnuPopUndo.Caption := TextByKey('common-undo');
btnUndo.Hint := TextByKey('main-toolbar-undo');
mnuUndo.Hint := TextByKey('main-toolbar-undo');
mnuRedo.Caption := TextByKey('common-redo');
mnuPopRedo.Caption := TextByKey('common-redo');
btnRedo.Hint := TextByKey('main-toolbar-redo');
mnuRedo.Hint := TextByKey('main-toolbar-redo');
MainFile.Caption := TextByKey('main-menu-file-title');
New1.Caption := TextByKey('main-menu-file-new');
New1.Hint := TextByKey('main-toolbar-new');
mnuTrace.Caption := TextByKey('main-menu-options-tracelog');
btNew.Hint := TextByKey('main-toolbar-new');
mnuOpen.Caption := TextByKey('main-menu-file-open');
btnOpen.Hint := TextByKey('main-toolbar-open');
mnuOpen.Hint := TextByKey('main-toolbar-open');
ImportFromPNG.Caption := TextByKey('main-menu-file-loadpng');
ImportFromPNG.Hint := TextByKey('main-menu-file-loadpnghint');
mnuScreenShot.Caption := TextByKey('main-menu-screenshot');
RestoreLastAutosave1.Caption := TextByKey('main-menu-file-restoreautosave');
RestoreLastAutosave1.Hint := TextByKey('main-menu-file-autosavehint');
mnuSaveAs.Caption := TextByKey('main-menu-file-saveparams');
mnuSaveAs.Hint := TextByKey('main-toolbar-saveparams');
btnSave.Hint := TextByKey('main-toolbar-saveparams');
mnuSaveAllAs.Caption := TextByKey('main-menu-file-saveallparams');
mnuSaveAllAs.Hint := TextByKey('main-menu-file-saveallhint');
mnuSmoothGradient.Caption := TextByKey('main-menu-file-smoothpalette');
mnuSmoothGradient.Hint := TextByKey('main-menu-file-smoothpalettehint');
mnuOpenGradient.Caption := TextByKey('main-menu-file-gradientbrowser');
mnuOpenGradient.Hint := TextByKey('main-menu-file-gradientbrowserhint');
mnuSaveUPR.Caption := TextByKey('main-menu-file-exportupr');
mnuExportFlame.Caption := TextByKey('main-menu-file-exportflame');
mnuExportChaotica.Caption := TextByKey('main-menu-file-exportchaotica');
// mnuImportGimp.Caption := TextByKey('main-menu-file-importgimp');
// mnuImportGimp.Hint := TextByKey('main-menu-file-importgimphint');
mnuRandomBatch.Caption := TextByKey('main-menu-file-randombatch');
mnuExit.Caption := TextByKey('main-menu-file-exit');
mnuExit.Hint := TextByKey('main-menu-file-exithint');
mnuSaveUPR.Hint := TextByKey('main-menu-file-exportuprhint');
mnuExportFlame.Hint := TextByKey('main-menu-file-exportflamehint');
mnuExportChaotica.Hint := TextByKey('main-menu-file-exportchaoticahint');
mnuExportBitmap.Caption := TextByKey('main-menu-saveimage'); // AV
mnuRandomBatch.Hint := TextByKey('main-menu-file-randombatchhint');
MainEdit.Caption := TextByKey('main-menu-edit-title');
mnuSaveUndo.Caption := TextByKey('main-menu-edit-saveundo');
mnuCopyUPR.Caption := TextByKey('main-menu-edit-copyasupr');
mnuCopyUPR.Hint := TextByKey('main-menu-edit-copyuprhint');
View1.Caption := TextByKey('main-menu-view-title');
mnuFullScreen.Caption := TextByKey('main-menu-view-fullscreen');
mnuPopFullscreen.Caption := TextByKey('main-menu-view-fullscreen');
btnFullScreen.Hint := TextByKey('main-toolbar-fullscreen');
mnuFullScreen.Hint := TextByKey('main-toolbar-fullscreen');
mnuEditor.Caption := TextByKey('main-menu-view-editor');
mnuEditor.Hint := TextByKey('main-toolbar-editor');
tbEditor.Hint := TextByKey('main-toolbar-editor');
mnuAdjust.Caption := TextByKey('main-menu-view-adjustment');
mnuAdjust.Hint := TextByKey('main-toolbar-adjustment');
tbAdjust.Hint := TextByKey('main-toolbar-adjustment');
mnuGrad.Caption := TextByKey('main-menu-view-gradient');
mnuGrad.Hint := TextByKey('main-toolbar-gradient');
tbPalette.Hint := TextByKey('main-toolbar-gradient');
mnuMutate.Hint := TextByKey('main-toolbar-mutation');
mnuMutate.Caption := TextByKey('main-menu-view-mutation');
tbMutate.Hint := TextByKey('main-toolbar-mutation');
mnuImageSize.Caption := TextByKey('main-menu-view-imagesize');
mnuImageSize.Hint := TextByKey('main-toolbar-imagesize');
tbImageSize.Hint := TextByKey('main-toolbar-imagesize');
mnuMessages.Caption := TextByKey('main-menu-view-messages');
mnuMessages.Hint := TextByKey('main-toolbar-messages');
tbMessages.Hint := TextByKey('main-toolbar-messages');
tbCurves.Hint := TextByKey('main-toolbar-curves');
mnuCurves.Hint := TextByKey('main-toolbar-curves');
mnuCurves.Caption := TextByKey('main-menu-view-curves');
MainFlame.Caption := TextByKey('main-menu-flame-title');
mnuResetLocation.Caption := TextByKey('main-menu-flame-reset');
mnuPopResetLocation.Caption := TextByKey('main-menu-flame-reset');
mnuResetLocation.Hint := TextByKey('main-toolbar-reset');
btnReset.Hint := TextByKey('main-toolbar-reset');
mnuRandom.Caption := TextByKey('main-menu-flame-randomize');
mnuRandom.Hint := TextByKey('main-menu-flame-randomizehint');
mnuRWeights.Caption := TextByKey('main-menu-flame-randomweights');
mnuRWeights.Hint := TextByKey('main-menu-flame-randomweightshint');
mnuEqualize.Caption := TextByKey('main-menu-flame-equalweights');
mnuEqualize.Hint := TextByKey('main-menu-flame-equalweightshint');
CalculateWeights.Caption := TextByKey('main-menu-flame-calculateweights');
CalculateWeights.Hint := TextByKey('main-menu-flame-calculateweightshint');
mnuNormalWeights.Caption := TextByKey('main-menu-flame-normweights');
mnuNormalWeights.Hint := TextByKey('main-menu-flame-normweightshint');
mnuCalculateColors.Caption := TextByKey('main-menu-flame-calculatecolors');
mnuRandomizeColorValues.Caption := TextByKey('main-menu-flame-randomizecolors');
Calculatecolorspeed1.Caption := TextByKey('main-menu-flame-calculatecolorspeed');
Randomizecolorspeed1.Caption := TextByKey('main-menu-flame-randomizecolorspeed');
ResetColorSpeed.Caption := TextByKey('main-menu-flame-resetcolorspeed');
ResetColorValues.Caption := TextByKey('main-menu-flame-resetcolors');
ResetColorValues.Hint := TextByKey('main-menu-flame-resetcolorshint');
mnuCalculateColors.Hint := TextByKey('main-menu-flame-calccolorshint');
mnuRandomizeColorValues.Hint := TextByKey('main-menu-flame-randcolorshint');
Calculatecolorspeed1.Hint := TextByKey('main-menu-flame-calccolorspeedhint');
Randomizecolorspeed1.Hint := TextByKey('main-menu-flame-randcolorspeedhint');
Resetcolorspeed.Hint := TextByKey('main-menu-flame-resetcolorspeedhint');
mnuFlatten.Caption := TextByKey('main-menu-flame-flatten');
mnuFlatten.Hint := TextByKey('main-menu-flame-flattenhint');
mnuUnflatten.Caption := TextByKey('main-menu-flame-unflatten');
mnuUnflatten.Hint := TextByKey('main-menu-flame-unflattenhint');
mnuRender.Caption := TextByKey('main-menu-flame-rendertodisk');
mnuRender.Hint := TextByKey('main-toolbar-render');
btnRender.Hint := TextByKey('main-toolbar-render');
mnuRenderAll.Caption := TextByKey('main-menu-flame-renderallflames');
mnuRenderAll.Hint := TextByKey('main-toolbar-renderall');
tbRenderAll.Hint := TextByKey('main-toolbar-renderall');
mnuReportFlame.Caption := TextByKey('main-menu-flame-generatereport');
mnuReportFlame.Hint := TextByKey('main-menu-flame-reporthint');
AddTemplate.Caption := TextByKey('main-menu-flame-template');
AddTemplate.Hint := TextByKey('main-menu-flame-templatehint');
mnuVar.Caption := TextByKey('main-menu-variation-title');
mnuVRandom.Caption := TextByKey('main-menu-variation-random');
mnuBuiltinVars.Caption := TextByKey('main-menu-variation-builtin');
mnuPluginVars.Caption := TextByKey('main-menu-variation-plugins');
mnuVRandom.Hint := TextByKey('main-menu-variation-randomhint');
mnuBuiltinVars.Hint := TextByKey('main-menu-variation-builtinhint');
mnuPluginVars.Hint := TextByKey('main-menu-variation-pluginshint');
mnuScript.Caption := TextByKey('main-menu-script-title');
mnuRun.Caption := TextByKey('main-menu-script-run');
mnuRun.Hint := TextByKey('main-toolbar-runscript');
btnRunScript.Hint := TextByKey('main-toolbar-runscript');
mnuStop.Caption := TextByKey('main-menu-script-stop');
mnuStop.Hint := TextByKey('main-toolbar-stopscript');
btnStopScript.Hint := TextByKey('main-toolbar-stopscript');
mnuOpenScript.Caption := TextByKey('main-menu-script-open');
mnuOpenScript.Hint := TextByKey('main-menu-script-openhint');
mnuEditScript.Caption := TextByKey('main-menu-script-edit');
mnuEditScript.Hint := TextByKey('main-toolbar-editscript');
tbEditScript.Hint := TextByKey('main-toolbar-editscript');
mnuManageFavorites.Caption := TextByKey('main-menu-script-managefaves');
mnuTurnFlameToScript.Caption := TextByKey('main-menu-script-flametoscript');
mnuManageFavorites.Hint := TextByKey('main-menu-script-managefaveshint');
mnuTurnFlameToScript.Hint := TextByKey('main-menu-script-flametoscripthint');
FavouriteScripts1.Caption := TextByKey('favscripts-title');
FavouriteScripts1.Hint := TextByKey('favscripts-hint');
mnuView.Caption := TextByKey('main-menu-options-title');
Directory1.Caption := IfThen(FavouriteScripts1.Enabled,
TextByKey('main-menu-script-more'), TextByKey('main-menu-script-directory'));
Directory1.Hint := TextByKey('main-menu-script-directoryhint');
mnuToolbar.Caption := TextByKey('main-menu-options-togglemaintoolbar');
mnuStatusBar.Caption := TextByKey('main-menu-options-togglestatusbar');
mnuFileContents.Caption := TextByKey('main-menu-options-togglefilelist');
mnuResetUI.Caption := TextByKey('main-menu-options-resetfilelistwidth');
mnuResetUI.Hint := TextByKey('main-menu-options-resetwidthhint');
SortFlames.Caption := TextByKey('main-menu-options-sortflames');
EnumerateFlames.Caption := TextByKey('main-menu-options-enumflames');
mnuTrace.Hint := TextByKey('main-menu-options-traceloghint');
mnuOptions.Caption := TextByKey('main-menu-options-showoptions');
mnuOptions.Hint := TextByKey('main-toolbar-options');
tbOptions.Hint := TextByKey('main-toolbar-options');
MainHelp.Caption := TextByKey('main-menu-help-title');
mnuHelpTopics.Caption := TextByKey('main-menu-help-contents');
mnuFlamePDF.Caption := TextByKey('main-menu-help-aboutalgorithm');
mnuAbout.Caption := TextByKey('main-menu-help-aboutapophysis');
mnuHelpTopics.Hint := TextByKey('main-menu-help-contentshint');
mnuFlamePDF.Hint := TextByKey('main-menu-help-aboutalgorithmhint');
mnuAbout.Hint := TextByKey('main-menu-help-aboutapophysishint');
btnViewList.Hint := TextByKey('main-toolbar-listviewmode-classic');
btnViewIcons.Hint := TextByKey('main-toolbar-listviewmode-icons');
tbShowAlpha.Hint := TextByKey('main-toolbar-togglealpha');
tbGuides.Hint := TextByKey('main-toolbar-toggleguides');
tbQualityBox.Hint := TextByKey('main-toolbar-quality');
tbDrag.Hint := TextByKey('main-toolbar-modemove');
tbRotate.Hint := TextByKey('main-toolbar-moderotate');
tbZoomIn.Hint := TextByKey('main-toolbar-modezoomin');
tbZoomOut.Hint := TextByKey('main-toolbar-modezoomout');
ListView1.Columns[0].Caption := TextByKey('save-name');
mnuResumeRender.Caption := TextByKey('main-menu-flame-resumeunfinished');
mnuApoStyle.Caption := TextByKey('main-menu-options-apouistyle');
mnuApoStyle.Hint := TextByKey('main-menu-options-apouistylehint');
mnuManual.Caption := TextByKey('main-menu-help-ifstheory');
mnuManual.Hint := TextByKey('main-menu-help-ifstheoryhint'); // AV
DownloadPlugins.Caption := TextByKey('main-menu-help-pluginlink'); // AV
Changeweightdistribution1.Caption := TextByKey('main-menu-flame-changeweights');
Changecolordistribution1.Caption := TextByKey('main-menu-flame-changecolors');
Hexagonal1.Caption := TextByKey('main-menu-flame-hextile');
Rhombic1.Caption := TextByKey('main-menu-flame-rhombustile');
Square1.Caption := TextByKey('main-menu-flame-squaretile');
AddTile.Caption := TextByKey('main-menu-flame-addtile');
AddSymmetry.Caption := TextByKey('main-menu-flame-addsymmetry');
BilateralSym.Caption := TextByKey('options-tab-random-type-bilateral');
RotationalSym.Caption := TextByKey('options-tab-random-type-rotational') + TextByKey('main-menu-flame-symorder');
DihedralSym.Caption := TextByKey('options-tab-random-type-dihedral') + TextByKey('main-menu-flame-symorder');
end;
procedure TMainForm.InvokeLoadXML(xmltext: string);
begin
ParseXML(MainCP, PCHAR(xmltext), false);
end;
function TMainForm.ApplicationOnHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
var
Pos: TPoint;
begin
Pos.x := 0;
Pos.y := 0;
CallHelp := False;
Result := True;
case Command of
HELP_SETPOPUP_POS: Pos := SmallPointToPoint(TSmallPoint(Data));
HELP_CONTEXTPOPUP: ShowHelp(Pos, Data);
else Result := False;
end;
end;
procedure TMainForm.ApplyThemedColors; // AV
var
AStyle: TCustomStyleServices;
MenuC1, MenuC2: TColor;
mb: TMenuBreak;
i: integer;
begin
AStyle := TStyleManager.ActiveStyle;
CurrentStyle := AStyle.Name;
BrightColor := AStyle.GetSystemColor(clHighlight);
WinColor := AStyle.GetSystemColor(clWindow);
TextColor := AStyle.GetSystemColor(clWindowText);
MidColor := MiddleColor(BrightColor, WinColor);
AStyle.GetElementColor(AStyle.GetElementDetails(tmPopupItemNormal),
ecTextColor, MenuC1);
AStyle.GetElementColor(AStyle.GetElementDetails(tmMenuBarItemNormal),
ecTextColor, MenuC2);
IsLightMenu := (MenuC1 > $00BEBEBE);
if IsLightMenu then
mnuEditor.ImageIndex := 75
else
mnuEditor.ImageIndex := 19;
if CurrentStyle <> 'Obsidian' then
IsLightMenu := IsLightMenu or (MenuC2 > $00BEBEBE);
if IsLightMenu then
tbEditor.ImageIndex := 75
else
tbEditor.ImageIndex := 19;
IsDarkTheme := (CurrentStyle = 'TabletDark') or (CurrentStyle = 'Auric')
or (CurrentStyle = 'Cobalt XEMedia') or (CurrentStyle = 'Onyx Blue')
or (CurrentStyle = 'Ruby Graphite') or (CurrentStyle = 'Golden Graphite');
i := 0;
if (CurrentStyle = 'Windows') then mb := mbNone else mb := mbBreak;
while i < length(VarMenus) do
begin
VarMenus[i].Break := mb;
inc(i, 30);
end;
end;
{ **************************************************************************** }
procedure TMainForm.StopThread;
begin
RedrawTimer.Enabled := False;
if Assigned(Renderer) then begin
assert(Renderer.Suspended = false);
Renderer.Terminate;
Renderer.WaitFor;
end;
end;
(*
// AV: how old are they? Maybe since Apo 1.0? :)
procedure EqualizeVars(const x: integer);
var
i: integer;
begin
for i := 0 to Transforms - 1 do
MainCp.xform[x].SetVariation(i, 1.0 / NRVAR);
end;
procedure NormalVars(const x: integer);
var
i: integer;
td: double;
begin
td := 0.0;
for i := 0 to 6 do
td := td + Maincp.xform[x].GetVariation(i);
if (td < 0.001) then
EqualizeVars(x)
else
for i := 0 to 6 do
MainCp.xform[x].SetVariation(i, MainCp.xform[x].GetVariation(i) / td);
end;
*)
procedure RandomVariation(cp: TControlPoint);
{ Randomise variation parameters }
var
a, b, i, j: integer;
begin
inc(MainSeed);
RandSeed := MainSeed;
for i := 0 to cp.NumXForms - 1 do
begin
for j := 0 to NRVAR - 1 do
cp.xform[i].SetVariation(j, 0);
repeat
a := random(NRVAR);
until Variations[a];
repeat
b := random(NRVAR);
until Variations[b];
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;
function FindFlameXML(const FlameStr: string; const Title: string) : Integer;
var
i: integer;
FlameStart: string;
begin
Result := 0;
FlameStart := '<flame ';
if Title <> '' then
FlameStart := '<flame name="' + Title + '"';
if FlameStr <> '' then
begin
i := Pos(FlameStart, Lowercase(FlameStr));
while i > 0 do
if PosEx('</flame', Lowercase(FlameStr), i+1) > i then
begin
Result := i;
break;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.RandomizeColorSpeed1Click(Sender: TObject);
var
i: integer;
begin
inc(MainSeed);
RandSeed := MainSeed;
StopThread;
UpdateUndo;
for i := 0 to Transforms - 1 do
maincp.xform[i].symmetry := 2 * random - 1;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.RandomizeCP(var cp1: TControlPoint; alg: integer = 0);
var
sourceCP: TControlPoint;
begin
if assigned(MainCP) then
sourceCP := MainCP.Clone
else
SourceCP := nil;
if assigned(cp1) then begin
cp1.Free;
cp1 := nil;
end;
cp1 := RandomFlame(sourceCP, alg);
if assigned(sourceCP) then
sourceCP.Free;
end;
function TMainForm.GradientFromPalette(const pal: TColorMap; const title: string): string;
var
c, i, j: integer;
strings: TStringList;
begin
strings := TStringList.Create;
try
strings.add('gradient:');
strings.add(' title="' + CleanUPRTitle(title) + '" smooth=no');
for i := 0 to 255 do
begin
j := round(i * (399 / 255));
c := pal[i][2] shl 16 + pal[i][1] shl 8 + pal[i][0];
strings.Add(' index=' + IntToStr(j) + ' color=' + intToStr(c));
end;
result := strings.text;
finally
strings.free;
end;
end;
function CleanIdentifier(ident: string): string;
{ Strips unwanted characters from an identifier}
var
i: integer;
begin
for i := 0 to Length(ident) do
begin
if ident[i] = #32 then
ident[i] := '_'
else if ident[i] = '}' then
ident[i] := '_'
else if ident[i] = '{' then
ident[i] := '_';
end;
Result := ident;
end;
procedure TMainForm.OnProgress(prog: double);
var
Elapsed, Remaining: TDateTime;
IntProg: Integer;
begin
IntProg := (round(prog * 100));
LoadSaveProgress.Position := IntProg;
if (IntProg = 100) then LoadSaveProgress.Position := 0;
Elapsed := Now - StartTime;
StatusBar.Panels[1].Text := Format(TextByKey('render-status-elapsed') + ' %2.2d:%2.2d:%2.2d.%2.2d',
[Trunc(Elapsed * 24),
Trunc((Elapsed * 24 - Trunc(Elapsed * 24)) * 60),
Trunc((Elapsed * 24 * 60 - Trunc(Elapsed * 24 * 60)) * 60),
Trunc((Elapsed * 24 * 60 * 60 - Trunc(Elapsed * 24 * 60 * 60)) * 100)]);
if prog > 0 then
Remaining := Elapsed/prog - Elapsed
else
Remaining := 0;
StatusBar.Panels[2].Text := Format(TextByKey('render-status-remaining') + ' %2.2d:%2.2d:%2.2d.%2.2d',
[Trunc(Remaining * 24),
Trunc((Remaining * 24 - Trunc(Remaining * 24)) * 60),
Trunc((Remaining * 24 * 60 - Trunc(Remaining * 24 * 60)) * 60),
Trunc((Remaining * 24 * 60 * 60 - Trunc(Remaining * 24 * 60 * 60)) * 100)]);
StatusBar.Panels[3].Text := MainCp.name;
Application.ProcessMessages;
end;
procedure TMainForm.UpdateUndo;
begin
MainCp.FillUsedPlugins;
SaveFlame(MainCp, Format('%.4d-', [UndoIndex]) + MainCp.name,
AppPath + undoFilename);
Inc(UndoIndex);
UndoMax := UndoIndex; //Inc(UndoMax);
mnuSaveUndo.Enabled := true;
mnuUndo.Enabled := True;
mnuPopUndo.Enabled := True;
mnuRedo.Enabled := false;
mnuPopRedo.Enabled := false;
btnUndo.enabled := true;
btnRedo.Enabled := false;
EditForm.mnuUndo.Enabled := True;
EditForm.mnuRedo.Enabled := false;
EditForm.tbUndo.enabled := true;
EditForm.tbRedo.enabled := false;
AdjustForm.btnUndo.enabled := true;
AdjustForm.btnRedo.enabled := false;
end;
function GradientEntries(gFilename: string): string;
var
i, p: integer;
Title: string;
FileStrings: TStringList;
NewStrings: TStringList;
begin
FileStrings := TStringList.Create;
NewStrings := TStringList.Create;
NewStrings.Text := '';
FileStrings.LoadFromFile(gFilename);
try
if (Pos('{', FileStrings.Text) <> 0) then
begin
for i := 0 to FileStrings.Count - 1 do
begin
p := Pos('{', FileStrings[i]);
if (p <> 0) then
begin
Title := Trim(Copy(FileStrings[i], 1, p - 1));
if (Title <> '') and (LowerCase(Title) <> 'comment') then
begin { Otherwise bad format }
NewStrings.Add(Title);
end;
end;
end;
GradientEntries := NewStrings.Text;
end;
finally
FileStrings.Free;
NewStrings.Free;
end;
end;
{ ********************************* File ************************************* }
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])) <> 0 then
Result := True;
finally
FStrings.Free;
end
end
else
Result := False;
end;
function CleanEntry(ident: string): string;
{ Strips unwanted characters from an identifier}
var
i: integer;
begin
for i := 1 to Length(ident) do
begin
if ident[i] = #32 then
ident[i] := '_'
else if ident[i] = '}' then
ident[i] := '_'
else if ident[i] = '{' then
ident[i] := '_';
end;
Result := ident;
end;
function CleanXMLName(ident: string): string;
var
i: integer;
begin
for i := 1 to Length(ident) do
begin
if ident[i] = '*' then
ident[i] := '_'
else if ident[i] = '"' then
ident[i] := #39;
end;
Result := ident;
end;
function CleanUPRTitle(ident: string): string;
{ Strips braces but leave spaces }
var
i: integer;
begin
for i := 1 to Length(ident) do
begin
if ident[i] = '}' then
ident[i] := '_'
else if ident[i] = '{' then
ident[i] := '_';
end;
Result := ident;
end;
function DeleteEntry(Entry, FileName: string): boolean;
{ Deletes an entry from a multi-entry file }
var
Strings: TStringList;
p, i: integer;
begin
Result := True;
Strings := TStringList.Create;
try
i := 0;
Strings.LoadFromFile(FileName);
while Pos(Entry + ' ', Trim(Strings[i])) <> 1 do
begin
inc(i);
end;
repeat
p := Pos('}', Strings[i]);
Strings.Delete(i);
until p <> 0;
if (i < Strings.Count) and (Trim(Strings[i]) = '') then Strings.Delete(i);
Strings.SaveToFile(FileName);
finally
Strings.Free;
end;
end;
function SaveUPR(Entry, FileName: string): boolean;
{ Saves UF parameter to end of file }
var
UPRFile: TextFile;
begin
Result := True;
try
AssignFile(UPRFile, FileName);
if FileExists(FileName) then
begin
if EntryExists(Entry, FileName) then DeleteEntry(Entry, FileName);
Append(UPRFile);
end
else
ReWrite(UPRFile);
WriteLn(UPRFile, MainForm.UPRString(MainCp, Entry));
CloseFile(UPRFile);
except on E: EInOutError do
begin
Application.MessageBox(PChar(Format(TextByKey('common-genericsavefailure'), [FileName])), 'Apophysis', 16);
Result := False;
end;
end;
end;
function IFSToString(cp: TControlPoint; Title: string): string;
{ Creates a string containing a formated IFS parameter set }
var
i: integer;
a, b, c, d, e, f, p: double;
Strings: TStringList;
begin
Strings := TStringList.Create;
try
Strings.Add(CleanEntry(Title) + ' {');
for i := 0 to Transforms - 1 do
begin
a := cp.xform[i].c[0][0];
b := cp.xform[i].c[0][1];
c := cp.xform[i].c[1][0];
d := cp.xform[i].c[1][1];
e := cp.xform[i].c[2][0];
f := cp.xform[i].c[2][1];
p := cp.xform[i].density;
Strings.Add(Format('%.6g %.6g %.6g %.6g %.6g %.6g %.6g',
[a, b, c, d, e, f, p]));
end;
Strings.Add('}');
IFSToString := Strings.Text;
finally
Strings.Free;
end;
end;
function GetTitle(str: string): string;
var
p: integer;
begin
str := Trim(str);
p := Pos(' ', str);
GetTitle := Trim(Copy(str, 1, p));
end;
function GetComment(str: string): string;
{ Extracts comment form line of IFS file }
var
p: integer;
begin
str := Trim(str);
p := Pos(';', str);
if p <> 0 then
GetComment := Trim(Copy(str, p + 1, Length(str) - p))
else
GetComment := '';
end;
function GetParameters(str: string; var a, b, c, d, e, f, p: double): boolean;
var
Tokens: TStringList;
begin
GetParameters := False;
Tokens := TStringList.Create;
try
try
GetTokens(str, tokens);
if Tokens.Count >= 7 then {enough tokens}
begin
a := StrToFloat(Tokens[0]);
b := StrToFloat(Tokens[1]);
c := StrToFloat(Tokens[2]);
d := StrToFloat(Tokens[3]);
e := StrToFloat(Tokens[4]);
f := StrToFloat(Tokens[5]);
p := StrToFloat(Tokens[6]);
Result := True;
end;
except on E: EConvertError do
begin
Result := False
end;
end;
finally
Tokens.Free;
end;
end;
function StringToIFS(strng: string): boolean;
{ Loads an IFS parameter set from string}
var
Strings: TStringList;
Comments: TStringList;
i, sTransforms: integer;
cmnt, sTitle: string;
a, b, c, d: double;
e, f, p: double;
begin
MainCp.clear;
StringToIFS := True;
sTransforms := 0;
Strings := TStringList.Create;
Comments := 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.');
{To Do ... !!!!}
sTitle := GetTitle(Strings[0]);
if sTitle = '' then raise EFormatInvalid.Create('No identifier.');
cmnt := GetComment(Strings[0]);
if cmnt <> '' then Comments.Add(cmnt);
i := 1;
try
repeat
cmnt := GetComment(Strings[i]);
if cmnt <> '' then Comments.Add(cmnt);
if (Pos(';', Trim(Strings[i])) <> 1) and (Trim(Strings[i]) <> '') then
if GetParameters(Strings[i], a, b, c, d, e, f, p) then
begin
MainCp.xform[sTransforms].c[0][0] := a;
MainCp.xform[sTransforms].c[0][1] := c;
MainCp.xform[sTransforms].c[1][0] := b;
MainCp.xform[sTransforms].c[1][1] := d;
MainCp.xform[sTransforms].c[2][0] := e;
MainCp.xform[sTransforms].c[2][1] := f;
MainCp.xform[sTransforms].density := p;
inc(sTransforms);
end
else
EFormatInvalid.Create('Insufficient parameters.');
inc(i);
until (Pos('}', Strings[i]) <> 0) or (sTransforms = NXFORMS);
except on E: EMathError do
end;
if sTransforms < 2 then
raise EFormatInvalid.Create('Insufficient parameters.');
MainCp.name := sTitle;
Transforms := sTransforms;
for i := 1 to Transforms - 1 do
MainCp.xform[i].color := 0;
MainCp.xform[0].color := 1;
except on E: EFormatInvalid do
begin
Application.MessageBox(PChar(TextByKey('common-invalidformat')), PChar('Apophysis'), 16);
end;
end;
finally
Strings.Free;
Comments.Free;
end;
end;
function SaveIFS(cp: TControlPoint; Title, FileName: string): boolean;
{ Saves IFS parameters to end of file }
var
a, b, c: double;
d, e, f, p: double;
m: integer;
IFile: TextFile;
begin
Result := True;
try
AssignFile(IFile, FileName);
if FileExists(FileName) then
begin
if EntryExists(Title, FileName) then DeleteEntry(Title, FileName);
Append(IFile);
end
else
ReWrite(IFile);
WriteLn(IFile, Title + ' {');
for m := 0 to Transforms - 1 do
begin
a := cp.xform[m].c[0][0];
c := cp.xform[m].c[0][1];
b := cp.xform[m].c[1][0];
d := cp.xform[m].c[1][1];
e := cp.xform[m].c[2][0];
f := cp.xform[m].c[2][1];
p := cp.xform[m].density;
Write(IFile, Format('%.6g %.6g %.6g %.6g %.6g %.6g %.6g',
[a, b, c, d, e, f, p]));
WriteLn(IFile, '');
end;
WriteLn(IFile, '}');
WriteLn(IFile, ' ');
CloseFile(IFile);
except on E: EInOutError do
begin
Application.MessageBox(PChar(Format(TextByKey('common-genericsavefailure'), [FileName])), 'Apophysis', 16);
Result := False;
end;
end;
end;
function TMainForm.SaveFlame(cp1: TControlPoint; title, filename: string): boolean;
{ Saves Flame parameters to end of file }
var
IFile: TextFile;
sl: TStringList;
i: integer;
begin
Result := True;
try
AssignFile(IFile, filename);
if FileExists(filename) then
begin
if EntryExists(title, filename) then DeleteEntry(title, fileName);
Append(IFile);
end
else ReWrite(IFile);
sl := TStringList.Create;
try
cp1.SaveToStringList(sl);
WriteLn(IFile, title + ' {');
write(IFile, sl.Text);
WriteLn(IFile, 'palette:');
for i := 0 to 255 do
begin
WriteLn(IFile, IntToStr(cp1.cmap[i][0]) + ' ' +
IntToStr(cp1.cmap[i][1]) + ' ' +
IntToStr(cp1.cmap[i][2]))
end;
WriteLn(IFile, ' }');
finally
sl.free
end;
WriteLn(IFile, ' ');
CloseFile(IFile);
except on EInOutError do
begin
Application.MessageBox(PChar(Format(TextByKey('common-genericsavefailure'), [FileName])), 'Apophysis', 16);
Result := False;
end;
end;
end;
function ColorToXmlCompact(cp1: TControlPoint): string;
var
i: integer;
begin
Result := ' <palette count="256" format="RGB">';
for i := 0 to 255 do begin
if ((i and 7) = 0) then Result := Result + #13#10 + ' ';
Result := Result + IntToHex(cp1.cmap[i, 0],2)
+ IntToHex(cp1.cmap[i, 1],2)
+ IntToHex(cp1.cmap[i, 2],2);
end;
Result := Result + #13#10 + ' </palette>';
end;
function ColorToXml(cp1: TControlPoint): string;
var
i: integer;
begin
Result := '';
for i := 0 to 255 do begin
Result := Result + ' <color index="' + IntToStr(i) +
'" rgb="' + IntToStr(cp1.cmap[i, 0]) + ' ' +
IntToStr(cp1.cmap[i, 1]) + ' ' +
IntToStr(cp1.cmap[i, 2]) + '"/>' + #13#10;
end;
end;
function FlameToXMLAS(const cp1: TControlPoint; title: string; exporting: boolean): string;
var
t, i{, j}: integer;
FileList: TStringList;
x, y: double;
parameters: string;
curves, str: string;
begin
FileList := TStringList.create;
x := cp1.center[0];
y := cp1.center[1];
// if cp1.cmapindex >= 0 then pal := pal + 'gradient="' + IntToStr(cp1.cmapindex) + '" ';
try
parameters := 'version="' + AppVersionString + '" ';
if cp1.time <> 0 then
parameters := parameters + format('time="%g" ', [cp1.time]);
parameters := parameters +
'size="' + IntToStr(cp1.width) + ' ' + IntToStr(cp1.height) +
format('" center="%g %g" ', [x, y]) +
format('scale="%g" ', [cp1.pixels_per_unit]);
if cp1.FAngle <> 0 then
parameters := parameters + format('angle="%g" ', [cp1.FAngle]) +
format('rotate="%g" ', [-180 * cp1.FAngle/Pi]);
if cp1.zoom <> 0 then
parameters := parameters + format('zoom="%g" ', [cp1.zoom]);
// 3d
if cp1.cameraPitch <> 0 then
parameters := parameters + format('cam_pitch="%g" ', [cp1.cameraPitch]);
if cp1.cameraYaw <> 0 then
parameters := parameters + format('cam_yaw="%g" ', [cp1.cameraYaw]);
if cp1.cameraRoll <> 0 then
parameters := parameters + format('cam_roll="%g" ', [cp1.cameraRoll]);
if cp1.cameraPersp <> 0 then
parameters := parameters + format('cam_perspective="%g" ', [cp1.cameraPersp]);
if cp1.cameraZpos <> 0 then
parameters := parameters + format('cam_zpos="%g" ', [cp1.cameraZpos]);
if cp1.cameraDOF <> 0 then
parameters := parameters + format('cam_dof="%g" ', [cp1.cameraDOF]);
//
parameters := parameters + format(
'oversample="%d" filter="%g" quality="%g" ',
[cp1.spatial_oversample,
cp1.spatial_filter_radius,
cp1.sample_density]
);
if cp1.nbatches <> 1 then parameters := parameters + 'batches="' + IntToStr(cp1.nbatches) + '" ';
if cp1.hue_rotation <> 1 then parameters := parameters + format('hue="%g" ', [cp1.hue_rotation]); // AV
parameters := parameters +
format('background="%g %g %g" ', [cp1.background[0] / 255, cp1.background[1] / 255, cp1.background[2] / 255]) +
format('brightness="%g" ', [cp1.brightness]) +
format('gamma="%g" ', [cp1.gamma]);
if cp1.contrast <> 1 then // AV
parameters := parameters + format('contrast="%g" ', [cp1.contrast]);
if cp1.vibrancy <> 1 then
parameters := parameters + format('vibrancy="%g" ', [cp1.vibrancy]);
if cp1.gamma_threshold <> 0 then
parameters := parameters + format('gamma_threshold="%g" ', [cp1.gamma_threshold]);
if cp1.soloXform >= 0 then
parameters := parameters + format('soloxform="%d" ', [cp1.soloXform]);
parameters := parameters +
format('estimator_radius="%g" ', [cp1.estimator]) +
format('estimator_minimum="%g" ', [cp1.estimator_min]) +
format('estimator_curve="%g" ', [cp1.estimator_curve]);
if (cp1.enable_de) then
parameters := parameters + ('enable_de="1" ')
else parameters := parameters + ('enable_de="0" ');
str := '';
for i := 0 to cp1.used_plugins.Count-1 do begin
str := str + cp1.used_plugins[i];
if (i = cp1.used_plugins.Count-1) then break;
str := str + ' ';
end;
parameters := parameters + format('plugins="%s" new_linear="1" ', [str]);
for i := 0 to 3 do
begin
curves := curves + FloatToStr(cp1.curvePoints[i][0].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][0].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][0]) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][1].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][1].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][1]) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][2].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][2].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][2]) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][3].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][3].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][3]) + ' ';
end;
curves := trim(curves);
parameters := parameters + format('curves="%s" ', [curves]);
FileList.Add('<flame name="' + title + '" ' + parameters + '>');
{ Write transform parameters }
t := cp1.NumXForms;
for i := 0 to t - 1 do
FileList.Add(cp1.xform[i].ToXMLString);
if cp1.HasFinalXForm then
begin
// 'enabled' flag disabled in this release
FileList.Add(cp1.xform[t].FinalToXMLString(cp1.finalXformEnabled));
end;
{ Write palette data }
if exporting or OldPaletteFormat then
FileList.Add(ColorToXml(cp1))
else
FileList.Add(ColorToXmlCompact(cp1));
FileList.Add('</flame>');
result := FileList.text;
finally
FileList.free
end;
end;
/////////// AV: working with embedded PNG-parameters ////////////////////////
procedure TMainForm.ImportFromPNGClick(Sender: TObject);
begin
OpenDialog.Title := TextByKey('common-open-apoimage');
OpenDialog.Filter := TextByKey('common-filter-png') + ' |*.png';
OpenDialog.InitialDir := ParamFolder;
OpenDialog.FileName := '';
if OpenDialog.Execute then
ImportThumbnailPNG(OpenDialog.FileName);
end;
procedure TMainForm.ImportThumbnailPNG(FileName: string);
var
flameXML: string;
begin
flameXML := MainForm.LoadXMLFlameTextPNG(FileName);
if flameXML <> '' then
begin
try
PasteFlameXML(flameXML);
except
Application.MessageBox(PChar(Format(TextByKey('common-openpngerror1'),
[ExtractFileName(FileName)])), PChar('Apophysis AV'), MB_ICONWARNING or MB_OK);
end;
end;
end;
function TMainForm.LoadXMLFlameTextPNG(FileName: string): string;
var
PngObject: TPNGObject;
ChunkList: TPngList;
TextChunk: TChunkTEXT;
flameXML: string;
label loadedFlame;
begin
Result := '';
PngObject := TPngObject.Create;
try
PngObject.LoadFromFile(FileName);
ChunkList := PngObject.Chunks;
if ChunkList <> nil then
begin
TextChunk := ChunkList.FindChunk(TChunkTEXT) as TChunkTEXT;
// iterate through text chunks until 'ApoFlame' keyword is found
while TextChunk <> nil do
begin
if TextChunk.Keyword = 'ApoFlame' then
begin
if FindFlameXML(String(TextChunk.Text), '') > 0 then
begin
Result := String(TextChunk.Text);
goto loadedFlame;
end;
break;
end else
ChunkList.RemoveChunk(TextChunk);
end;
Application.MessageBox(PChar(Format(TextByKey('common-openpngerror2'),
[ExtractFileName(FileName)])), PChar('Apophysis AV'), MB_ICONWARNING or MB_OK);
loadedFlame:
end;
except
Application.MessageBox(PChar(Format(TextByKey('common-openpngerror3'),
[ExtractFileName(FileName)])), PChar('Apophysis AV'), MB_ICONWARNING or MB_OK);
end;
PngObject.Free;
end;
///////////////////////////////
function GetThumbnailBase64(const cp1: TControlPoint) : string;
var
st: TMemoryStream;
tempcp : TControlPoint;
render : TRenderer;
buffer : array of byte;
base64 : string;
size : integer;
bmp : TJPegImage;
w, h, r: double;
begin
w := cp1.Width;
h := cp1.Height;
r := w / h;
if (w < h) then
begin
w := r * ThumbnailSize;
h := ThumbnailSize;
end else if (w > h) then
begin
h := ThumbnailSize / r;
w := ThumbnailSize;
end else
begin
w := ThumbnailSize;
h := ThumbnailSize;
end;
render := TRenderer.Create;
tempcp := TControlPoint.create;
tempcp.Copy(cp1);
tempcp.AdjustScale(round(w), round(h));
tempcp.Width := round(w);
tempcp.Height := round(h);
tempcp.spatial_oversample := defOversample;
tempcp.spatial_filter_radius := defFilterRadius;
tempcp.sample_density := 10;
render.SetCP(tempcp);
render.Render;
st := TMemoryStream.Create;
bmp := TJpegImage.Create;
bmp.Assign(render.GetImage);
bmp.SaveToStream(st);
size := st.Size;
SetLength(buffer, size);
st.Seek(0, soBeginning);
st.ReadBuffer(buffer[0], length(buffer));
base64 := B64Encode(TBinArray(buffer), length(buffer));
tempcp.Free;
render.Free;
st.Free;
bmp.Free;
result := base64;
end;
function FlameToXML(const cp1: TControlPoint; exporting, embedthumb: boolean): String;
var
t, i{, j}, pos: integer;
FileList: TStringList;
x, y: double;
parameters: string;
curves, str, buf, xdata: string;
begin
FileList := TStringList.create;
x := cp1.center[0];
y := cp1.center[1];
// if cp1.cmapindex >= 0 then pal := pal + 'gradient="' + IntToStr(cp1.cmapindex) + '" ';
try
parameters := 'version="' + AppVersionString + '" ';
if cp1.time <> 0 then
parameters := parameters + format('time="%g" ', [cp1.time]);
parameters := parameters +
'size="' + IntToStr(cp1.width) + ' ' + IntToStr(cp1.height) +
format('" center="%g %g" ', [x, y]) +
format('scale="%g" ', [cp1.pixels_per_unit]);
if cp1.FAngle <> 0 then
parameters := parameters + format('angle="%g" ', [cp1.FAngle]) + // !?!?!?
format('rotate="%g" ', [-180 * cp1.FAngle/Pi]);
if cp1.zoom <> 0 then
parameters := parameters + format('zoom="%g" ', [cp1.zoom]);
// 3d
if cp1.cameraPitch <> 0 then
parameters := parameters + format('cam_pitch="%g" ', [cp1.cameraPitch]);
if cp1.cameraYaw <> 0 then
parameters := parameters + format('cam_yaw="%g" ', [cp1.cameraYaw]);
if cp1.cameraRoll <> 0 then // AV
parameters := parameters + format('cam_roll="%g" ', [cp1.cameraRoll]);
if cp1.cameraPersp <> 0 then
parameters := parameters + format('cam_perspective="%g" ', [cp1.cameraPersp]);
if cp1.cameraZpos <> 0 then
parameters := parameters + format('cam_zpos="%g" ', [cp1.cameraZpos]);
if cp1.cameraDOF <> 0 then
parameters := parameters + format('cam_dof="%g" ', [cp1.cameraDOF]);
//
parameters := parameters + format(
'oversample="%d" filter="%g" quality="%g" ',
[cp1.spatial_oversample,
cp1.spatial_filter_radius,
cp1.sample_density]
);
if cp1.nbatches <> 1 then parameters := parameters + 'batches="' + IntToStr(cp1.nbatches) + '" ';
if cp1.hue_rotation <> 1 then parameters := parameters + format('hue="%g" ', [cp1.hue_rotation]); // AV
parameters := parameters +
format('background="%g %g %g" ', [cp1.background[0] / 255, cp1.background[1] / 255, cp1.background[2] / 255]) +
format('brightness="%g" ', [cp1.brightness]) +
format('gamma="%g" ', [cp1.gamma]);
if cp1.contrast <> 1 then // AV
parameters := parameters + format('contrast="%g" ', [cp1.contrast]);
if cp1.vibrancy <> 1 then
parameters := parameters + format('vibrancy="%g" ', [cp1.vibrancy]);
if cp1.gamma_threshold <> 0 then
parameters := parameters + format('gamma_threshold="%g" ', [cp1.gamma_threshold]);
if cp1.soloXform >= 0 then
parameters := parameters + format('soloxform="%d" ', [cp1.soloXform]);
//
parameters := parameters +
format('estimator_radius="%g" ', [cp1.estimator]) +
format('estimator_minimum="%g" ', [cp1.estimator_min]) +
format('estimator_curve="%g" ', [cp1.estimator_curve]);
if exporting then parameters := parameters +
format('temporal_samples="%d" ', [cp1.jitters]);
if (cp1.enable_de) then
parameters := parameters + ('enable_de="1" ')
else parameters := parameters + ('enable_de="0" ');
str := '';
for i := 0 to cp1.used_plugins.Count-1 do begin
str := str + cp1.used_plugins[i];
if (i = cp1.used_plugins.Count-1) then break;
str := str + ' ';
end;
parameters := parameters + format('plugins="%s" new_linear="1" ', [str]);
for i := 0 to 3 do
begin
curves := curves + FloatToStr(cp1.curvePoints[i][0].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][0].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][0]) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][1].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][1].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][1]) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][2].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][2].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][2]) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][3].x) + ' ';
curves := curves + FloatToStr(cp1.curvePoints[i][3].y) + ' ';
curves := curves + FloatToStr(cp1.curveWeights[i][3]) + ' ';
end;
curves := trim(curves);
parameters := parameters + format('curves="%s" ', [curves]);
FileList.Add('<flame name="' + CleanXMLName(cp1.name) + '" ' + parameters + '>');
{ Write transform parameters }
t := cp1.NumXForms;
for i := 0 to t - 1 do
FileList.Add(cp1.xform[i].ToXMLString);
if cp1.HasFinalXForm then
begin
// 'enabled' flag disabled in this release
FileList.Add(cp1.xform[t].FinalToXMLString(cp1.finalXformEnabled));
end;
if (embedthumb and EmbedThumbnails) then begin
xdata := GetThumbnailBase64(cp1);
buf := '';
for i := 1 to length(xdata) do begin
buf := buf + xdata[i];
if (length(buf) = 150) then begin
FileList.Add(' <xdata content="' + buf + '" />');
buf := '';
end;
end;
if (Length(buf) > 0) then FileList.Add(' <xdata content="' + buf + '" />');
end;
{ Write palette data }
if exporting or OldPaletteFormat then
FileList.Add(ColorToXml(cp1))
else
FileList.Add(ColorToXmlCompact(cp1));
FileList.Add('</flame>');
result := FileList.text;
finally
FileList.free
end;
end;
function RemoveExt(filename: string): string;
var
ext: string;
p: integer;
begin
filename := ExtractFileName(filename);
ext := ExtractFileExt(filename);
p := Pos(ext, filename);
Result := Copy(filename, 0, p - 1);
end;
function XMLEntryExists(title, filename: string): boolean;
var
FileList: TStringList;
begin
Result := false;
if FileExists(filename) then
begin
FileList := TStringList.Create;
try
FileList.LoadFromFile(filename);
if pos('<flame name="' + title + '"', FileList.Text) <> 0 then Result := true;
finally
FileList.Free;
end
end else
result := false;
end;
procedure DeleteXMLEntry(title, filename: string);
var
Strings: TStringList;
p, i: integer;
begin
Strings := TStringList.Create;
try
i := 0;
Strings.LoadFromFile(FileName);
while Pos('name="' + title + '"', Trim(Strings[i])) = 0 do
inc(i);
p := 0;
while p = 0 do
begin
p := Pos('</flame>', Strings[i]);
Strings.Delete(i);
end;
Strings.SaveToFile(FileName);
finally
Strings.Free;
end;
end;
function TMainForm.SaveXMLFlame(const cp1: TControlPoint; title, filename: string): boolean;
{ Saves Flame parameters to end of file }
var
Tag: string;
IFile: File;
FileList: TStringList;
i, p: integer;
bakname: string;
begin
Tag := RemoveExt(filename);
Result := True;
try
if FileExists(filename) then
begin
bakname := ChangeFileExt(filename, '.bak');
if FileExists(bakname) then DeleteFile(bakname);
RenameFile(filename, bakname);
FileList := TStringList.create;
try
FileList.LoadFromFile(bakname);
if Pos('<flame name="' + title + '"', FileList.Text) <> 0 then
begin
i := 0;
while Pos('<flame name="' + title + '"', Trim(FileList[i])) = 0 do
inc(i);
p := 0;
while p = 0 do
begin
p := Pos('</flame>', FileList[i]);
FileList.Delete(i);
end;
end;
// fix first line
if (FileList.Count > 0) then begin
//FileList[0] := '<flames name="' + Tag + '">';
// AV: fix fixed :-)
if (pos('<flames name', FileList[0]) <> 0) then
FileList[0] := '<flames name="' + Tag + '">'
else // single-flame support
FileList.Insert(0, '<flames name="' + Tag + '">');
end;
if FileList.Count > 2 then
begin
// AV fix last line :-)
if (pos('</flames>', FileList[FileList.Count - 1]) = 0) then
FileList.Add('</flames>');
if pos('<flame ', FileList.text) <> 0 then
repeat
FileList.Delete(FileList.Count - 1);
until (Pos('</flame>', FileList[FileList.count - 1]) <> 0)
else
repeat
FileList.Delete(FileList.Count - 1);
until (Pos('<' + Tag + '>', FileList[FileList.count - 1]) <> 0) or
(Pos('</flames>', FileList[FileList.count - 1]) <> 0);
end else
begin
FileList.Delete(FileList.Count - 1);
end;
FileList.Add(Trim(FlameToXML(cp1, false, true)));
FileList.Add('</flames>');
FileList.SaveToFile(filename);
finally
if FileExists(bakname) and not FileExists(filename) then
RenameFile(bakname, filename);
FileList.Free;
end;
end
else
begin
// New file ... easy
FileList := TStringList.Create;
FileList.Text := '<flames name="' + Tag + '">' + #$0D#$0A +
FlameToXML(cp1, false, true) + #$0D#$0A + '</flames>';
FileList.SaveToFile(filename, TEncoding.UTF8);
FileList.Destroy;
end;
except // AV: fixed multi-updating
Result := False; // AV: first assign the value, then exit
raise Exception.CreateFmt(TextByKey('common-genericsavefailure'), [FileName]); // AV
//Application.MessageBox(PChar(Format(TextByKey('common-genericsavefailure'), [FileName])), 'Apophysis', 16);
end;
end;
function TMainForm.SaveGradient(Gradient, Title, FileName: string): boolean;
{ Saves gradient parameters to end of file }
var
IFile: TextFile;
begin
Result := True;
try
AssignFile(IFile, FileName);
if FileExists(FileName) then
begin
if EntryExists(Title, FileName) then DeleteEntry(Title, FileName);
Append(IFile);
end
else
ReWrite(IFile);
Write(IFile, Gradient);
WriteLn(IFile, ' ');
CloseFile(IFile);
except on EInOutError do
begin
Result := False;
raise Exception.CreateFmt(TextByKey('common-genericsavefailure'), [FileName]); // AV
end;
end;
end;
function RenameIFS(OldIdent: string; var NewIdent: string): boolean;
{ Renames an IFS parameter set in a file }
var
Strings: TStringList;
p, i: integer;
s: string;
begin
Result := True;
NewIdent := CleanEntry(NewIdent);
Strings := TStringList.Create;
try
try
i := 0;
Strings.LoadFromFile(OpenFile);
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(OpenFile);
end
else
Result := False;
except on Exception do Result := False;
end;
finally
Strings.Free;
end;
end;
function RenameXML(OldIdent: string; var NewIdent: string): boolean;
{ Renames an XML parameter set in a file }
var
Strings: TStringList;
i: integer;
bakname: string;
begin
Result := True;
Strings := TStringList.Create;
try
try
i := 0;
Strings.LoadFromFile(OpenFile);
if Pos('name="' + OldIdent + '"', Strings.Text) <> 0 then
begin
while Pos('name="' + OldIdent + '"', Strings[i]) = 0 do
begin
inc(i);
end;
Strings[i] := StringReplace(Strings[i], OldIdent, NewIdent, []);
bakname := ChangeFileExt(OpenFile, '.bak');
if FileExists(bakname) then DeleteFile(bakname);
RenameFile(OpenFile, bakname);
Strings.SaveToFile(OpenFile);
end
else
Result := False;
except on Exception do
Result := False;
end;
finally
Strings.Free;
end;
end;
procedure ListIFS(FileName: string; sel: integer);
{ List identifiers in file }
var
i, p: integer;
Title: string;
ListItem: TListItem;
FStrings: TStringList;
begin
MainForm.ParseLoadingBatch := true;
FStrings := TStringList.Create;
FStrings.LoadFromFile(FileName);
try
MainForm.ListView1.Items.BeginUpdate;
MainForm.ListView1.Items.Clear;
if (Pos('{', FStrings.Text) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('{', FStrings[i]);
// AV: why do we use 2-nd condition? A rudiment from 3D-hack?
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 }
if ((i mod 5) = 0) then
MainForm.LoadSaveProgress.Position :=
round(100 * i / FStrings.Count); // AV
ListItem := MainForm.ListView1.Items.Add;
Listitem.Caption := Title; // Trim(Copy(FStrings[i], 1, p - 1));
end;
end;
end;
end;
MainForm.LoadSaveProgress.Position := 0; // AV
MainForm.ListView1.Items.EndUpdate;
with MainForm.ListView1 do
if Items.Count > 0 then // AV
case sel of
0: Selected := Items[Items.Count - 1];
1: Selected := Items[0];
end;
finally
FStrings.Free;
end;
MainForm.ParseLoadingBatch := false; // AV
end;
procedure ListFlames(FileName: string; sel: integer);
{ List identifiers in file }
var
i, p: integer;
Title: string;
ListItem: TListItem;
FStrings: TStringList;
begin
FStrings := TStringList.Create;
FStrings.LoadFromFile(FileName);
try
MainForm.ListView1.Items.BeginUpdate;
MainForm.ListView1.Items.Clear;
if (Pos('{', FStrings.Text) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('{', FStrings[i]);
if (p <> 0) then
begin
Title := Trim(Copy(FStrings[i], 1, p - 1));
if Title <> '' then
begin { Otherwise bad format }
ListItem := MainForm.ListView1.Items.Add;
Listitem.Caption := Trim(Copy(FStrings[i], 1, p - 1));
end;
end;
end;
end;
MainForm.ListView1.Items.EndUpdate;
if sel = 1 then MainForm.ListView1.Selected := MainForm.ListView1.Items[0];
finally
FStrings.Free;
end;
end;
{ ****************************** Display ************************************ }
procedure Trace1(const str: string);
begin
if TraceLevel >= 1 then
TraceForm.MainTrace.Lines.Add('. ' + str);
end;
procedure Trace2(const str: string);
begin
if TraceLevel >= 2 then
TraceForm.MainTrace.Lines.Add('. . ' + str);
end;
procedure TMainForm.HandleThreadCompletion(var Message: TMessage);
var
oldscale: double;
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;
Image.Cursor := crDefault;
if assigned(FViewImage) then begin
oldscale := FViewImage.Width / Image.Width;
FViewImage.Free;
end
else oldscale := FViewScale;
FViewImage := Renderer.GetTransparentImage;
if (FViewImage <> nil) and (FViewImage.Width > 0) then begin
FViewScale := FViewImage.Width / Image.Width;
FViewPos.X := FViewScale/oldscale * (FViewPos.X - FViewOldPos.X);
FViewPos.Y := FViewScale/oldscale * (FViewPos.Y - FViewOldPos.Y);
DrawImageView;
{
case FMouseMoveState of
msZoomWindowMove: FMouseMoveState := msZoomWindow;
msZoomOutWindowMove: FMouseMoveState := msZoomOutWindow;
// msDragMove: FMouseMoveState := msDrag;
msRotateMove: FMouseMoveState := msRotate;
end;
}
if FMouseMoveState in [msZoomWindowMove, msZoomOutWindowMove, msRotateMove] then
DrawSelection := false;
Trace1(TimeToStr(Now) + ' : Render complete');
Renderer.ShowSmallStats;
end
else Trace2('WARNING: No image rendered!');
Renderer.WaitFor;
Trace2('Destroying RenderThread #' + IntToStr(Renderer.ThreadID));
Renderer.Free;
Renderer := nil;
Trace1('');
end;
procedure TMainForm.HandleThreadTermination(var Message: TMessage);
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;
Image.Cursor := crDefault;
Trace2(' Render aborted');
Trace2('Destroying RenderThread #' + IntToStr(Renderer.ThreadID));
Renderer.Free;
Renderer := nil;
Trace1('');
end;
procedure TMainForm.DrawPreview;
var
cp : TControlPoint;
Render : TRenderer;
BM: TBitmap;
begin
Render := TRenderer.Create;
bm := TBitmap.Create;
cp := MainCP.Clone;
cp.sample_density := 1;
cp.spatial_oversample := 1;
cp.spatial_filter_radius := 1;
//Render.NrThreads := NrTreads;
Render.SetCP(cp);
Render.Render;
BM.Assign(Render.GetImage);
Image.Picture.Graphic := bm;
end;
procedure TMainForm.DrawFlame;
var
GlobalMemoryInfo: TMemoryStatus; // holds the global memory status information
RenderCP: TControlPoint;
Mem, ApproxMem: cardinal;
bs: integer;
begin
RedrawTimer.Enabled := False;
if Assigned(Renderer) then begin
assert(Renderer.Suspended = false);
Trace2('Killing previous RenderThread #' + inttostr(Renderer.ThreadID));
Renderer.Terminate;
Renderer.WaitFor;
Trace2('Destroying RenderThread #' + IntToStr(Renderer.ThreadID));
Renderer.Free;
Renderer := nil;
end;
if not Assigned(Renderer) then
begin
if EditForm.Visible and ((MainCP.Width / MainCP.Height) <> (EditForm.cp.Width / EditForm.cp.Height))
then EditForm.UpdateDisplay(true); // preview only?
if AdjustForm.Visible then AdjustForm.UpdateDisplay(true); // preview only!
RenderCP := MainCP.Clone;
RenderCp.AdjustScale(Image.width, Image.height);
// following needed ?
// cp.Zoom := Zoom;
// cp.center[0] := center[0];
// cp.center[1] := center[1];
RenderCP.sample_density := defSampleDensity;
// oversample and filter are just slowing us down here...
RenderCP.spatial_oversample := 1; // defOversample;
RenderCP.spatial_filter_radius := 0.001; {?} //defFilterRadius;
RenderCP.Transparency := true; // always generate transparency here
GlobalMemoryInfo.dwLength := SizeOf(GlobalMemoryInfo);
GlobalMemoryStatus(GlobalMemoryInfo);
Mem := GlobalMemoryInfo.dwAvailPhys;
if (singleBuffer) then bs := 16
else bs := 32;
// if Output.Lines.Count >= 1000 then Output.Lines.Clear;
Trace1('--- Previewing "' + RenderCP.name + '" ---');
Trace1(Format(' Available memory: %f Mb', [Mem / (1024*1024)]));
ApproxMem := int64(RenderCp.Width) * int64(RenderCp.Height) {* sqr(Oversample)}
* (bs + 4 + 4); // +4 for temp image(s)...?
assert(MainPreviewScale <> 0);
if ApproxMem * sqr(MainPreviewScale) < Mem then begin
if ExtendMainPreview then begin
RenderCP.sample_density := RenderCP.sample_density / sqr(MainPreviewScale);
RenderCP.Width := round(RenderCp.Width * MainPreviewScale);
RenderCP.Height := round(RenderCp.Height * MainPreviewScale);
end;
end
else Trace1('WARNING: Not enough memory for extended preview!');
if ApproxMem > Mem then
Trace1('OUTRAGEOUS: Not enough memory even for normal preview! :-(');
Trace1(Format(' Size: %dx%d, Quality: %f',
[RenderCP.Width, RenderCP.Height, RenderCP.sample_density]));
FViewOldPos.x := FViewPos.x;
FViewOldPos.y := FViewPos.y;
StartTime := Now;
try
Renderer := TRenderThread.Create;
Renderer.TargetHandle := MainForm.Handle;
if TraceLevel > 0 then Renderer.Output := TraceForm.MainTrace.Lines;
Renderer.OnProgress := OnProgress;
Renderer.SetCP(RenderCP);
// Renderer.NrThreads := NrTreads;
Trace2('Starting RenderThread #' + inttostr(Renderer.ThreadID));
Renderer.Resume;
Image.Cursor := crAppStart;
except
Trace1('ERROR: Cannot start renderer!');
end;
RenderCP.Free;
end;
end;
{ ************************** IFS and triangle stuff ************************* }
function FlameToString(Title: string): string;
{ Creates a string containing the formated flame parameter set }
var
I: integer;
sl, Strings: TStringList;
begin
Strings := TStringList.Create;
sl := TStringList.Create;
try
Strings.Add(CleanEntry(Title) + ' {');
MainCp.SaveToStringList(sl);
Strings.Add(sl.text);
Strings.Add('palette:');
for i := 0 to 255 do
begin
Strings.Add(IntToStr(MainCp.cmap[i][0]) + ' ' +
IntToStr(MainCp.cmap[i][1]) + ' ' +
IntToStr(MainCp.cmap[i][2]))
end;
Strings.Add('}');
Result := Strings.Text;
finally
sl.Free;
Strings.Free;
end;
end;
procedure TMainForm.RandomBatch;
{ Write a series of random ifs to a file }
var
i: integer;
F: TextFile;
b, RandFile: string;
begin
b := IntToStr(BatchSize);
inc(MainSeed);
RandSeed := MainSeed;
try
AssignFile(F, AppPath + randFilename);
OpenFile := AppPath + randFilename;
ReWrite(F);
WriteLn(F, '<flames name="Random Batch">'); // AV: fixed '<random_batch>');
for i := 0 to BatchSize - 1 do
begin
inc(RandomIndex);
Statusbar.SimpleText := Format(TextByKey('main-status-batchgenerate'), [(i+1), b]);
RandSeed := MainSeed;
if randGradient = 0 then cmap_index := random(NRCMAPS);
inc(MainSeed);
RandSeed := MainSeed;
RandomizeCP(MainCp);
MainCp.CalcBoundbox;
MainCp.name := RandomPrefix + RandomDate + '-' + IntToStr(RandomIndex);
Write(F, FlameToXML(MainCp, False, false));
end;
Write(F, '</flames>'); // AV: fixed '</random_batch>');
CloseFile(F);
except
on EInOutError do
Application.MessageBox(PChar(TextByKey('main-status-batcherror')), PChar('Apophysis'), 16);
end;
RandFile := AppPath + randFilename;
MainCp.name := '';
end;
{ ******************************** Menu ************************************ }
function LoadXMLFlameText(filename, name: string) : string;
var
i, p: integer;
FileStrings: TStringList;
ParamStrings: TStringList;
Tokens: TStringList;
time: integer;
begin
time := -1;
FileStrings := TStringList.Create;
ParamStrings := TStringList.Create;
Result := '';
if pos('*untitled', name) <> 0 then
begin
Tokens := TStringList.Create;
GetTokens(name, tokens);
time := StrToInt(tokens[1]);
Tokens.free;
end;
try
{ if UpperCase(ExtractFileExt(filename)) = '.PNG' then
FileStrings.Text := MainForm.LoadXMLFlameTextPNG(filename)
else }
FileStrings.LoadFromFile(filename);
for i := 0 to FileStrings.Count - 1 do
begin
pname := '';
ptime := '';
p := Pos('<flame ', LowerCase(FileStrings[i]));
if (p <> 0) then
begin
MainForm.ListXMLScanner.LoadFromBuffer(TCharType(TStringType(FileStrings[i])));
MainForm.ListXMLScanner.Execute;
if pname <> '' then
begin
if (Trim(pname) = Trim(name)) then
begin
ParamStrings.Add(FileStrings[i]);
Break;
end;
end
else
begin
if ptime <> '' then
begin
if StrToInt(ptime) = time then
begin
ParamStrings.Add(FileStrings[i]);
Break;
end;
end;
end;
end;
end;
repeat
inc(i);
ParamStrings.Add(FileStrings[i]);
until pos('</flame>', Lowercase(FileStrings[i])) <> 0;
Result := ParamStrings.Text;
finally
FileStrings.free;
ParamStrings.free;
end;
end;
procedure AddThumbnail(renderer : TRenderer; width, height : double);
var
Bmp: TBitmap;
x, y : double;
begin
Bmp := TBitmap.Create;
Bmp.PixelFormat := pf24bit;
Bmp.HandleType := bmDIB;
Bmp.Width := ThumbnailSize;
Bmp.Height := ThumbnailSize;
x := ThumbnailSize / 2;
y := ThumbnailSize / 2;
x := x - width / 2;
y := y - height / 2;
with Bmp.Canvas do begin
Brush.Color := GetSysColor(5); // window background
FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
Draw(round(x), round(y), renderer.GetImage);
end;
MainForm.UsedThumbnails.Add(bmp, nil);
if (Bmp <> nil) then Bmp.Free;
end;
function ScanVariations(name:string):boolean;
var
i,count:integer;
vname:string;
begin
count:=NrVar;
for i:=0 to count - 1 do
begin
vname := VarNames(i);
if (vname = name) then
begin
Result := true;
exit;
end;
end;
for i := 0 to MainForm.SubstSource.Count - 1 do
begin
vname := MainForm.SubstSource[i];
if (vname = name) then
begin
Result := true;
exit;
end;
end;
Result := false;
end;
function ScanVariables(name:string):boolean;
var
i,count:integer;
begin
count:=GetNrVariableNames;
for i:=0 to count - 1 do
begin
if (GetVariableNameAt(i) = name) then
begin
Result := true;
exit;
end;
end;
for i := 0 to MainForm.SubstSource.Count - 1 do
begin
if (MainForm.SubstSource[i] = name) then
begin
Result := true;
exit;
end;
end;
Result := false;
end;
procedure TMainForm.mnuOpenClick(Sender: TObject);
var
fn: string;
begin
//ScriptEditor.Stopped := True;
MainMenuClick(nil); // AV
OpenDialog.Filter := TextByKey('common-filter-flamefiles') + '|*.flame;*.xml|'
+ TextByKey('common-filter-templatefiles') + ' |*.template;*.temp|'
+ TextByKey('common-filter-undofiles') + '|*.undo;*.apo|'
+ TextByKey('common-filter-allfiles') + '|*.*';
OpenDialog.InitialDir := ParamFolder;
OpenDialog.FileName := '';
if OpenSaveFileDialog(MainForm, '.flame', OpenDialog.Filter, OpenDialog.InitialDir,
TextByKey('common-browse'), fn, true, false, false, true) then
begin
OpenDialog.FileName := fn;
MainForm.CurrentFileName := OpenDialog.FileName;
LastOpenFile := OpenDialog.FileName;
Maincp.name := '';
ParamFolder := ExtractFilePath(OpenDialog.FileName);
OpenFile := OpenDialog.FileName;
//MainForm.Caption := AppVersionString + ' - ' + OpenFile; // --Z--
if APP_BUILD = '' then MainForm.Caption := AppVersionString + ' - ' + openFile
else MainForm.Caption := AppVersionString + ' ' + APP_BUILD + ' - ' + openFile;
OpenFileType := ftXML;
(* if UpperCase(ExtractFileExt(OpenDialog.FileName)) = '.IFS' then
begin
OpenFileType := ftIfs;
Variation := vLinear;
VarMenus[0].Checked := True;
end; *)
if (UpperCase(ExtractFileExt(OpenDialog.FileName)) = '.UNDO') or
(UpperCase(ExtractFileExt(OpenDialog.FileName)) = '.APO') then
OpenFileType := ftFla; // AV
if OpenFileType = ftXML then
ListXML(OpenDialog.FileName, 1)
else
ListIFS(OpenDialog.FileName, 1);
end;
end;
procedure TMainForm.mnuNextClick(Sender: TObject);
begin
with ListView1 do
if Items.Count <> 0 then
Selected := Items[(Selected.Index + 1) mod Items.Count];
end;
procedure TMainForm.mnuPreviousClick(Sender: TObject);
var
i: integer;
begin
with ListView1 do
if Items.Count <> 0 then
begin
i := Selected.Index - 1;
if i < 0 then i := Items.Count - 1;
Selected := Items[i];
end;
end;
procedure TMainForm.mnuListRenameClick(Sender: TObject);
var
i: integer;
begin
if ListView1.SelCount <> 0 then
begin
if (UndoIndex <> 0) then // AV
if Application.MessageBox(PChar(Format(TextByKey('common-confirmrename'),
[ListView1.Selected.Caption])), 'Apophysis AV', 36) <> IDYES then exit;
ListView1.Items[ListView1.Selected.Index].EditCaption;
end;
end;
procedure TMainForm.mnuCopyUPRClick(Sender: TObject);
begin
Clipboard.SetTextBuf(PChar(UPRString(MainCp, Maincp.name)));
end;
procedure TMainForm.mnuItemDeleteClick(Sender: TObject);
var
c: boolean;
begin
if ListView1.SelCount <> 0 then
begin
if ConfirmDelete then
begin
if (UndoIndex <> 0) then // AV: if the flame is not saved in the list
c := Application.MessageBox(
PChar(Format(TextByKey('common-confirmdelete'), [ListView1.Selected.Caption])
+ #32 + TextByKey('common-deletecurrent')), 'Apophysis', 36) = IDYES
else
c := Application.MessageBox(
PChar(Format(TextByKey('common-confirmdelete'), [ListView1.Selected.Caption])), 'Apophysis', 36) = IDYES
end
else
c := True;
if c then
if ListView1.Focused and (ListView1.SelCount <> 0) then
begin
Application.ProcessMessages;
if OpenFileType = ftXML then
DeleteXMLEntry(ListView1.Selected.Caption, OpenFile)
else
DeleteEntry(ListView1.Selected.Caption, OpenFile);
{
if (ListView1.Selected.Index >= 0) and (ListView1.Selected.Index < UsedThumbnails.Count)
and (not ClassicListMode) then
UsedThumbnails.Delete(ListView1.Selected.Index);
}
ListView1.Items.Delete(ListView1.Selected.Index);
Application.ProcessMessages;
ListView1.Selected := ListView1.ItemFocused;
// AV: re-adjust the displayed numbers...
if EnumerateFlames.Checked then EnumerateFlamesClick(EnumerateFlames);
(*
// AV: I set ListView1.IconOptions.AutoArrange := True;
// for auto-updating the flame list without redrawing the thumbs.
// An alternative (but slow) way to do the same thing:
if ListView1.Items.Count > 0 then // refresh the list
begin
i := ListView1.ItemFocused.Index; // AV
if OpenFileType = ftXML then
UpdateThumbnails // AV
else
ListIFS(OpenFile, 2); // AV: for undo files
// AV: now scroll to the nearest item
i := min(i, ListView1.Items.Count - 1);
ListView1.Selected := ListView1.Items[i];
ListView1.Items[i].MakeVisible(true);
end;
*)
end;
end;
end;
procedure TMainForm.mnuOptionsClick(Sender: TObject);
var isSmallThumb: boolean;
begin
isSmallThumb := UseSmallThumbnails; // AV
OptionsForm.ShowModal;
// --Z--
StopThread;
RedrawTimer.Enabled := True;
tbQualityBox.Text := FloatToStr(defSampleDensity);
tbShowAlpha.Down := ShowTransparency;
if (isSmallThumb <> UseSmallThumbnails) then // update the thumbs
begin
SetThumbnailProperties; // AV
UpdateThumbnails; // AV
end;
if EnumerateFlames.Checked then EnumerateFlamesClick(EnumerateFlames); // AV
DrawImageView;
UpdateWindows;
end;
procedure TMainForm.mnuRefreshClick(Sender: TObject);
begin
RedrawTimer.enabled := true;
end;
procedure TMainForm.mnuRefreshThumbClick(Sender: TObject);
begin
if (ListView1.Selected = nil) or ParseLoadingBatch then exit;
RefreshThumbnail; // current only
end;
procedure TMainForm.mnuNormalWeightsClick(Sender: TObject);
begin
StopThread;
UpdateUndo;
// TODO: ...something <-- AV: something's done :)
MainCp.NormalizeProbabilities;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuRWeightsClick(Sender: TObject);
begin
StopThread;
UpdateUndo;
inc(MainSeed);
RandSeed := MainSeed;
MainCp.RandomizeWeights;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuRandomBatchClick(Sender: TObject);
begin
//ScriptEditor.Stopped := True;
MainMenuClick(nil); // AV
inc(MainSeed);
RandSeed := MainSeed;
RandomBatch;
OpenFile := AppPath + randFilename;
OpenFileType := ftXML;
MainForm.Caption := AppVersionString + ' - ' + TextByKey('main-common-randombatch');
ListXML(OpenFile, 1);
ListView1.SetFocus; // AV
if batchsize = 1 then DrawFlame;
end;
function GradientString(c: TColorMap): string;
var
strings: TStringList;
i, j, cl: integer;
begin
strings := TStringList.Create;
for i := 0 to 255 do
begin
j := round(i * (399 / 255));
cl := (c[i][2] shl 16) + (c[i][1] shl 8) + (c[i][0]);
strings.Add(' index=' + IntToStr(j) + ' color=' + intToStr(cl));
end;
Result := Strings.Text;
strings.Free;
end;
function TMainForm.UPRString(cp1: TControlPoint; Entry: string): string;
{ Returns a string containing an Ultra Fractal parameter set for copying
or saving to file }
var
IterDensity, m, i, j: integer;
scale, a, b, c, d, e, f, p, v: double;
GradStrings, Strings: TStringList;
rept, cby, smap, sol: string;
uprcenter: array[0..1] of double; // camera center
Backcolor: longint;
xf_str: string;
begin
cp1.Prepare;
uprcenter[0] := cp1.Center[0];
uprcenter[1] := cp1.Center[1];
cp1.Width := UPRWidth;
cp1.Height := UPRHeight;
scale := power(2, cp1.zoom) * CalcUPRMagn(cp1);
cp1.center[0] := uprCenter[0];
cp1.center[1] := uprCenter[1];
smap := 'no';
sol := 'no';
rept := '';
cby := 'Hit Frequency';
Strings := TStringList.Create;
GradStrings := TStringList.Create;
try
Strings.Add(CleanEntry(Entry) + ' {');
Strings.Add('fractal:');
Strings.Add(' title="' + CleanUPRTitle(Entry) +
'" width=' + IntToStr(UPRWidth) + ' height=' + IntToStr(UPRHeight) + ' layers=1');
Strings.Add('layer:');
Strings.Add(' method=linear caption="Background" opacity=100 mergemode=normal');
Strings.Add('mapping:');
Strings.Add(' center=' + floatToStr(cp1.center[0]) + '/' + floatToStr(-cp1.center[1]) +
' magn=' + FloatToStr(scale));
Strings.Add('formula:');
Strings.Add(' maxiter=1 filename="' + UPRFormulaFile + '" entry="' + UPRFormulaIdent + '"');
Strings.Add('inside:');
Strings.Add(' transfer=none');
Strings.Add('outside:');
Strings.Add(' transfer=linear repeat=no ' + 'filename="' + UPRColoringFile + '" entry="'
+ UPRColoringIdent + '"');
if (UPRAdjustDensity) and (scale > 1) then
IterDensity := Trunc(UPRSampleDensity * scale * scale)
else
IterDensity := UPRSampleDensity;
Strings.Add(' p_iter_density=' + IntToStr(IterDensity) + ' p_spat_filt_rad=' +
Format('%.3g', [UPRFilterRadius]) + ' p_oversample=' + IntToStr(UPROversample));
backcolor := 255 shl 24 + cp1.background[0] shl 16 + cp1.background[1] shl 8 + cp1.background[2];
Strings.Add(' p_bk_color=' + IntToStr(Backcolor) + ' p_contrast=' + FloatToStr(cp1.Contrast) +
' p_brightness=' + FloatToStr(cp1.Brightness) + ' p_gamma=' + FloatToStr(cp1.Gamma));
Strings.Add(' p_white_level=200 p_xforms=' + inttostr(Transforms));
for m := 0 to Transforms do
begin
a := cp1.xform[m].c[0][0];
c := cp1.xform[m].c[0][1];
b := cp1.xform[m].c[1][0];
d := cp1.xform[m].c[1][1];
e := cp1.xform[m].c[2][0];
f := cp1.xform[m].c[2][1];
p := cp1.xform[m].Density;
if m < Transforms then xf_str := 'p_xf' + inttostr(m)
else begin
if cp1.HasFinalXForm = false then break;
xf_str := 'p_finalxf';
end;
Strings.Add(' ' + xf_str + '_p=' + Format('%.6g ', [p]));
Strings.Add(' ' + xf_str + '_c=' + floatTostr(cp1.xform[m].color));
Strings.Add(' ' + xf_str + '_sym=' + floatTostr(cp1.xform[m].symmetry));
Strings.Add(' ' + xf_str + '_cfa=' + Format('%.6g ', [a]) +
xf_str + '_cfb=' + Format('%.6g ', [b]) +
xf_str + '_cfc=' + Format('%.6g ', [c]) +
xf_str + '_cfd=' + Format('%.6g ', [d]));
Strings.Add(' ' + xf_str + '_cfe=' + Format('%.6g ', [e]) +
' ' + xf_str + '_cff=' + Format('%.6g ', [f]));
for i := 0 to NRVAR-1 do
if cp1.xform[m].GetVariation(i) <> 0 then begin
Strings.Add(' ' + xf_str + '_var_' + VarNames(i) + '=' +
floatToStr(cp1.xform[m].GetVariation(i)));
for j:= 0 to GetNrVariableNames - 1 do begin
{$ifndef VAR_STR}
cp1.xform[m].GetVariable(GetVariableNameAt(j), v);
Strings.Add(' ' + xf_str + '_par_' + GetVariableNameAt(j) + '=' + floatToStr(v));
{$else}
Strings.Add(' ' + xf_str + '_par_' +
GetVariableNameAt(j) + '=' + cp1.xform[m].GetVariableStr(GetVariableNameAt(j)));
{$endif}
end;
end;
end;
Strings.Add('gradient:');
Strings.Add(GradientString(cp1.cmap));
Strings.Add('}');
UPRString := Strings.Text;
finally
GradStrings.Free;
Strings.Free;
end;
end;
procedure TMainForm.mnuRandomClick(Sender: TObject);
begin
StopThread;
UpdateUndo;
inc(MainSeed);
RandomizeCP(MainCp);
inc(RandomIndex);
MainCp.name := RandomPrefix + RandomDate + '-' +
IntToStr(RandomIndex);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
if AdjustForm.visible then AdjustForm.UpdateDisplay;
StatusBar.Panels[3].text := maincp.name;
ResetLocation;
RedrawTimer.Enabled := true;
UpdateWindows;
end;
procedure TMainForm.mnuEqualizeClick(Sender: TObject);
begin
StopThread;
UpdateUndo;
MainCP.EqualizeWeights;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuEditorClick(Sender: TObject);
begin
EditForm.Show;
end;
procedure TMainForm.mnuExitClick(Sender: TObject);
begin
MainMenuClick(nil); // AV
Close;
end;
procedure TMainForm.mnuSaveUPRClick(Sender: TObject);
{ Write a UPR to a file }
begin
SaveForm.SaveType := stExportUPR;
SaveForm.Filename := UPRPath + 'Apophysis.upr'; // AV
SaveForm.Title := maincp.name;
if SaveForm.ShowModal = mrOK then
begin
UPRPath := SaveForm.FileName;
SaveUPR(SaveForm.Title, SaveForm.Filename);
end;
end;
procedure TMainForm.mnuSaveAsClick(Sender: TObject);
{ Save parameters to a file }
var saved: boolean; // AV
begin
SaveForm.SaveType := stSaveParameters;
SaveForm.Filename := SavePath;
SaveForm.Title := maincp.name;
if SaveForm.ShowModal = mrOK then
begin
maincp.name := SaveForm.Title;
SavePath := SaveForm.Filename;
if ExtractFileExt(SavePath) = '' then
SavePath := SavePath + '.flame';
if (LowerCase(ExtractFileExt(SaveForm.Filename)) = '.undo') or
(LowerCase(ExtractFileExt(SaveForm.Filename)) = '.apo') then
saved := SaveFlame(maincp, maincp.name, SavePath) // AV
else
saved := SaveXMLFlame(maincp, maincp.name, SavePath);
StatusBar.Panels[3].Text := maincp.name;
if (SavePath = OpenFile) and saved then // AV: added status check
begin
if OpenFileType = ftXML then
// AV: fixed re-saving error with OpenDialog.FileName!
ListXML(OpenFile, 2, maincp.name) // AV: remember the current position
else
ListIFS(OpenFile, 0); // AV: fixed re-saving error!
end;
end;
end;
procedure TMainForm.mnuSaveAllAsClick(Sender: TObject);
{ Save all parameters to a file }
var
i, current: integer;
currentXML : string;
begin
SaveForm.SaveType := stSaveAllParameters;
SaveForm.Filename := SavePath;
if SaveForm.ShowModal = mrOK then
begin
SavePath := SaveForm.Filename;
if ExtractFileExt(SavePath) = '' then
SavePath := SavePath + '.flame';
current := ListView1.ItemIndex;
currentXML := Trim(FlameToXML(Maincp, false, true));
for i := 0 to ListView1.Items.Count-1 do
begin
// -X- what if there are unsaved changes at the current CP?
// AV: this only can be if UndoIndex <> 0
if (i = current) and (UndoIndex <> 0) then begin
ParseXML(maincp, PCHAR(currentXML), true);
SaveXMLFlame(maincp, maincp.name, SavePath);
end else begin
// AV: cancel unneseccary multiple preview updated
LoadXMLFlame(OpenFile, ListView1.Items.Item[i].Caption, false);
SaveXMLFlame(maincp, maincp.name, SavePath);
end;
MainForm.LoadSaveProgress.Position :=
round(100 * i / (ListView1.Items.Count - 1)); // AV
end;
MainForm.LoadSaveProgress.Position := 0; // AV
// AV: we don't need to do this because it resets the Undo history!
{
ListXML(SavePath, 2);
if (current < 0) then current := 0;
ListView1.Selected := ListView1.Items[current];
LoadXMLFlame(SavePath, ListView1.Selected.caption);
}
end;
end;
function GradTitle(str: string): string;
var
p: integer;
begin
p := pos('{', str);
GradTitle := Trim(copy(str, 1, p - 1));
end;
procedure TMainForm.DisplayHint(Sender: TObject);
var
T: TComponent;
begin
T := MainForm.FindComponent('StatusBar');
if T <> nil then
if Application.Hint = '' then
begin
TStatusBar(T).SimpleText := '';
TStatusBar(T).SimplePanel := False;
TStatusBar(T).Refresh;
end
else
begin
// AV: fixed - someone forgot to change this property
TStatusBar(T).SimplePanel := True;
TStatusBar(T).SimpleText := Application.Hint;
end;
end;
procedure TMainForm.DownloadPluginsClick(Sender: TObject);
begin
AboutForm.lblPluginsClick(nil);
end;
procedure TMainForm.MainMenuClick(Sender: TObject);
begin
try // AV: sometimes this damn Stopped causes AccessViolations...
if ScriptEditor.btnPause.Down then ScriptEditor.btnPause.Click; // AV
ScriptEditor.Stopped := True;
except
// ?
end;
end;
procedure TMainForm.mnuScreenShotClick(Sender: TObject);
begin
SaveScreenShot('Apophysis Main Window');
end;
{ ********************************* Form ************************************ }
procedure TMainForm.FavoriteClick(Sender: TObject);
var
i: integer;
s: string;
begin
i := TMenuItem(Sender).Tag;
Script := favorites[i];
if FileExists(Script) then
begin
ScriptEditor.Editor.Lines.LoadFromFile(Script);
s := ExtractFileName(Script);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
mnuRun.Caption := Format(TextByKey('main-menu-script-run2'), [s]);
btnRunScript.Hint := Format(TextByKey('main-menu-script-run2'), [s]);
ScriptEditor.Caption := s;
ScriptEditor.RunScript;
end else
TMenuItem(Sender).Enabled := False;
end;
procedure TMainForm.ScriptItemClick(Sender: TObject);
var
s: string;
begin
s := AppPath + 'Scripts\' + TMenuItem(Sender).Caption;
// AV: fixed Apo7X bug that didn't recognize the new extension
if TMenuItem(Sender).Tag = 1 then
s := s + '.aposcript'
else
s := s + '.asc';
if FileExists(s) then
begin
Script := s;
ScriptEditor.Editor.Lines.LoadFromFile(Script);
s := ExtractFileName(Script);
s := RemoveExt(s);
mnuRun.Caption := Format(TextByKey('main-menu-script-run2'), [s]);
btnRunScript.Hint := Format(TextByKey('main-menu-script-run2'), [s]);
ScriptEditor.Caption := s;
ScriptEditor.RunScript;
end else // if the script was removed or renamed
TMenuItem(Sender).Visible := False;
end;
procedure TMainForm.GetScripts;
var
NewItem, NewItem2, MenuItem: TMenuItem;
searchResult: TSearchRec;
i: integer;
s, path, path1: string;
sl: TStringList;
begin
sl := TStringList.Create;
if FileExists(AppPath + scriptFavsFilename) then
begin
Favorites.LoadFromFile(AppPath + scriptFavsFilename);
if Trim(Favorites.Text) <> '' then
begin
if Favorites.count <> 0 then
begin
FavouriteScripts1.Enabled := True;
FavouriteScripts1.Clear; // AV: refresh the menu everytime it updates
for i := 0 to Favorites.Count - 1 do
begin
if FileExists(Favorites[i]) then
begin
NewItem := TMenuItem.Create(FavouriteScripts1); // (Self);
if i < 12 then
NewItem.ShortCut := TextToShortCut('Ctrl+F' + IntToStr(i + 1));
NewItem.Tag := i;
s := ExtractFileName(Favorites[i]);
sl.Add(s);
s := RemoveExt(s);
MenuItem := Directory1.Find(s); // check the default folder
if (MenuItem <> nil) then
begin
path := LowerCase(ExtractFilePath(Favorites[i]));
if (path = LowerCase(AppPath + 'scripts\')) then
MenuItem.Free;
end;
NewItem.Caption := s;
NewItem.Hint := Format(TextByKey('main-menu-script-run3'), [s]);
NewItem.OnClick := FavoriteClick;
OnClick := FavoriteClick;
FavouriteScripts1.Add(NewItem);
end;
end;
end;
Directory1.Caption := TextByKey('main-menu-script-more');
end
else begin // disable unused items
FavouriteScripts1.Enabled := False;
Directory1.Caption := TextByKey('main-menu-script-directory');
end;
end;
// Try to find regular files matching *.asc in the scripts dir
path := AppPath + 'Scripts\*.asc';
if FindFirst(path, faAnyFile, searchResult) = 0 then
begin
Directory1.Enabled := True;
repeat
NewItem2 := TMenuItem.Create(Directory1); // (Self);
s := searchResult.Name;
if (sl.IndexOf(s) < 0) then
begin
s := RemoveExt(s);
NewItem2.AutoHotkeys := maManual; // AV: to prevent underlined letters
NewItem2.Caption := s;
NewItem2.Hint := Format(TextByKey('main-menu-script-run3'), [s]);
NewItem2.OnClick := ScriptItemClick;
if (Directory1.Find(s) = nil) then Directory1.Add(NewItem2);
end;
until (FindNext(searchResult) <> 0);
FindClose(searchResult);
end;
// AV: the same procedure for new extensions
path := AppPath + 'Scripts\*.aposcript';
if FindFirst(path, faAnyFile, searchResult) = 0 then
begin
Directory1.Enabled := True;
repeat
NewItem2 := TMenuItem.Create(Directory1); // (Self);
s := searchResult.Name;
if (sl.IndexOf(s) < 0) then
begin
s := RemoveExt(s);
NewItem2.AutoHotkeys := maManual; // AV: to prevent underlined letters
NewItem2.Caption := s;
NewItem2.Tag := 1; // AV: to identify scripts with different extensions
NewItem2.Hint := Format(TextByKey('main-menu-script-run3'), [s]);
NewItem2.OnClick := ScriptItemClick;
if (Directory1.Find(s) = nil) then Directory1.Add(NewItem2);
end;
until (FindNext(searchResult) <> 0);
FindClose(searchResult);
end;
if (Directory1.Count = 0) then Directory1.Enabled := False; // AV
sl.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
dte: string;
cmdl : TCommandLine;
Registry: TRegistry;
apoUI: string;
Layouts: array[0..7] of THandle;
lnum, i: byte;
ExtSM: HMenu;
extStyle: TSearchRec;
begin
ApophysisSVN := APP_VERSION;
AppVersionString := APP_NAME +' '+ APP_VERSION;
SubstSource := TStringList.Create;
SubstTarget := TStringList.Create;
CreateSubstMap;
TbBreakWidth := 802;
ListXmlScanner := TEasyXmlScanner.Create(nil);
XmlScanner := TXmlScanner.Create(nil);
MainForm.ListXmlScanner.Normalize := False;
MainForm.ListXmlScanner.OnStartTag := ListXmlScannerStartTag;
MainForm.XmlScanner.Normalize := False;
MainForm.XmlScanner.OnContent := XmlScannerContent;
MainForm.XmlScanner.OnEmptyTag := XMLScannerEmptyTag;
MainForm.XmlScanner.OnEndTag := XmlScannerEndTag;
MainForm.XmlScanner.OnStartTag := XMLScannerStartTag;
AppPath := ExtractFilePath(Application.ExeName); // AV: moved here
ReadSettings;
InternalBitsPerSample := 0; // AV: now unused
// renderBitsPerSample := 0;
//SaveSettings;
LoadLanguage(LanguageFile);
InsertStrings;
AvailableLanguages := TStringList.Create;
AvailableLanguages.Add('');
ListLanguages;
MissingPluginList := TStringList.Create; // AV
C_SyncDllPlugins;
cmdl := TCommandLine.Create;
cmdl.Load;
if (NXFORMS > 100) then
AppVersionString := AppVersionString + ' (' + TextByKey('main-common-title-t500') + ')'
else if (NXFORMS < 100) or (cmdl.Lite) then
AppVersionString := AppVersionString + ' (' + TextByKey('main-common-title-lite') + ')';
SplashWindow.SetInfo(TextByKey('splash-loadingui'));
{ //*************** GUI Style Stuff *****************************// }
// AV: trying to load externals GUI styles
apoUI := AppPath + 'Styles\';
if FindFirst(apoUI + '*.vsf', faAnyFile, extStyle) = 0 then
begin
repeat
if TStyleManager.IsValidStyle(apoUI + extStyle.Name) then
TStyleManager.LoadFromFile(apoUI + extStyle.Name);
until (FindNext(extStyle) <> 0);
FindClose(extStyle);
end;
{ AV: Read Apophysis style name from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Defaults', False) then
if Registry.ValueExists('UIStyle') then begin
apoUI := Registry.ReadString('UIStyle');
TStyleManager.TrySetStyle(apoUI, false);
end;
Registry.CloseKey;
finally
Registry.Free;
end;
CreateStyleList; // create Apo GUI style menu...
ApplyThemedColors; // AV
{ //******************************************************************// }
Screen.Cursors[crEditArrow] := LoadCursor(HInstance, 'ARROW_WHITE');
Screen.Cursors[crEditMove] := LoadCursor(HInstance, 'MOVE_WB');
Screen.Cursors[crEditRotate] := LoadCursor(HInstance, 'ROTATE_WB');
Screen.Cursors[crEditScale] := LoadCursor(HInstance, 'SCALE_WB');
Caption := AppVersionString + APP_BUILD;
mnuExportFLame.Enabled := FileExists(flam3Path);
mnuExportChaotica.Enabled := FileExists(chaoticaPath + '\chaotica.exe');
// AV: hack for creating screenshots of Apo windows
ExtSM := GetSystemMenu(Handle, False);
InsertMenu(ExtSM, UINT(5), MF_ByPosition or MF_Separator, 0, nil);
InsertMenu(ExtSM, UINT(6), MF_ByPosition, $C0, PChar(TextByKey('main-menu-screenshot')));
FMouseMoveState := msDrag;
LimitVibrancy := False;
Favorites := TStringList.Create;
GetScripts;
Randomize;
MainSeed := Random(123456789);
maincp := TControlPoint.Create;
ParseCp := TControlPoint.create;
MemCp := TControlPoint.Create; // AV
OpenFileType := ftXML;
Application.OnHint := DisplayHint;
CanDrawOnResize := False;
SplashWindow.SetInfo(TextByKey('splash-loadingsettings'));
Dte := FormatDateTime('yymmdd', Now);
if Dte <> RandomDate then
RandomIndex := 0;
RandomDate := Dte;
mnuExit.ShortCut := TextToShortCut('Alt+F4');
defKB := Screen.DefaultKbLayout;
if SetEngLayout then // AV: switch to English language if needed
begin
lnum := GetKeyboardLayoutList(High(Layouts) + 1, Layouts);
for i := 0 to lnum-1 do
if (LoWord(Layouts[i]) and $FF) = Lang_English then
begin
ActivateKeyboardLayout(Layouts[i], 0);
PInteger(@Screen.DefaultKbLayout)^ := -1; // AV: hack - to rewrite a read-only value
break;
end;
end;
SplashWindow.SetInfo(TextByKey('splash-loadingplugins'));
FillVariantMenu;
tbQualityBox.Text := FloatToStr(defSampleDensity);
tbShowAlpha.Down := ShowTransparency;
DrawSelection := true;
FViewScale := 1;
{ ************ AV: setting flame thumbnails properties *************}
case ThumbPrevQual of
0: begin
TThumbnailThread.FPreviewDensity := prevLowQuality;
mnuLowQuality.Checked := True;
end;
1: begin
TThumbnailThread.FPreviewDensity := prevMediumQuality;
mnuMediumQuality.Checked := True;
end;
2: begin
TThumbnailThread.FPreviewDensity := prevHighQuality;
mnuHighQuality.Checked := True;
end;
else TThumbnailThread.FPreviewDensity := 1; // just in case...
end;
ThumbnailPlaceholder := TBitmap.Create; // AV
SetThumbnailProperties; // AV
// AV: deleted duplicated image lists to reduce memory allocation
ListView1.LargeImages := UsedThumbnails;
// AV: to prevent updating flame list before it's created
GeneratingThumbs := True;
{ *******************************************************************}
if not cmdl.Lite then
begin
if ClassicListMode = true then
btnViewListClick(nil)
else
btnViewIconsClick(nil);
end else
begin // AV: Lite version from command line cannot change NXFORM const :(
ListView1.ViewStyle := vsReport;
ToolBar.Perform(CM_CONTROLCHANGE, WPARAM(btnViewList), 0);
ToolBar.Perform(CM_CONTROLCHANGE, WPARAM(btnViewIcons), 0);
ToolBar.Perform(CM_CONTROLCHANGE, WPARAM(ToolButton9), 0);
TbBreakWidth := TbBreakWidth - (2 * 26 + 1 * 8);
end;
cmdl.Free; // <-- AV: fixed memory leak
SaveSettings; // AV: moved back from top to the end
end;
procedure TMainForm.FormShow(Sender: TObject);
var
Registry: TRegistry;
i: integer;
index: integer;
mins:integer;
cmdl : TCommandLine;
fn, flameXML : string;
openScript: string;
autoScript: TStringList; // AV
begin
tbGuides.Down := EnableGuides;
{ Read position from registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Main', False) then
begin
if Registry.ValueExists('Left') then
MainForm.Left := Registry.ReadInteger('Left');
if Registry.ValueExists('Top') then
MainForm.Top := Registry.ReadInteger('Top');
if Registry.ValueExists('Width') then
MainForm.Width := Registry.ReadInteger('Width');
if Registry.ValueExists('Height') then
MainForm.Height := Registry.ReadInteger('Height');
if Registry.ValueExists('SortFlames') then // AV
begin
if Registry.ReadBool('SortFlames') then SortFlames.Click;
end;
if Registry.ValueExists('EnumerateFlames') then // AV
EnumerateFlames.Checked := Registry.ReadBool('EnumerateFlames');
end;
Registry.CloseKey;
if Registry.OpenKey('\Software\' + APP_NAME + '\Defaults', False) then
begin // AV
if Registry.ValueExists('RandBackColor') then
RandBackColor := Registry.ReadInteger('RandBackColor')
else RandBackColor := 0; // AV
end;
Registry.CloseKey;
finally
Registry.Free;
end;
{ Synchronize menus etc..}
// should be defaults....
SplashWindow.SetInfo(TextByKey('splash-initrenderer'));
UndoIndex := 0;
UndoMax := 0;
index := 1;
ListView1.RowSelect := True;
inc(MainSeed);
RandSeed := MainSeed;
Variation := vRandom;
Maincp.brightness := defBrightness;
maincp.contrast := defContrast; // AV
maincp.gamma := defGamma;
maincp.vibrancy := defVibrancy;
maincp.sample_density := defSampleDensity;
maincp.spatial_oversample := defOversample;
maincp.spatial_filter_radius := defFilterRadius;
maincp.gammaThreshRelative := defGammaThreshold;
if KeepBackGround and (RandBackColor <> 0) then begin // AV
maincp.background[0] := RandBackColor and 255;
maincp.background[1] := RandBackColor shr 8 and 255;
maincp.background[2] := RandBackColor shr 16 and 255;
end;
inc(MainSeed);
RandSeed := MainSeed;
// somehow this doesn't work:
// Image.Width := BackPanel.Width - 2;
// Image.Height := BackPanel.Height - 2;
// so we'll do it 'bad' way ;-)
Image.Align := alNone;
SplashWindow.SetInfo(TextByKey('splash-initcolormap'));
if FileExists(AppPath + 'Gradients\default.map') then
begin
DefaultPalette := GradientBrowser.LoadFractintMap(AppPath + 'Gradients\default.map');
maincp.cmap := DefaultPalette;
end
else
begin
cmap_index := random(NRCMAPS);
GetCMap(cmap_index, 1, maincp.cmap);
DefaultPalette := maincp.cmap;
end;
if FileExists(AppPath + randFilename) then
DeleteFile(AppPath + randFilename);
cmdl := TCommandLine.Create;
cmdl.Load;
openScript := '';
// get filename from command line argument
SplashWindow.SetInfo(TextByKey('splash-initbatch'));
if ParamCount > 0 then
openFile := ParamStr(1)
else
openFile := defFlameFile;
if ((openFile = '') or (not FileExists(openFile))) and RememberLastOpenFile then begin
openFile := LastOpenFile;
index := LastOpenFileEntry;
end;
// if FileExists(openFile) and ((LowerCase(ExtractFileExt(OpenFile)) <> '.asc') or (LowerCase(ExtractFileExt(OpenFile)) <> '.aposcript')) then begin
// AV: something's wrong here...
if FileExists(openFile) and (not ((LowerCase(ExtractFileExt(OpenFile)) = '.asc') or (LowerCase(ExtractFileExt(OpenFile)) = '.aposcript'))) then begin
LastOpenFile := openFile;
LastOpenFileEntry := index;
end;
// if (openFile = '') or (not FileExists(openFile)) and ((LowerCase(ExtractFileExt(OpenFile)) <> '.asc') or (LowerCase(ExtractFileExt(OpenFile)) <> '.aposcript')) then
// AV: something's wrong here...
if (openFile = '') or (not FileExists(openFile)) and
(not ((LowerCase(ExtractFileExt(OpenFile)) = '.asc') or (LowerCase(ExtractFileExt(OpenFile)) = '.aposcript'))) then
begin
MainCp.Width := Image.Width;
MainCp.Height := Image.Height;
RandomBatch;
if APP_BUILD = '' then
MainForm.Caption := AppVersionString + ' - ' + TextByKey('main-common-randombatch')
else
MainForm.Caption := AppVersionString + ' ' + APP_BUILD + ' - ' + TextByKey('main-common-randombatch');
OpenFile := AppPath + randFilename;
ListXML(OpenFile, 1);
OpenFileType := ftXML;
if batchsize = 1 then DrawFlame;
end
else
begin
if (LowerCase(ExtractFileExt(OpenFile)) = '.apo') or (LowerCase(ExtractFileExt(OpenFile)) = '.undo') then
begin
ListFlames(OpenFile, 1);
OpenFileType := ftFla;
end else
if (LowerCase(ExtractFileExt(OpenFile)) = '.asc') or (LowerCase(ExtractFileExt(OpenFile)) = '.aposcript') then
begin
openScript := OpenFile;
RandomBatch;
if APP_BUILD = '' then
MainForm.Caption := AppVersionString + ' - ' + TextByKey('main-common-randombatch')
else
MainForm.Caption := AppVersionString + ' ' + APP_BUILD + ' - ' + TextByKey('main-common-randombatch');
OpenFile := AppPath + randFilename;
ListXML(OpenFile, 1);
OpenFileType := ftXML;
if batchsize = 1 then DrawFlame;
end else begin
ListXML(OpenFile, 2);
OpenFileType := ftXML;
MainForm.ListView1.Selected := MainForm.ListView1.Items[index - 1];
end;
if APP_BUILD = '' then MainForm.Caption := AppVersionString + ' - ' + openFile
else MainForm.Caption := AppVersionString + ' ' + APP_BUILD + ' - ' + openFile;
end;
ListView1.SetFocus; // AV
CanDrawOnResize := True;
Statusbar.Panels[3].Text := maincp.name;
AdjustForm.cmbPalette.Items.clear;
for i := 0 to NRCMAPS -1 do
AdjustForm.cmbPalette.Items.Add(cMapnames[i]);
AdjustForm.cmbPalette.ItemIndex := 0;
// ExportDialog.cmbDepth.ItemIndex := 2; // AV: changed inside ExportForm
// DoNotAskAboutChange := false;
if (AutoSaveFreq = 0) then mins := 1
else if (AutoSaveFreq = 1) then mins := 2
else if (AutoSaveFreq = 2) then mins := 5
else if (AutoSaveFreq = 3) then mins := 10
else begin
mins := 5;
AutoSaveFreq := 2;
AutoSaveEnabled := false;
end;
AutoSaveTimer.Interval := 60 * 1000 * mins;
AutoSaveTimer.Enabled := AutoSaveEnabled;
// loading done..now do what is told by cmdline ...
if (cmdl.CreateFromTemplate) then begin
if FileExists(cmdl.TemplateFile) then begin
fn := cmdl.TemplateFile;
flameXML := LoadXMLFlameText(fn, cmdl.TemplateName);
UpdateUndo;
ScriptEditor.Stopped := True;
StopThread;
InvokeLoadXML(flameXML);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
Statusbar.Panels[3].Text := MainCp.name;
ResizeImage;
RedrawTimer.Enabled := True;
Application.ProcessMessages;
UpdateWindows;
//AdjustForm.TemplateRandomizeGradient;
AdjustForm.mnuRandomize.Click;
end;
end;
cmdl.Free; // <-- AV: fixed memory leak
// .. and run autoexec.asc
SplashWindow.SetInfo(TextByKey('splash-execstartupscript'));
if (FileExists(AppPath + 'autoexec.asc')) then
begin
// AV: first we must check that the file is not empty
autoScript := TStringList.Create;
autoScript.LoadFromFile(AppPath + 'autoexec.asc');
if Trim(autoScript.Text) <> '' then // AV
begin
ScriptEditor.LoadRunAndClear(AppPath + 'autoexec.asc');
mnuRun.Caption := TextByKey('main-menu-script-run');
btnRunScript.Hint := TextByKey('main-menu-script-run');
end;
autoScript.Free;
end;
if (openScript <> '') then begin
ScriptEditor.LoadScriptFile(openScript);
ScriptEditor.Show;
end;
if ScriptEditor.Editor.IsEmpty then // AV: is there any code?
begin
mnuStop.Enabled := False;
btnStopScript.Enabled := False;
end;
SplashWindow.Hide;
SplashWindow.Free;
end;
function TMainForm.SystemErrorMessage: string;
var
P: PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer + Format_Message_From_System,
nil,
GetLastError,
0,
@P,
0,
nil) <> 0 then
begin
Result := P;
LocalFree(Integer(P))
end
else
Result := '';
end;
function TMainForm.SystemErrorMessage2(errno: cardinal): string;
var
P: PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer + Format_Message_From_System,
nil,
errno,
0,
@P,
0,
nil) <> 0 then
begin
Result := P;
LocalFree(Integer(P))
end
else
Result := '';
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
Registry: TRegistry;
begin
if ConfirmExit and (UndoIndex <> 0) then
if Application.MessageBox(PChar(TextByKey('common-confirmexit')), 'Apophysis', MB_ICONWARNING or MB_YESNO) <> IDYES then
begin
Action := caNone;
exit;
end;
if ScriptEditor.btnPause.Down then ScriptEditor.btnPause.Click; // AV
ScriptEditor.Stopped := True;
HtmlHelp(0, nil, HH_CLOSE_ALL, 0);
{ To capture secondary window positions }
if EditForm.visible then EditForm.Close;
if AdjustForm.visible then AdjustForm.close;
if GradientBrowser.visible then GradientBrowser.close;
if MutateForm.visible then MutateForm.Close;
if ScriptEditor.visible then ScriptEditor.Close;
{ Stop the render thread }
if assigned(Renderer) then Renderer.Terminate;
if assigned(Renderer) then Renderer.WaitFor;
if RenderForm.Visible then RenderForm.Close;
{ Write position to registry }
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Main', True) then
begin
if MainForm.WindowState <> wsMaximized then begin
Registry.WriteInteger('Top', MainForm.Top);
Registry.WriteInteger('Left', MainForm.Left);
Registry.WriteInteger('Width', MainForm.Width);
Registry.WriteInteger('Height', MainForm.Height);
end;
Registry.WriteBool('SortFlames', SortFlames.Checked); // AV
Registry.WriteBool('EnumerateFlames', EnumerateFlames.Checked); // AV
end;
finally
Registry.Free;
end;
Application.ProcessMessages;
CanDrawOnResize := False;
if FileExists(AppPath + randFilename) then
DeleteFile(AppPath + randFilename);
if FileExists(AppPath + undoFilename) then
DeleteFile(AppPath + undoFilename);
if KeepBackGround then // AV
RandBackColor := MainCp.background[2] * 65536 + MainCp.background[1] * 256 + MainCp.background[0];
// AV: remember the flame position if the list was sorted
if assigned(ListView1.Selected) then
LastOpenFileEntry := ListView1.Selected.Index + 1;
SaveSettings;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
var i: word;
begin
if assigned(Renderer) then Renderer.Terminate;
if assigned(Renderer) then Renderer.WaitFor;
if assigned(Renderer) then Renderer.Free;
if assigned(FViewImage) then FViewImage.Free;
ListXmlScanner.Free; // AV: fixed memory leak
XmlScanner.Free; // AV: fixed memory leak
// AV: all memory leaks with cp.used_plugins are fixed
MainCP.free;
ParseCp.free;
MemCp.free; // AV
Favorites.Free;
SubstSource.Free; // AV: fixed memory leak
SubstTarget.Free; // AV: fixed memory leak
MissingPluginList.Free; // AV
if assigned(ThumbnailPlaceholder) then
begin
ThumbnailPlaceholder.Free; // AV: fixed memory leak
ThumbnailPlaceholder := nil;
end;
AvailableLanguages.Free; // AV: fixed memory leak
for i := 0 to length(Translation.language) - 1 do
Translation.language[i].Free; // AV: fixed memory leaks
ActivateKeyboardLayout(defKB, 0); // AV: restore default user's language
end;
procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
var
scale: double;
begin
if Key = #27 then begin
case FMouseMoveState of
msZoomWindowMove:
FMouseMoveState := msZoomWindow;
msZoomOutWindowMove:
FMouseMoveState := msZoomOutWindow;
msDragMove:
begin
FMouseMoveState := msDrag;
scale := FViewScale * Image.Width / FViewImage.Width;
FViewPos.X := FViewPos.X - (FClickRect.Right - FClickRect.Left) / scale;
FViewPos.Y := FViewPos.Y - (FClickRect.Bottom - FClickRect.Top) / scale;
end;
msRotateMove:
FMouseMoveState := msRotate;
end;
DrawImageView;
end;
//ScriptEditor.Stopped := True;
end;
{ ****************************** Misc controls ****************************** }
procedure TMainForm.BackPanelResize(Sender: TObject);
begin
StopThread;
if CanDrawOnResize then
reDrawTimer.Enabled := True;
ResizeImage;
DrawImageView;
end;
// AV: added the third parameter to prevent multiple updates of the previews
procedure TMainForm.LoadXMLFlame(filename, name: string; upd: boolean = true);
var
i, p: integer;
FileStrings: TStringList;
ParamStrings: TStringList;
Tokens: TStringList;
time: integer;
begin
time := -1;
FileStrings := TStringList.Create;
ParamStrings := TStringList.Create;
if pos('*untitled', name) <> 0 then
begin
Tokens := TStringList.Create;
GetTokens(name, tokens);
time := StrToInt(tokens[1]);
Tokens.free;
end;
try
FileStrings.LoadFromFile(filename);
for i := 0 to FileStrings.Count - 1 do
begin
pname := '';
ptime := '';
p := Pos('<flame ', LowerCase(FileStrings[i]));
if (p <> 0) then
begin
MainForm.ListXMLScanner.LoadFromBuffer(TCharType(TStringType(FileStrings[i])));
MainForm.ListXMLScanner.Execute;
if pname <> '' then
begin
if (Trim(pname) = Trim(name)) then
begin
ParamStrings.Add(FileStrings[i]);
Break;
end;
end
else
begin
if ptime='' then ptime:='0'; //hack
if StrToInt(ptime) = time then
begin
ParamStrings.Add(FileStrings[i]);
Break;
end;
end;
end;
end;
repeat
inc(i);
ParamStrings.Add(FileStrings[i]);
until pos('</flame>', Lowercase(FileStrings[i])) <> 0;
//ScriptEditor.Stopped := True; // AV: I hate this...
// If script preview isnit visible, it's useless,
// otherwise it loads wrong flame from sripter...
StopThread;
ParseXML(MainCp,ParamStrings.Text, true);
if upd then
begin // AV: to prevent redrawing when saving a batch
mnuSaveUndo.Enabled := false;
mnuUndo.Enabled := False;
mnuPopUndo.Enabled := False;
mnuRedo.enabled := False;
mnuPopRedo.enabled := False;
EditForm.mnuUndo.Enabled := False;
EditForm.mnuRedo.enabled := False;
EditForm.tbUndo.enabled := false;
EditForm.tbRedo.enabled := false;
AdjustForm.btnUndo.enabled := false;
AdjustForm.btnRedo.enabled := false;
btnUndo.Enabled := false;
btnRedo.enabled := false;
Transforms := MainCp.TrianglesFromCP(MainTriangles);
UndoIndex := 0;
UndoMax := 0;
if fileExists(AppPath + undoFilename) then
DeleteFile(AppPath + undoFilename);
Statusbar.Panels[3].Text := Maincp.name;
RedrawTimer.Enabled := True;
Application.ProcessMessages;
EditForm.SelectedTriangle := 0; // (?)
UpdateWindows;
end; // end updates
finally
FileStrings.free;
ParamStrings.free;
end;
end;
procedure TMainForm.ResizeImage;
var
pw, ph: integer;
begin
pw := BackPanel.Width - 2;
ph := BackPanel.Height - 2;
begin
if (MainCP.Width / MainCP.Height) > (pw / ph) then
begin
Image.Width := pw;
Image.Height := round(MainCP.Height / MainCP.Width * pw);
Image.Left := 1;
Image.Top := (ph - Image.Height) div 2;
end
else begin
Image.Height := ph;
Image.Width := round(MainCP.Width / MainCP.Height * ph);
Image.Top := 1;
Image.Left := (pw - Image.Width) div 2;
end;
end;
//MainCP.AdjustScale(Image.Width, Image.Height);
end;
procedure TMainForm.ListViewColumnClick(Sender: TObject; Column: TListColumn);
begin // AV
if Column = ListView1.Columns[0] then
SortFlames.Click // sorting flames alphabetically or chronologically
else // if Column = ListView1.Columns[1] then
EnumerateFlames.Click;
end;
procedure TMainForm.ListPopUpPopup(Sender: TObject); // AV
var
i: byte;
IsSel: boolean;
begin
IsSel := assigned(ListView1.Selected);
mnuListRename.Enabled := IsSel;
mnuItemDelete.Enabled := IsSel;
mnuRefreshThumb.Enabled := IsSel;
if ClassicListMode then
for i := 2 to 8 do ListPopUp.Items[i].Visible := False
else
for i := 2 to 8 do ListPopUp.Items[i].Visible := True;
end;
procedure TMainForm.ListViewDblClick(Sender: TObject);
begin
if not (ClassicListMode or ParseLoadingBatch) then UpdateThumbnails;
end;
procedure TMainForm.ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
var
FStrings: TStringList;
IFSStrings: TStringList;
EntryStrings, Tokens: TStringList;
SavedPal: Boolean;
i, j: integer;
floatcolor: double;
s: string;
Palette: TcolorMap;
name:string;
begin
if (ListView1.SelCount <> 0) and (Trim(ListView1.Selected.Caption) <> Trim(maincp.name)) then
begin
LastOpenFileEntry := ListView1.Selected.Index + 1;
RedrawTimer.Enabled := False; //?
StopThread;
if OpenFileType = ftXML then
begin
name := ListView1.Selected.caption;
ParseLoadingBatch := false;
LoadXMLFlame(OpenFile, name);
AnnoyUser;
end
else
begin
SavedPal := false;
//ScriptEditor.Stopped := True;
FStrings := TStringList.Create;
IFSStrings := TStringList.Create;
Tokens := TStringList.Create;
EntryStrings := TStringList.Create;
try
FStrings.LoadFromFile(OpenFile);
for i := 0 to FStrings.count - 1 do
if Pos(ListView1.Selected.Caption + ' {', Trim(FStrings[i])) = 1 then
break;
IFSStrings.Add(FStrings[i]);
repeat
inc(i);
IFSStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
maincp.Clear; // initialize control point for new flame;
maincp.background[0] := 0;
maincp.background[1] := 0;
maincp.background[2] := 0;
maincp.sample_density := defSampleDensity;
maincp.spatial_oversample := defOversample;
maincp.spatial_filter_radius := defFilterRadius;
if OpenFileType = ftFla then // AV: Undo flame list
begin
for i := 0 to FStrings.count - 1 do
begin
if Pos(ListView1.Selected.Caption + ' {', Trim(FStrings[i])) = 1 then
break;
end;
inc(i);
while (Pos('}', FStrings[i]) = 0) and (Pos('palette:', FStrings[i]) = 0) do
begin
EntryStrings.Add(FStrings[i]);
inc(i);
end;
if Pos('palette:', FStrings[i]) = 1 then
begin
SavedPal := True;
inc(i);
for j := 0 to 255 do begin
s := FStrings[i];
GetTokens(s, tokens);
floatcolor := StrToFloat(Tokens[0]);
Palette[j][0] := round(floatcolor);
floatcolor := StrToFloat(Tokens[1]);
Palette[j][1] := round(floatcolor);
floatcolor := StrToFloat(Tokens[2]);
Palette[j][2] := round(floatcolor);
inc(i);
end;
end;
FlameString := EntryStrings.Text;
maincp.ParseString(FlameString);
Transforms := MainCP.NumXForms;
end
else
begin
{ Open *.ifs File }
Variation := vLinear;
VarMenus[0].Checked := True;
StringToIFS(IFSStrings.Text);
SetVariation(maincp);
maincp.CalcBoundBox;
end;
Center[0] := maincp.Center[0];
Center[1] := maincp.Center[1];
mnuSaveUndo.Enabled := false;
mnuUndo.Enabled := False;
mnuPopUndo.Enabled := False;
mnuRedo.enabled := False;
mnuPopRedo.enabled := False;
EditForm.mnuUndo.Enabled := False;
EditForm.mnuRedo.enabled := False;
EditForm.tbUndo.enabled := false;
EditForm.tbRedo.enabled := false;
AdjustForm.btnUndo.enabled := false;
AdjustForm.btnRedo.enabled := false;
btnUndo.Enabled := false;
btnRedo.enabled := false;
Transforms := MainCp.TrianglesFromCP(MainTriangles);
// Fix Apophysis 1.0 parameters with negative color parameteres!
for i := 0 to Transforms - 1 do
if maincp.xform[i].color < 0 then maincp.xform[i].color := 0;
if SavedPal then maincp.cmap := Palette;
UndoIndex := 0;
UndoMax := 0;
if fileExists(AppPath + undoFilename) then
DeleteFile(AppPath + undoFilename);
maincp.name := ListView1.Selected.Caption; // AV: fixed Apo7X bug
Statusbar.Panels[3].Text := maincp.name;
RedrawTimer.Enabled := True;
Application.ProcessMessages;
UpdateWindows;
finally
IFSStrings.Free;
FStrings.Free;
Tokens.free;
EntryStrings.free;
end;
end;
{if ResizeOnLoad then}
ResizeImage;
end;
end;
procedure TMainForm.UpdateWindows;
begin
if AdjustForm.visible then AdjustForm.UpdateDisplay;
if EditForm.visible then EditForm.UpdateDisplay;
if MutateForm.visible then MutateForm.UpdateDisplay;
if CurvesForm.Visible then CurvesForm.SetCp(MainCp);
end;
procedure TMainForm.LoadUndoFlame(index: integer; filename: string);
var
FStrings: TStringList;
IFSStrings: TStringList;
EntryStrings, Tokens: TStringList;
SavedPal: Boolean;
i, j: integer;
s: string;
Palette: TColorMap;
begin
//ScriptEditor.Stopped := True;
FStrings := TStringList.Create;
IFSStrings := TStringList.Create;
Tokens := TStringList.Create;
EntryStrings := TStringList.Create;
try
FStrings.LoadFromFile(filename);
for i := 0 to FStrings.count - 1 do
if Pos(Format('%.4d-', [UndoIndex]), Trim(FStrings[i])) = 1 then
break;
IFSStrings.Add(FStrings[i]);
repeat
inc(i);
IFSStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
for i := 0 to FStrings.count - 1 do
begin
if Pos(Format('%.4d-', [UndoIndex]), Trim(Lowercase(FStrings[i]))) = 1 then
break;
end;
inc(i);
while (Pos('}', FStrings[i]) = 0) and (Pos('palette:', FStrings[i]) = 0) do
begin
EntryStrings.Add(FStrings[i]);
inc(i);
end;
SavedPal := false;
if Pos('palette:', FStrings[i]) = 1 then
begin
SavedPal := True;
inc(i);
for j := 0 to 255 do begin
s := FStrings[i];
GetTokens(s, tokens);
Palette[j][0] := StrToInt(Tokens[0]);
Palette[j][1] := StrToInt(Tokens[1]);
Palette[j][2] := StrToInt(Tokens[2]);
inc(i);
end;
end;
maincp.Clear;
FlameString := EntryStrings.Text;
maincp.zoom := 0;
maincp.center[0] := 0;
maincp.center[0] := 0;
maincp.ParseString(FlameString);
maincp.sample_density := defSampleDensity;
Center[0] := maincp.Center[0];
Center[1] := maincp.Center[1];
Transforms := MainCp.TrianglesFromCP(MainTriangles);
// Trim undo index from title
maincp.name := Copy(Fstrings[0], 6, length(Fstrings[0]) - 7);
if SavedPal then maincp.cmap := palette;
if AdjustForm.visible then AdjustForm.UpdateDisplay;
RedrawTimer.Enabled := True;
UpdateWindows;
finally
IFSStrings.Free;
FStrings.Free;
Tokens.free;
EntryStrings.free;
end;
end;
procedure TMainForm.ResetColorSpeedClick(Sender: TObject);
var i: integer;
begin
StopThread;
UpdateUndo;
for i := 0 to Transforms-1 do
maincp.xform[i].symmetry := 0;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.ResetColorValuesClick(Sender: TObject);
var i: integer;
begin
StopThread;
UpdateUndo;
for i := 0 to Transforms-1 do
maincp.xform[i].color := 0;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.ResetLocation;
begin
maincp.zoom := 0;
//maincp.FAngle := 0;
//maincp.Width := Image.Width;
//maincp.Height := Image.Height;
maincp.CalcBoundBox;
center[0] := maincp.center[0];
center[1] := maincp.center[1];
end;
procedure TMainForm.ListViewEdited(Sender: TObject; Item: TListItem;
var S: string);
var Discard: boolean;
begin
if (s <> Item.Caption) then
begin
// AV: fixed 'List index out of bounds' bugs
if (s = '') then
begin
MessageBox(Handle, PChar(TextByKey('save-status-notitle')), PCHar('Apophysis AV'), 48);
Discard := True;
end else if (ListView1.FindCaption(0, s, false, true, false) <> nil) then
begin
MessageBox(Handle, PChar(Format(TextByKey('save-status-alreadyexists3'),
[s])), PChar('Apophysis AV'), 48);
Discard := True;
end
else if OpenFileType = ftXML then
Discard := (not RenameXML(Item.Caption, s))
else
Discard := (not RenameIFS(Item.Caption, s));
if Discard then
s := Item.Caption
else
if SortFlames.Checked and EnumerateFlames.Checked then
EnumerateFlamesClick(EnumerateFlames);
end;
end;
procedure TMainForm.RedrawTimerTimer(Sender: TObject);
{ Draw flame when timer fires. This seems to stop a lot of errors }
begin
if FMouseMoveState in [msZoomWindowMove, msZoomOutWindowMove, msDragMove, msRotateMove] then exit;
RedrawTimer.enabled := False;
DrawFlame;
end;
procedure TMainForm.mnuVRandomClick(Sender: TObject);
var i: integer;
begin
mnuVRandom.Checked := True;
// AV: only one variation can be active here
for i := 0 to NRVAR - 1 do
VarMenus[i].Checked := False;
mnuBuiltinVars.Checked := False;
mnuPluginVars.Checked := False;
StopThread;
UpdateUndo;
inc(MainSeed);
RandSeed := MainSeed;
repeat
Variation := vRandom;
SetVariation(maincp);
until not maincp.blowsup(1000);
inc(randomindex);
MainCp.name := RandomPrefix + RandomDate + '-' +
IntToStr(RandomIndex);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuGradClick(Sender: TObject);
begin
AdjustForm.UpdateDisplay;
AdjustForm.PageControl.TabIndex:=2;
AdjustForm.Show;
end;
///////////////////////////////////////////////////////////////////////////////
procedure swapcolor(var clist: array of cardinal; i, j: integer);
var
t: cardinal;
begin
t := clist[j];
clist[j] := clist[i];
clist[i] := t;
end;
function diffcolor(clist: array of cardinal; i, j: integer): cardinal;
var
r1, g1, b1, r2, g2, b2: byte;
begin
r1 := clist[j] and 255;
g1 := clist[j] shr 8 and 255;
b1 := clist[j] shr 16 and 255;
r2 := clist[i] and 255;
g2 := clist[i] shr 8 and 255;
b2 := clist[i] shr 16 and 255;
Result := abs((r1 - r2) * (r1 - r2)) + abs((g1 - g2) * (g1 - g2)) +
abs((b1 - b2) * (b1 - b2));
end;
procedure TMainForm.mnuSmoothGradientClick(Sender: TObject);
begin
SmoothPalette;
end;
procedure TMainForm.SmoothPalette;
{ From Draves' Smooth palette Gimp plug-in }
var
Bitmap: TBitMap;
JPEG: TJPEGImage;
pal: TColorMap;
strings: TStringlist;
ident, FileName: string;
len, len_best, as_is, swapd: cardinal;
cmap_best, original, clist: array[0..255] of cardinal;
{p, total,} j, rand, tryit, i0, i1, x, y, i, iw, ih: integer;
fn: string;
begin
//Total := Trunc(NumTries * TryLength / 100);
//p := 0;
Bitmap := TBitmap.Create;
JPEG := TJPEGImage.Create;
strings := TStringList.Create;
try
begin
inc(MainSeed);
RandSeed := MainSeed;
OpenDialog.Filter := Format('%s|*.bmp;*.dib;*.jpg;*.jpeg|%s|*.bmp;*.dib|%s|*.jpg;*.jpeg|%s|*.*',
[TextByKey('common-filter-allimages'), TextByKey('common-filter-bitmap'),
TextByKey('common-filter-jpeg'), TextByKey('common-filter-allfiles')]);
OpenDialog.InitialDir := ImageFolder;
OpenDialog.Title := TextByKey('common-browse');
OpenDialog.FileName := '';
if OpenSaveFileDialog(MainForm, OpenDialog.DefaultExt, OpenDialog.Filter, OpenDialog.InitialDir, TextByKey('common-browse'), fn, true, false, false, true) then
begin
OpenDialog.FileName := fn;
ImageFolder := ExtractFilePath(OpenDialog.FileName);
Application.ProcessMessages;
len_best := 0;
if (UpperCase(ExtractFileExt(Opendialog.FileName)) = '.BMP')
or (UpperCase(ExtractFileExt(Opendialog.FileName)) = '.DIB') then
Bitmap.LoadFromFile(Opendialog.FileName);
if (UpperCase(ExtractFileExt(Opendialog.FileName)) = '.JPG')
or (UpperCase(ExtractFileExt(Opendialog.FileName)) = '.JPEG') then
begin
JPEG.LoadFromFile(Opendialog.FileName);
with Bitmap do
begin
Width := JPEG.Width;
Height := JPEG.Height;
Canvas.Draw(0, 0, JPEG);
end;
end;
iw := Bitmap.Width;
ih := Bitmap.Height;
for i := 0 to 255 do
begin
{ Pick colors from 256 random pixels in the image }
x := random(iw);
y := random(ih);
clist[i] := Bitmap.canvas.Pixels[x, y];
end;
original := clist;
cmap_best := clist;
for tryit := 1 to NumTries do
begin
clist := original;
// scramble
for i := 0 to 255 do
begin
rand := random(256);
swapcolor(clist, i, rand);
end;
// measure
len := 0;
for i := 0 to 255 do
len := len + diffcolor(clist, i, i + 1);
// improve
for i := 1 to TryLength do
begin
//inc(p);
// StatusBar.SimpleText := Format(TextByKey('main-status-calculatingpalette'), [p div total]);
i0 := 1 + random(254);
i1 := 1 + random(254);
if ((i0 - i1) = 1) then
begin
as_is := diffcolor(clist, i1 - 1, i1) + diffcolor(clist, i0, i0 + 1);
swapd := diffcolor(clist, i1 - 1, i0) + diffcolor(clist, i1, i0 + 1);
end
else if ((i1 - i0) = 1) then
begin
as_is := diffcolor(clist, i0 - 1, i0) + diffcolor(clist, i1, i1 + 1);
swapd := diffcolor(clist, i0 - 1, i1) + diffcolor(clist, i0, i1 + 1);
end
else
begin
as_is := diffcolor(clist, i0, i0 + 1) + diffcolor(clist, i0, i0 - 1) +
diffcolor(clist, i1, i1 + 1) + diffcolor(clist, i1, i1 - 1);
swapd := diffcolor(clist, i1, i0 + 1) + diffcolor(clist, i1, i0 - 1) +
diffcolor(clist, i0, i1 + 1) + diffcolor(clist, i0, i1 - 1);
end;
if (swapd < as_is) then
begin
swapcolor(clist, i0, i1);
len := abs(len + swapd - as_is);
end;
end;
if (tryit = 1) or (len < len_best) then
begin
cmap_best := clist;
len_best := len;
end;
end;
clist := cmap_best;
// clean
for i := 1 to 1024 do
begin
i0 := 1 + random(254);
i1 := i0 + 1;
as_is := diffcolor(clist, i0 - 1, i0) + diffcolor(clist, i1, i1 + 1);
swapd := diffcolor(clist, i0 - 1, i1) + diffcolor(clist, i0, i1 + 1);
if (swapd < as_is) then
begin
swapcolor(clist, i0, i1);
len_best := len_best + swapd - as_is;
end;
end;
{ Convert to TColorMap, Gradient and save }
FileName := lowercase(ExtractFileName(Opendialog.FileName));
ident := CleanEntry(FileName);
strings.add(ident + ' {');
strings.add('gradient:');
strings.add(' title="' + CleanUPRTitle(FileName) + '" smooth=no');
for i := 0 to 255 do
begin
pal[i][0] := clist[i] and 255;
pal[i][1] := clist[i] shr 8 and 255;
pal[i][2] := clist[i] shr 16 and 255;
j := round(i * (399 / 255));
strings.Add(' index=' + IntToStr(j) + ' color=' + intToStr(clist[i]));
end;
strings.Add('}');
if not DirectoryExists(ExtractFilePath(defSmoothPaletteFile)) then // AV
begin
CreateDir(AppPath + 'Gradients\');
defSmoothPaletteFile := AppPath + 'Gradients\SmoothPalette.ugr';
end;
SaveGradient(Strings.Text, Ident, defSmoothPaletteFile);
StopThread;
UpdateUndo;
maincp.cmap := Pal;
maincp.cmapindex := -1;
AdjustForm.UpdateDisplay;
if EditForm.Visible then EditForm.UpdateDisplay;
if MutateForm.Visible then MutateForm.UpdateDisplay;
RedrawTimer.enabled := true;
end;
// StatusBar.SimpleText := '';
end;
finally
Bitmap.Free;
JPEG.Free;
strings.Free;
end;
end;
procedure TMainForm.SortFlamesClick(Sender: TObject);
begin
StopThread;
SortFlames.Checked := not SortFlames.Checked;
if SortFlames.Checked then
begin
ListView1.SortType := stText;
// AV: to use Morph scripting method properly
ScriptForm.FileList.Sorted := True;
if ListView1.Items.Count > 1 then ListView1.AlphaSort;
EnumerateFlamesClick(EnumerateFlames);
end
else begin
ListView1.SortType := stNone;
ScriptForm.FileList.Sorted := False;
if (OpenFile <> '') then
if OpenFileType = ftXML then
begin
if assigned(ListView1.Selected) then
ListXML(OpenFile, 2, ListView1.Selected.Caption)
else
ListXML(OpenFile, 1);
end;
end;
end;
procedure TMainForm.Smoothize(const oldpal: TColorMap; const a, b: byte);
{ AV: this one applies Smooth palette to the current gradient or its part }
var
pal: TColorMap;
len, len_best, as_is, swapd: cardinal;
cmap_best, original, clist: array[0..255] of cardinal;
rand, tryit, i0, i1, i: integer;
begin
try
inc(MainSeed);
RandSeed := MainSeed;
Application.ProcessMessages;
len_best := 0;
for i := 0 to 255 do
clist[i] := OldPal[i, 2] * 65536 + OldPal[i, 1] * 256 + oldpal[i, 0];
original := clist;
cmap_best := clist;
for tryit := 1 to NumTries do
begin
clist := original;
// scramble
for i := a to b do
begin
{ Pick color from randomly selected index of the palette }
rand := a + random(b - a + 1); // random(256);
swapcolor(clist, i, rand);
end;
// measure
len := 0;
for i := a to b do
len := len + diffcolor(clist, i, i + 1);
// improve
for i := 1 to TryLength do
begin
i0 := a + 1 + random(b - a - 1); // 1 + random(254);
i1 := a + 1 + random(b - a - 1); // 1 + random(254);
if ((i0 - i1) = 1) then
begin
as_is := diffcolor(clist, i1 - 1, i1) + diffcolor(clist, i0, i0 + 1);
swapd := diffcolor(clist, i1 - 1, i0) + diffcolor(clist, i1, i0 + 1);
end
else if ((i1 - i0) = 1) then
begin
as_is := diffcolor(clist, i0 - 1, i0) + diffcolor(clist, i1, i1 + 1);
swapd := diffcolor(clist, i0 - 1, i1) + diffcolor(clist, i0, i1 + 1);
end
else
begin
as_is := diffcolor(clist, i0, i0 + 1) + diffcolor(clist, i0, i0 - 1) +
diffcolor(clist, i1, i1 + 1) + diffcolor(clist, i1, i1 - 1);
swapd := diffcolor(clist, i1, i0 + 1) + diffcolor(clist, i1, i0 - 1) +
diffcolor(clist, i0, i1 + 1) + diffcolor(clist, i0, i1 - 1);
end;
if (swapd < as_is) then
begin
swapcolor(clist, i0, i1);
len := abs(len + swapd - as_is);
end;
end;
if (tryit = 1) or (len < len_best) then
begin
cmap_best := clist;
len_best := len;
end;
end;
clist := cmap_best;
// clean
for i := 1 to 1024 do
begin
i0 := a + 1 + random(b - a - 1); // 1 + random(254);
i1 := i0 + 1;
as_is := diffcolor(clist, i0 - 1, i0) + diffcolor(clist, i1, i1 + 1);
swapd := diffcolor(clist, i0 - 1, i1) + diffcolor(clist, i0, i1 + 1);
if (swapd < as_is) then
begin
swapcolor(clist, i0, i1);
len_best := len_best + swapd - as_is;
end;
end;
{ Convert to TColorMap }
for i := 0 to 255 do
begin
pal[i][0] := clist[i] and 255;
pal[i][1] := clist[i] shr 8 and 255;
pal[i][2] := clist[i] shr 16 and 255;
end;
StopThread;
UpdateUndo;
maincp.cmap := Pal;
maincp.cmapindex := -1;
AdjustForm.UpdateDisplay;
if EditForm.Visible then EditForm.UpdateDisplay;
if MutateForm.Visible then MutateForm.UpdateDisplay;
RedrawTimer.enabled := true;
finally
end;
end;
procedure TMainForm.mnuThumbnailQualityClick(Sender: TObject); // AV
begin
if TMenuItem(Sender).Checked then exit; // prevent unneseccary updating
TMenuItem(Sender).Checked := True;
case TMenuItem(Sender).Tag of
0: TThumbnailThread.FPreviewDensity := prevMediumQuality;
1: TThumbnailThread.FPreviewDensity := prevMediumQuality;
2: TThumbnailThread.FPreviewDensity := prevHighQuality;
end;
ThumbPrevQual := TMenuItem(Sender).Tag;
// refresh the list of flame previews
if (OpenFile <> '') and (OpenFileType = ftXML) then
if not ParseLoadingBatch then UpdateThumbnails;
end;
procedure TMainForm.mnuToolbarClick(Sender: TObject);
begin
Toolbar.Visible := not Toolbar.Visible;
mnuToolbar.Checked := Toolbar.visible;
end;
procedure TMainForm.mnuTraceClick(Sender: TObject);
begin
TraceForm.Show;
end;
procedure TMainForm.mnuStatusBarClick(Sender: TObject);
begin
// Statusbar.Visible := not Statusbar.Visible;
// AV: fixed Apo7X bug - someone forget to hide other components...
BottomDock.Visible := not BottomDock.Visible; // AV
mnuStatusbar.Checked := BottomDock.Visible; // Statusbar.visible;
end;
procedure TMainForm.mnuFileContentsClick(Sender: TObject);
begin
ListBackPanel.Visible := not ListBackPanel.Visible;
mnuFileContents.Checked := ListBackPanel.Visible; // ListView1.Visible;
if ListBackPanel.Visible then
Splitter.Width := 4
else
Splitter.Width := 0;
end;
procedure TMainForm.Undo;
begin
if UndoIndex = UndoMax then
SaveFlame(maincp, Format('%.4d-', [UndoIndex]) + maincp.name,
AppPath + undoFilename);
StopThread;
Dec(UndoIndex);
LoadUndoFlame(UndoIndex, AppPath + undoFilename);
mnuRedo.Enabled := True;
mnuPopRedo.Enabled := True;
btnRedo.Enabled := True;
EditForm.mnuRedo.Enabled := True;
EditForm.tbRedo.enabled := true;
AdjustForm.btnRedo.enabled := true;
if UndoIndex = 0 then begin
mnuUndo.Enabled := false;
mnuPopUndo.Enabled := false;
btnUndo.Enabled := false;
EditForm.mnuUndo.Enabled := false;
EditForm.tbUndo.enabled := false;
AdjustForm.btnUndo.enabled := false;
end;
end;
procedure TMainForm.mnuUndoClick(Sender: TObject);
begin
Undo;
StatusBar.Panels[3].Text := maincp.name;
end;
procedure TMainForm.mnuUnflattenClick(Sender: TObject);
var
i, t: integer;
refresh: boolean;
begin
StopThread;
refresh := False;
if maincp.HasFinalXForm then t := Transforms
else t := Transforms - 1;
for i := 0 to t do
if maincp.xform[i].GetVariation(1) <> 0 then
begin
maincp.xform[i].SetVariation(1, 0);
refresh := True;
end;
if refresh then
begin
UpdateUndo;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
end;
procedure TMainForm.Redo;
begin
StopThread;
Inc(UndoIndex);
assert(UndoIndex <= UndoMax, 'Undo list index out of range!');
LoadUndoFlame(UndoIndex, AppPath + undoFilename);
mnuUndo.Enabled := True;
mnuPopUndo.Enabled := True;
btnUndo.Enabled := True;
EditForm.mnuUndo.Enabled := True;
EditForm.tbUndo.enabled := true;
AdjustForm.btnUndo.enabled := true;
if UndoIndex = UndoMax then begin
mnuRedo.Enabled := false;
mnuPopRedo.Enabled := false;
btnRedo.Enabled := false;
EditForm.mnuRedo.Enabled := false;
EditForm.tbRedo.enabled := false;
AdjustForm.btnRedo.enabled := false;
end;
end;
procedure TMainForm.mnuRedoClick(Sender: TObject);
begin
Redo;
StatusBar.Panels[3].Text := maincp.name;
end;
// AV: added support for fast preview and params saving without rendering
// for absolute beginners :)
procedure TMainForm.mnuExportBitmapClick(Sender: TObject);
var pic: TPNGObject;
begin
SaveDialog.DefaultExt := 'png';
SaveDialog.Filter := Format('%s|*.png', [TextByKey('common-filter-png')]);
SaveDialog.Filename := maincp.name;
if SaveDialog.Execute then
begin
try
pic := TPNGObject.Create;
try
pic.Assign(Image.Picture.Bitmap);
pic.AddtEXt('ApoFlame', AnsiString(Trim(FlameToXML(Maincp, false, false))));
pic.SaveToFile(SaveDialog.Filename);
finally
pic.Free;
end;
except
Image.Picture.Bitmap.SaveToFile(ChangeFileExt(SaveDialog.FileName, '.bmp'));
end;
end;
end;
procedure TMainForm.mnuFullScreenClick(Sender: TObject);
begin
FullScreenForm.ActiveForm := Screen.ActiveForm;
FullScreenForm.Width := Screen.Width;
FullScreenForm.Height := Screen.Height;
FullScreenForm.Top := 0;
FullScreenForm.Left := 0;
FullScreenForm.cp.Copy(maincp);
FullScreenForm.cp.cmap := maincp.cmap;
FullScreenForm.center[0] := center[0];
FullScreenForm.center[1] := center[1];
FullScreenForm.Calculate := True;
FullScreenForm.Show;
end;
procedure TMainForm.mnuRenderClick(Sender: TObject);
var
Ext: string;
NewRender: Boolean;
begin
NewRender := True;
if Assigned(RenderForm.Renderer) then
if Application.MessageBox(PChar(TextByKey('render-status-confirmstop')), 'Apophysis', 36) = ID_NO then
NewRender := false;
if NewRender then
begin
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.Terminate;
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #1
RenderForm.ResetControls;
RenderForm.PageCtrl.TabIndex := 0;
case renderFileFormat of
1: Ext := '.bmp';
2: Ext := '.png';
3: Ext := '.jpg';
end;
//RenderForm.caption := 'Render ' + #39 + maincp.name + #39 + ' to Disk';
RenderForm.Filename := RenderPath + maincp.name + Ext;
RenderForm.SaveDialog.FileName := RenderPath + maincp.name + Ext;
RenderForm.txtFilename.Text := ChangeFileExt(RenderForm.SaveDialog.Filename, Ext);
RenderForm.cp.Copy(MainCP);
RenderForm.cp.cmap := maincp.cmap;
RenderForm.zoom := maincp.zoom;
RenderForm.Center[0] := center[0];
RenderForm.Center[1] := center[1];
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #2
end;
RenderForm.Show;
end;
procedure TMainForm.mnuRenderAllClick(Sender: TObject);
var
Ext: string;
NewRender: Boolean;
begin
NewRender := True;
if Assigned(RenderForm.Renderer) then
if Application.MessageBox(PChar(TextByKey('render-status-confirmstop')), 'Apophysis', 36) = ID_NO then
NewRender := false;
if NewRender then
begin
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.Terminate;
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #1
RenderForm.ResetControls;
RenderForm.PageCtrl.TabIndex := 0;
case renderFileFormat of
1: Ext := '.bmp';
2: Ext := '.png';
3: Ext := '.jpg';
end;
//RenderForm.caption := 'Render all flames to disk';
RenderForm.bRenderAll := true;
RenderForm.Filename := RenderPath + maincp.name + Ext;
RenderForm.SaveDialog.FileName := RenderForm.Filename;
RenderForm.txtFilename.Text := ChangeFileExt(RenderForm.SaveDialog.Filename, Ext);
RenderForm.cp.Copy(MainCP);
RenderForm.cp.cmap := maincp.cmap;
RenderForm.zoom := maincp.zoom;
RenderForm.Center[0] := center[0];
RenderForm.Center[1] := center[1];
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #2
end;
RenderForm.Show;
end;
procedure TMainForm.mnuMutateClick(Sender: TObject);
begin
MutateForm.Show;
MutateForm.UpdateDisplay;
end;
procedure TMainForm.mnuAdjustClick(Sender: TObject);
begin
AdjustForm.UpdateDisplay;
AdjustForm.PageControl.TabIndex := 0;
AdjustForm.Show;
end;
procedure TMainForm.mnuResetLocationClick(Sender: TObject);
var
scale: double;
dx, dy, cdx, cdy: double;
sina, cosa: extended;
begin
StopThread; // AV
UpdateUndo;
try // AV
scale := MainCP.pixels_per_unit / MainCP.Width * power(2, MainCP.zoom);
cdx := MainCP.center[0];
cdy := MainCP.center[1];
ResetLocation;
cdx := MainCP.center[0] - cdx;
cdy := MainCP.center[1] - cdy;
Sincos(MainCP.FAngle, sina, cosa);
if IsZero(sina) then begin
dy := cdy*cosa {- cdx*sina};
dx := (cdx {+ dy*sina})/cosa;
end
else begin
dx := cdy*sina + cdx*cosa;
dy := (dx*cosa - cdx)/sina;
end;
FViewPos.x := FViewPos.x - dx * scale * Image.Width;
FViewPos.y := FViewPos.y - dy * scale * Image.Width;
FViewScale := FViewScale * MainCP.pixels_per_unit / MainCP.Width * power(2, MainCP.zoom) / scale;
DrawImageView;
RedrawTimer.enabled := true;
UpdateWindows;
except on EMathError do // AV
Trace2('Cannot calculate the flame scale and bounds...');
end;
end;
procedure TMainForm.mnuAboutClick(Sender: TObject);
begin
AboutForm.ShowModal;
end;
procedure TMainForm.mnuOpenGradientClick(Sender: TObject);
begin
GradientBrowser.Filename := GradientFile;
GradientBrowser.Show;
end;
procedure TMainForm.mnuSaveUndoClick(Sender: TObject);
begin
if FileExists(AppPath + undoFilename) then
begin
SaveDialog.DefaultExt := 'undo';
SaveDialog.Filter := TextByKey('common-filter-undofiles') + '|*undo;*.apo';
SaveDialog.Filename := maincp.name;
if SaveDialog.Execute then
begin
if FileExists(SaveDialog.Filename) then DeleteFile(SaveDialog.Filename);
CopyFile(PChar(AppPath + undoFilename), PChar(SaveDialog.Filename), False);
end;
end;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Assigned(RenderForm.Renderer) then
if Application.MessageBox(PChar(TextByKey('render-status-confirmstop')), 'Apophysis', 36) = ID_NO then
CanClose := False;
AboutToExit := CanClose;
end;
procedure TMainForm.FormActivate(Sender: TObject);
begin
if Assigned(Renderer) then Renderer.Priority := tpNormal;
mnuPaste.Enabled := FlameInClipboard; // AV
end;
procedure TMainForm.FormDeactivate(Sender: TObject);
begin
if Assigned(Renderer) then Renderer.Priority := tpLower;
end;
procedure TMainForm.mnuCalculateColorsClick(Sender: TObject);
var
i: integer;
begin
StopThread;
UpdateUndo;
for i := 0 to Transforms - 1 do
maincp.xform[i].color := i / (transforms - 1);
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuRandomizeColorValuesClick(Sender: TObject);
var
i: integer;
begin
inc(MainSeed);
RandSeed := MainSeed;
StopThread;
UpdateUndo;
for i := 0 to Transforms - 1 do
maincp.xform[i].color := random;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.mnuEditScriptClick(Sender: TObject);
begin
ScriptEditor.Show;
end;
procedure TMainForm.mnuRunClick(Sender: TObject);
begin
if not ScriptEditor.Editor.IsEmpty then // AV: is there any code?
ScriptEditor.RunScript;
end;
procedure TMainForm.mnuOpenScriptClick(Sender: TObject);
begin
ScriptEditor.OpenScript;
end;
procedure TMainForm.mnuStopClick(Sender: TObject);
begin
//ScriptEditor.Stopped := True;
// AV: what if script is paused?
ScriptEditor.btnStop.Click; // AV
end;
{
procedure TMainForm.mnuImportGimpClick(Sender: TObject);
var
flist: tStringList;
begin
flist := TStringList.Create;
OpenDialog.Filter := Format('%s|*.*', [TextByKey('common-filter-allfiles')]);
try
if OpenDialog.Execute then
begin
flist.loadFromFile(OpenDialog.filename);
maincp.clear;
maincp.ParseStringList(flist);
maincp.Width := Image.Width;
maincp.Height := Image.Height;
maincp.zoom := 0;
maincp.CalcBoundBox;
center[0] := maincp.center[0];
center[1] := maincp.center[1];
RedrawTimer.Enabled := True;
Application.ProcessMessages;
Transforms := MainCp.TrianglesFromCP(MainTriangles);
UpdateWindows;
end;
finally
flist.free;
end;
end;
}
procedure TMainForm.mnuManageFavoritesClick(Sender: TObject);
var
MenuItem: TMenuItem;
i: integer;
s: string;
begin
if FavoritesForm.ShowModal = mrOK then
begin
if favorites.count <> 0 then
begin
for i := 0 to Favorites.Count - 1 do
begin
s := ExtractFileName(Favorites[i]);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
MenuItem := FavouriteScripts1.Find(s);
if MenuItem <> nil then
MenuItem.Free;
end;
end;
GetScripts;
end;
end;
procedure TMainForm.DisableFavorites;
var
MenuItem: TMenuItem;
i: integer;
s: string;
begin
for i := 0 to Favorites.Count - 1 do
begin
s := ExtractFileName(Favorites[i]);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
MenuItem := FavouriteScripts1.Find(s);
if MenuItem <> nil then
MenuItem.Enabled := False;
end;
end;
procedure TMainForm.EnableFavorites;
var
MenuItem: TMenuItem;
i: integer;
s: string;
begin
for i := 0 to Favorites.Count - 1 do
begin
s := ExtractFileName(Favorites[i]);
s := Copy(s, 0, length(s) - Length(ExtractFileExt(s)));
MenuItem := FavouriteScripts1.Find(s);
if MenuItem <> nil then
MenuItem.Enabled := True;
end;
end;
procedure TMainForm.EnumerateFlamesClick(Sender: TObject);
var i: integer;
begin
with MainForm.ListView1.Items do
begin
BeginUpdate;
for i := 0 to Count - 1 do Item[i].SubItems.Clear; // AV: hide the index
if TMenuItem(Sender).Checked then
begin // AV: displaying the index
MainForm.ListView1.Column[1].Caption := ' N ';
if FlameEnumMode = 0 then
for i := 0 to Count - 1 do Item[i].SubItems.Add(IntToStr(i))
else
for i := 0 to Count - 1 do Item[i].SubItems.Add(IntToStr(i+1));
end
else
MainForm.ListView1.Column[1].Caption := '';
EndUpdate;
end;
end;
procedure TMainForm.mnuShowFullClick(Sender: TObject);
begin
FullScreenForm.Calculate := False;
FullScreenForm.Show;
end;
procedure TMainForm.mnuImageSizeClick(Sender: TObject);
begin
AdjustForm.UpdateDisplay;
AdjustForm.PageControl.TabIndex:=3;
AdjustForm.Show;
end;
procedure TMainForm.AddSymmetryClick(Sender: TObject);
var finTX: TXForm;
begin
if (Transforms + TMenuItem(Sender).Tag > NXForms) then Exit;
StopThread;
UpdateUndo;
finTX := TXForm.Create;
finTX.Assign(MainCp.xform[Transforms]);
MainCp.NormalizeProbabilities;
add_symmetry_to_control_point(MainCp, TMenuItem(Sender).Tag);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
MainCp.xform[Transforms].Assign(finTX);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
finTX.Free;
end;
procedure TMainForm.AddTemplateClick(Sender: TObject); // AV
var
tmpdir: string;
begin
tmpdir := AppPath + 'Templates\';
if not DirectoryExists(tmpdir) then
CreateDir(tmpdir);
with SaveForm do
begin
SaveType := stSaveTemplate;
Filename := tmpdir + 'Fractal Templates.template';
Title := maincp.name;
ActiveControl := txtTitle;
if ShowModal = mrOK then
begin
maincp.name := Title;
SaveXMLFlame(maincp, maincp.name, Filename);
StatusBar.Panels[3].Text := maincp.name;
end;
end;
end;
procedure TMainForm.AddTileClick(Sender: TObject);
var finTX: TXForm;
begin
if (Transforms + 6 > NXForms) then Exit;
StopThread;
UpdateUndo;
finTX := TXForm.Create;
finTX.Assign(MainCp.xform[Transforms]);
MainCp.NormalizeProbabilities;
tile_control_point(MainCp, TMenuItem(Sender).Tag);
Transforms := MainCp.TrianglesFromCP(MainTriangles);
MainCp.xform[Transforms].Assign(finTX);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
finTX.Free;
end;
// AV: make a common event handler for Main and Adjust forms
procedure TMainForm.ApplicationEventsActivate(Sender: TObject);
begin
if GradientInClipboard then
begin
AdjustForm.mnuPaste.enabled := true;
AdjustForm.btnPaste.enabled := true;
mnuPaste.enabled := false;
end
else if FlameInClipboard then
begin
AdjustForm.mnuPaste.enabled := false;
AdjustForm.btnPaste.enabled := false;
if (pos('Memorized XForm Parameters', Clipboard.AsText) > 0) then
mnuPaste.enabled := False // AV: hack
else
mnuPaste.Enabled := true;
end
else
begin
AdjustForm.mnuPaste.enabled := false;
AdjustForm.btnPaste.enabled := false;
mnuPaste.enabled := false;
end;
end;
procedure TMainForm.ParseXML(var cp1: TControlPoint; const params: string; const ignoreErrors : boolean);
var
i: integer;
h, s, v: real;
begin
CurrentFlame := cp1.name;
nxform := 0;
FinalXformLoaded := false;
ActiveXformSet := 0;
XMLPaletteFormat := '';
XMLPaletteCount := 0;
SurpressHandleMissingPlugins := ignoreErrors;
ParseCp.Free; // we're creating this CP from the scratch
ParseCp := TControlPoint.create; // to reset variables properly (randomize)
XMLScanner.LoadFromBuffer(TCharType(TStringType(params)));
XMLScanner.Execute;
cp1.copy(ParseCp);
if (Parsecp.cmapindex = -2) then
begin
if cp1.cmapindex < NRCMAPS then
GetCMap(cp1.cmapindex, 1, cp1.cmap)
{else
ShowMessage('Palette index too high')};
if (cp1.hue_rotation > 0) and (cp1.hue_rotation < 1) then
for i := 0 to 255 do
begin
RGBToHSV(cp1.cmap[i][0], cp1.cmap[i][1], cp1.cmap[i][2], h, s, v);
h := Round(360 + h + (cp1.hue_rotation * 360)) mod 360;
HSVToRGB(h, s, v, cp1.cmap[i][0], cp1.cmap[i][1], cp1.cmap[i][2]);
end;
end;
if FinalXformLoaded = false then begin
cp1.xform[nxform].Clear;
cp1.xform[nxform].symmetry := 1;
end;
if nxform < NXFORMS then
for i := nxform to NXFORMS - 1 do
cp1.xform[i].density := 0;
// Check for symmetry parameter
if ParseCp.symmetry <> 0 then
begin
add_symmetry_to_control_point(cp1, ParseCp.symmetry);
cp1.symmetry := 0;
end;
cp1.FillUsedPlugins;
SurpressHandleMissingPlugins := false;
end;
procedure TMainForm.PasteFlameXML(flameXML: string); // AV
begin
if (flameXML <> '') then
begin
UpdateUndo;
//ScriptEditor.Stopped := True;
MainMenuClick(nil); // AV
StopThread;
ParseXML(MainCP, PCHAR(flameXML), false);
AnnoyUser;
Transforms := MainCp.TrianglesFromCP(MainTriangles);
Statusbar.Panels[3].Text := MainCp.name;
if AutoSaveXML then // AV: saving loaded parameters in the current file
begin
if XMLEntryExists(MainCp.name, OpenFile) then
MainCp.name := MainCp.name + ' (new)'; // hmm...
if (OpenFile = AppPath + randfilename) then // random batch will be deleted
SaveXMLFlame(MainCp, MainCp.name,
IfThen(DirectoryExists(ExtractFilePath(AutoSavePath)), ExtractFilePath(AutoSavePath),
AppPath) + 'Saved by ApophysisAV.flame'); // :)
// AV: display these changes and scroll to the selected item
if SaveXMLFlame(MainCp, MainCp.name, OpenFile) then
ListXML(OpenFile, 2, MainCp.name);
end;
ResizeImage;
RedrawTimer.Enabled := True;
Application.ProcessMessages;
UpdateWindows;
end;
end;
procedure TMainForm.mnuPasteClick(Sender: TObject);
begin
//if Clipboard.HasFormat(CF_TEXT) then
if FlameInClipboard then // AV
PasteFlameXML(Clipboard.AsText);
end;
procedure TMainForm.mnuCopyClick(Sender: TObject);
var
txt: string;
i: integer;
begin
txt := Trim(FlameToXML(Maincp, false, false));
Clipboard.SetTextBuf(PChar(txt));
mnuPaste.enabled := true;
AdjustForm.mnuPaste.enabled := False;
AdjustForm.btnPaste.enabled := False;
// AV: for pasting multiple transforms into editor
MemCp.Clear;
for i := 0 to Maincp.NumXForms - 1 do //FIXME: skip final transform!
MemCp.xform[i].Assign(Maincp.xform[i]);
EditForm.PasteTransform1.Enabled := True;
end;
function WinShellExecute(const Operation, AssociatedFile: string): Boolean;
var
a1: string;
r: Cardinal;
begin
a1 := Operation;
if a1 = '' then
a1 := 'open';
r := ShellExecute(
application.handle
, pchar(a1)
, pchar(AssociatedFile)
, ''
, ''
, SW_SHOWNORMAL
);
if (r > 32) then WinShellExecute := true
else WinShellExecute := false;
end;
procedure WinShellOpen(const AssociatedFile: string);
begin
WinShellExecute('open', AssociatedFile);
end;
procedure TMainForm.mnuExportFlameClick(Sender: TObject);
var
FileList: Tstringlist;
Ext, ex, Path: string;
cp1: TControlPoint;
begin
if not FileExists(flam3Path) then
begin
Application.MessageBox(PChar(TextByKey('main-status-noflam3')), 'Apophysis', 16);
exit;
end;
// AV: we really don't need to waste the memory and create it at startup
ExportDialog := TExportDialog.Create(Application); // AV
case ExportFileFormat of
1: Ext := 'jpg';
2: Ext := 'ppm';
3: Ext := 'png';
end;
FileList := TstringList.Create;
cp1 := TControlPoint.Create;
cp1.copy(Maincp);
ExportDialog.ImageWidth := ExportWidth;
ExportDialog.ImageHeight := ExportHeight;
ExportDialog.Sample_density := ExportDensity;
ExportDialog.Filter_Radius := ExportFilter;
ExportDialog.Oversample := ExportOversample;
try
ExportDialog.Filename := RenderPath + Maincp.name + '.' + Ext;
if ExportDialog.ShowModal = mrOK then
begin
ex := ExtractFileExt(ExportDialog.Filename);
if ExtractFileExt(ExportDialog.Filename) = '.ppm' then
ExportFileFormat := 2
else if ExtractFileExt(ExportDialog.Filename) = '.png' then
ExportFileFormat := 3
else
ExportFileFormat := 1;
case ExportFileFormat of
1: Ext := 'jpg';
2: Ext := 'ppm';
3: Ext := 'png';
end;
ExportWidth := ExportDialog.ImageWidth;
ExportHeight := ExportDialog.ImageHeight;
ExportDensity := ExportDialog.Sample_density;
ExportFilter := ExportDialog.Filter_Radius;
ExportOversample := ExportDialog.Oversample;
ExportBatches := ExportDialog.Batches;
ExportEstimator := ExportDialog.Estimator;
ExportEstimatorMin := ExportDialog.EstimatorMin;
ExportEstimatorCurve := ExportDialog.EstimatorCurve;
ExportJitters := ExportDialog.Jitters;
ExportGammaTreshold := ExportDialog.GammaTreshold;
cp1.sample_density := ExportDensity;
cp1.spatial_oversample := ExportOversample;
cp1.spatial_filter_radius := ExportFilter;
cp1.nbatches := ExportBatches;
if (cp1.width <> ExportWidth) or (cp1.Height <> ExportHeight) then
cp1.AdjustScale(ExportWidth, ExportHeight);
cp1.estimator := ExportEstimator;
cp1.estimator_min := ExportEstimatorMin;
cp1.estimator_curve := ExportEstimatorCurve;
cp1.jitters := ExportJitters;
cp1.gamma_threshold := ExportGammaTreshold;
FileList.Text := FlameToXML(cp1, true, false);
FileList.SaveToFile(ChangeFileExt(ExportDialog.Filename, '.flame'));
FileList.Clear;
FileList.Add('@echo off');
FileList.Add('set verbose=1');
FileList.Add('set format=' + Ext);
if ExportFileFormat = 1 then
FileList.Add('set jpeg=' + IntToStr(JPEGQuality));
case ExportDialog.cmbDepth.ItemIndex of
0: FileList.Add('set bits=16');
1: FileList.Add('set bits=32');
2: FileList.Add('set bits=33');
3: FileList.Add('set bits=64');
end;
if ExportDialog.udStrips.Position > 1 then
FileList.Add('set nstrips=' + IntToStr(ExportDialog.udStrips.Position));
if (PNGTransparency > 0) then
FileList.Add('set transparency=1')
else
FileList.Add('set transparency=0');
FileList.Add('set out=' + ExportDialog.Filename);
FileList.Add('@echo Rendering "' + ExportDialog.Filename + '"');
FileList.Add('"' + flam3Path + '" < "' + ChangeFileExt(ExportDialog.Filename, '.flame') + '"');
Path := ExtractFilePath(ExtractFileDir(ExportDialog.Filename) + '\');
FileList.SaveToFile(ChangeFileExt(ExportDialog.Filename, '.bat'));
if ExportDialog.chkRender.Checked then
begin
SetCurrentDir(Path);
WinShellOpen(ChangeFileExt(ExportDialog.Filename, '.bat'));
end;
end;
finally
FileList.Free;
cp1.free;
ExportDialog.Free; // AV
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure ParseCompactColors(cp: TControlPoint; count: integer; in_data: string; alpha: boolean = true);
function HexChar(c: Char): Byte;
begin
case c of
'0'..'9': Result := Byte(c) - Byte('0');
'a'..'f': Result := (Byte(c) - Byte('a')) + 10;
'A'..'F': Result := (Byte(c) - Byte('A')) + 10;
else
Result := 0;
end;
end;
var
i, pos, len: integer;
c: char;
data: string;
begin
// diable generating pallete
if Parsecp.cmapindex = -2 then
Parsecp.cmapindex := -1;
Assert(Count = 256, 'only 256 color gradients are supported at the moment');
data := '';
for i := 1 to Length(in_data) do
begin
c := in_data[i];
if CharInSet(c,['0'..'9']+['A'..'F']+['a'..'f']) then data := data + c;
end;
if alpha then len := count * 8
else len := count * 6;
Assert(len = Length(data), 'color-data size mismatch');
for i := 0 to Count-1 do begin
if alpha then pos := i*8 + 2
else pos := i*6;
Parsecp.cmap[i][0] := 16 * HexChar(Data[pos + 1]) + HexChar(Data[pos + 2]);
Parsecp.cmap[i][1] := 16 * HexChar(Data[pos + 3]) + HexChar(Data[pos + 4]);
Parsecp.cmap[i][2] := 16 * HexChar(Data[pos + 5]) + HexChar(Data[pos + 6]);
end;
end;
procedure TMainForm.ListXmlScannerStartTag(Sender: TObject;
TagName: string; Attributes: TAttrList);
begin
pname := String(Attributes.value(TStringType('name')));
ptime := String(Attributes.value(TStringType('time')));
// pversion := String(Attributes.value(TStringType('version')));
end;
procedure TMainForm.XMLScannerStartTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
var
Tokens: TStringList;
v: TStringType;
ParsePos, i : integer;
begin
Tokens := TStringList.Create;
try
if TagName='xformset' then // unused in this release...
begin
v := Attributes.Value(TStringType('enabled'));
if v <> '' then ParseCP.finalXformEnabled := (StrToInt(String(v)) <> 0)
else ParseCP.finalXformEnabled := true;
inc(activeXformSet);
end
else if TagName='flame' then
begin
BeginParsing;
v := Attributes.value(TStringType('version')); // AV
if (pos('Apophysis 2.0', String(v)) > 0) or (v = '') then
oldApo := true else oldApo := false;
v := Attributes.value(TStringType('name'));
if v <> '' then Parsecp.name := String(v) else Parsecp.name := 'untitled';
v := Attributes.Value('time');
if v <> '' then Parsecp.Time := StrToFloat(String(v));
v := Attributes.value('palette');
if v <> '' then
Parsecp.cmapindex := StrToInt(String(v))
else
Parsecp.cmapindex := -1;
v := Attributes.value('gradient');
if v <> '' then
Parsecp.cmapindex := StrToInt(String(v))
else
Parsecp.cmapindex := -1;
//ParseCP.hue_rotation := 1;
v := Attributes.value('hue'); // AV: to animate the palette
if v <> '' then
Parsecp.hue_rotation := StrToFloat(String(v))
else
ParseCP.hue_rotation := 1;
v := Attributes.Value('brightness');
if v <> '' then Parsecp.Brightness := StrToFloat(String(v));
v := Attributes.Value('gamma');
if v <> '' then Parsecp.gamma := StrToFloat(String(v));
v := Attributes.Value('contrast'); // AV
if v <> '' then Parsecp.contrast := StrToFloat(String(v));
v := Attributes.Value('vibrancy');
if v <> '' then Parsecp.vibrancy := StrToFloat(String(v));
if (LimitVibrancy) and (Parsecp.vibrancy > 1) then Parsecp.vibrancy := 1;
v := Attributes.Value('gamma_threshold');
if v <> '' then Parsecp.gamma_threshold := StrToFloat(String(v))
else Parsecp.gamma_threshold := 0;
v := Attributes.Value('zoom');
if v <> '' then Parsecp.zoom := StrToFloat(String(v));
v := Attributes.Value('scale');
if v <> '' then Parsecp.pixels_per_unit := StrToFloat(String(v));
v := Attributes.Value('rotate');
if v <> '' then Parsecp.FAngle := -PI * StrToFloat(String(v))/180;
v := Attributes.Value('angle');
if v <> '' then Parsecp.FAngle := StrToFloat(String(v));
// 3d
v := Attributes.Value('cam_pitch');
if v <> '' then Parsecp.cameraPitch := StrToFloat(String(v));
v := Attributes.Value('cam_yaw');
if v <> '' then Parsecp.cameraYaw := StrToFloat(String(v));
v := Attributes.Value('cam_roll');
if v <> '' then Parsecp.cameraRoll := StrToFloat(String(v));
v := Attributes.Value('cam_dist');
if v <> '' then Parsecp.cameraPersp := 1/StrToFloat(String(v));
v := Attributes.Value('cam_perspective');
if v <> '' then Parsecp.cameraPersp := StrToFloat(String(v));
v := Attributes.Value('cam_zpos');
if v <> '' then Parsecp.cameraZpos := StrToFloat(String(v));
v := Attributes.Value('cam_dof');
if v <> '' then Parsecp.cameraDOF := abs(StrToFloat(String(v)));
//density estimation
v := Attributes.Value('estimator_radius');
if v <> '' then Parsecp.estimator := StrToFloat(String(v));
v := Attributes.Value('estimator_minimum');
if v <> '' then Parsecp.estimator_min := StrToFloat(String(v));
v := Attributes.Value('estimator_curve');
if v <> '' then Parsecp.estimator_curve := StrToFloat(String(v));
v := Attributes.Value('enable_de');
if (v = '1') then Parsecp.enable_de := true;
v := Attributes.Value('new_linear');
if (v = '1') then // AV
Parsecp.noLinearFix := true
else ParseCp.noLinearFix := false;
v := Attributes.Value('curves');
if (v <> '') then begin
GetTokens(String(v), tokens);
ParsePos := -1;
for i := 0 to 3 do
begin
Inc(ParsePos);ParseCp.curvePoints[i][0].x := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][0].y := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curveWeights[i][0] := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][1].x := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][1].y := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curveWeights[i][1] := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][2].x := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][2].y := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curveWeights[i][2] := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][3].x := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curvePoints[i][3].y := StrToFloat(Tokens[ParsePos]);
Inc(ParsePos);ParseCp.curveWeights[i][3] := StrToFloat(Tokens[ParsePos]);
end;
end;
try
v := Attributes.Value('center');
GetTokens(String(v), tokens);
Parsecp.center[0] := StrToFloat(Tokens[0]);
Parsecp.center[1] := StrToFloat(Tokens[1]);
except
Parsecp.center[0] := 0;
Parsecp.center[1] := 0;
end;
v := Attributes.Value('size');
GetTokens(String(v), tokens);
Parsecp.width := StrToInt(Tokens[0]);
Parsecp.height := StrToInt(Tokens[1]);
try
v := Attributes.Value('background');
GetTokens(String(v), tokens);
Parsecp.background[0] := Floor(StrToFloat(Tokens[0]) * 255);
Parsecp.background[1] := Floor(StrToFloat(Tokens[1]) * 255);
Parsecp.background[2] := Floor(StrToFloat(Tokens[2]) * 255);
except
Parsecp.background[0] := 0;
Parsecp.background[1] := 0;
Parsecp.background[2] := 0;
end;
v := Attributes.Value('soloxform');
if v <> '' then Parsecp.soloXform := StrToInt(String(v));
v := Attributes.Value('plugins');
GetTokens(String(v), tokens);
if (tokens.Count > 0) then begin
ParseCP.used_plugins.Clear;
for i := 0 to tokens.Count - 1 do
ParseCP.used_plugins.Add(tokens[i]);
end;
(* // AV: commented out since it's useless
v := Attributes.Value('nick');
if Trim(String(v)) = '' then v := TStringType(SheepNick);
Parsecp.Nick := String(v);
v := Attributes.Value('url');
if Trim(String(v)) = '' then v := TStringType(SheepUrl);
Parsecp.URL := String(v);
*)
end
else if TagName='palette' then
begin
XMLPaletteFormat := String(Attributes.Value('format'));
XMLPaletteCount := StrToIntDef(String(Attributes.Value('count')), 256);
end;
finally
Tokens.free;
end;
end;
function flatten_val(Attributes: TAttrList): double;
var
vv: array of double;
vn: array of string;
i: integer;
s: string;
d: boolean;
begin
// AV: invert the behavior since it flatten real 3D figures like bubble
vn := ['crop', 'auger', 'bipolar', 'blur', 'blur_circle', 'blur_pixelize',
'blur_zoom', 'horseshoe', 'diamond', 'disc', 'bent2', 'escher', 'eyefish',
'fan2', 'flux', 'foci', 'log', 'bwraps', 'juliascope', 'julian', 'mobius',
'noise', 'ngon', 'curl', 'rings2', 'scry', 'spherical', 'spiral', 'cropn',
'swirl', 'wedge', 'checks', 'polar', 'polar2', 'linear', 'cross', 'pdj',
'hyperbolic', 'radial_blur', 'elliptic', 'lazysusan', 'post_smartcrop',
'circlecrop', 'rectangles'];
SetLength(vv, length(vn)); // AV
d := false;
for i := 0 to High(vn) do
begin
s := String(Attributes.Value(TStringType(vn[i])));
if (s <> '') then vv[i] := StrToFloat(s)
else vv[i] := 0;
d := d or (vv[i] <> 0);
end;
// AV: changed 0 to 1 and vice versa
if (d) then Result := 1
else Result := 0;
SetLength(vv, 0);
SetLength(vn, 0);
end;
function linear_val(Attributes: TAttrList): double;
var
vv: array of double;
vn: array of string;
i: integer;
s: string;
begin
SetLength(vv, 2);
vn := ['linear3D', 'linear'];
Result := 0;
for i := 0 to 1 do
begin
s := String(Attributes.Value(TStringType(vn[i])));
if (s <> '') then vv[i] := StrToFloat(s)
else vv[i] := 0;
Result := Result + vv[i];
end;
SetLength(vv, 0);
SetLength(vn, 0);
end;
procedure TMainForm.XmlScannerContent(Sender: TObject; Content: String);
var i: byte;
h, s, v, hue: real;
begin
if XMLPaletteCount <= 0 then begin
//ShowMessage('ERROR: No colors in palette!');
Application.MessageBox(PChar(TextByKey('common-invalidformat')), 'Apophysis', MB_ICONERROR);
exit;
end;
if XMLPaletteFormat = 'RGB' then
begin
ParseCompactColors(ParseCP, XMLPaletteCount, Content, false);
end
else if XMLPaletteFormat = 'RGBA' then
begin
ParseCompactColors(ParseCP, XMLPaletteCount, Content);
end
else begin
Application.MessageBox(PChar(TextByKey('common-invalidformat')), 'Apophysis', MB_ICONERROR);
exit;
end;
Parsecp.cmapindex := -1;
// AV: restored hue rotation support, useful for animation
hue := Parsecp.hue_rotation;
if (hue < 1) and (hue > 0) then
for i := 0 to 255 do
begin
RGBToHSV(Parsecp.cmap[i][0], Parsecp.cmap[i][1], Parsecp.cmap[i][2], h, s, v);
h := Round(360 + h + (hue * 360)) mod 360;
HSVToRGB(h, s, v, Parsecp.cmap[i][0], Parsecp.cmap[i][1], Parsecp.cmap[i][2]);
end;
XMLPaletteFormat := '';
XMLPaletteCount := 0;
end;
procedure TMainForm.XMLScannerEmptyTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
var
i, j, k, vindex: integer; // j, k - AV
v, l, s: TStringType;
d, floatcolor, vl, n: double;
Tokens: TStringList;
begin
Tokens := TStringList.Create;
try
if (TagName = 'xform') or (TagName = 'finalxform') then
if {(TagName = 'finalxform') and} (FinalXformLoaded) then Application.MessageBox(PChar(TextByKey('common-invalidformat')), 'Apophysis', MB_ICONERROR)
else
begin
for i := 0 to Attributes.Count - 1 do begin
if not ScanVariations(String(attributes.Name(i))) and
not ScanVariables(String(attributes.Name(i))) then
CheckAttribute(String(Attributes.Name(i)));
end;
if (TagName = 'finalxform') or (activeXformSet > 0) then FinalXformLoaded := true;
with ParseCP.xform[nXform] do begin
Clear;
v := Attributes.Value('weight');
if (v <> '') and (TagName = 'xform') then density := StrToFloat(String(v));
if (TagName = 'finalxform') then
begin
v := Attributes.Value('enabled');
if v <> '' then ParseCP.finalXformEnabled := (StrToInt(String(v)) <> 0)
else ParseCP.finalXformEnabled := true;
end;
if activexformset > 0 then density := 0; // tmp...
///////////// AV: checking variation order ////////////////////
// TODO: optimize!
v := Attributes.Value('var_order');
if v <> '' then begin
GetTokens(String(v), tokens);
k := -1;
for j := 0 to Tokens.Count-1 do
begin
vindex := ifs.IndexOf(Tokens[j]);
if vindex >= 0 then
begin
inc(k);
ifs.Move(vindex, k);
end;
end;
end;
//////////////////////////////////////////////////////////////
v := Attributes.Value('color');
if v <> '' then color := StrToFloat(String(v));
v := Attributes.Value('var_color');
if v <> '' then pluginColor := StrToFloat(String(v));
v := Attributes.Value('symmetry');
if v <> '' then symmetry := StrToFloat(String(v));
v := Attributes.Value('coefs');
GetTokens(String(v), tokens);
if Tokens.Count < 6 then Application.MessageBox(PChar(TextByKey('common-invalidformat')), 'Apophysis', MB_ICONERROR);
c[0][0] := StrToFloat(Tokens[0]);
c[0][1] := StrToFloat(Tokens[1]);
c[1][0] := StrToFloat(Tokens[2]);
c[1][1] := StrToFloat(Tokens[3]);
c[2][0] := StrToFloat(Tokens[4]);
c[2][1] := StrToFloat(Tokens[5]);
v := Attributes.Value('post');
if v <> '' then begin
GetTokens(String(v), tokens);
if Tokens.Count < 6 then Application.MessageBox(PChar(TextByKey('common-invalidformat')), 'Apophysis', MB_ICONERROR);
p[0][0] := StrToFloat(Tokens[0]);
p[0][1] := StrToFloat(Tokens[1]);
p[1][0] := StrToFloat(Tokens[2]);
p[1][1] := StrToFloat(Tokens[3]);
p[2][0] := StrToFloat(Tokens[4]);
p[2][1] := StrToFloat(Tokens[5]);
end;
v := Attributes.Value('chaos');
if v <> '' then begin
GetTokens(String(v), tokens);
for i := 0 to Tokens.Count-1 do
modWeights[i] := Abs(StrToFloat(Tokens[i]));
end;
//else for i := 0 to NXFORMS-1 do modWeights[i] := 1;
// for 2.09 flames compatibility
v := Attributes.Value('opacity');
if v <> '' then begin
if StrToFloat(String(v)) = 0.0 then begin
transOpacity := 0;
end else begin
transOpacity := StrToFloat(String(v));
end;
end;
// 7x.9 name tag
v := Attributes.Value('name');
if v <> '' then begin
TransformName := String(v);
end;
v := Attributes.Value('plotmode');
if v <> '' then begin
if v = 'off' then begin
transOpacity := 0;
end;
end;
// tricky: attempt to convert parameters to 15C+-format if necessary
if ParseCp.noLinearFix then
for i := 0 to 1 do
begin
SetVariation(i, 0);
v := TStringType(ReadWithSubst(Attributes, varnames(i)));
//v := Attributes.Value(AnsiString(varnames(i)));
if v <> '' then
SetVariation(i, StrToFloat(String(v)));
end
else begin
SetVariation(0, linear_val(Attributes));
if ApplyFlatten then // AV
SetVariation(1, flatten_val(Attributes));
end;
// now parse the rest of the variations...as usual
for i := 2 to NRVAR - 1 do
begin
SetVariation(i, 0);
v := TStringType(ReadWithSubst(Attributes, varnames(i)));
//v := Attributes.Value(AnsiString(varnames(i)));
if v <> '' then
SetVariation(i, StrToFloat(String(v)));
end;
// and the variables
for i := 0 to GetNrVariableNames - 1 do begin
v := TStringType(ReadWithSubst(Attributes, GetVariableNameAt(i)));
//v := Attributes.Value(AnsiString(GetVariableNameAt(i)));
if v <> '' then begin
{$ifndef VAR_STR}
d := StrToFloat(String(v));
SetVariable(GetVariableNameAt(i), d);
{$else}
SetVariableStr(GetVariableNameAt(i), String(v));
{$endif}
end;
end;
{***** AV: tryig to convert old Apo 2.0x variations into new ones *****}
if oldApo then begin
// AV: 'perspective' into 'projective'
v := Attributes.Value('perspective');
s := Attributes.Value('projective');
if (v <> '') and (s = '') then // avoid to overwrite
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('projective'), d);
v := Attributes.Value('perspective_dist');
l := Attributes.Value('perspective_angle');
vl := StrToFloat(String(v)); // dist
d := StrToFloat(String(l)); // angle
n := 0;
SetVariable('pr_A', n);
SetVariable('pr_B1', n);
SetVariable('pr_C1', n);
SetVariable('pr_A2', n);
SetVariable('pr_C2', n);
SetVariable('pr_A1', vl);
SetVariable('pr_C', vl);
n := -sin(d * pi * 0.5);
SetVariable('pr_B', n);
n := vl * cos(d * pi * 0.5);
SetVariable('pr_B2', n);
n := 1;
SetVariable('projective_mode', n);
end
else if (v <> '') and (s <> '') then
begin
MissingPlugin.MissingPluginList.Add('perspective');
MissingPlugin.MissingPluginList.Add('perspective_angle');
MissingPlugin.MissingPluginList.Add('perspective_dist');
end;
v := Attributes.Value('rings');
s := Attributes.Value('rings2');
if (v <> '') and (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('rings2'), d);
n := c[2][0];
SetVariable('rings2_val', n);
n := 1;
SetVariable('rings2_old', n);
end
else if (v <> '') and (s <> '') then
MissingPlugin.MissingPluginList.Add('rings');
v := Attributes.Value('fan');
s := Attributes.Value('fan2');
if (v <> '') and (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('fan2'), d);
n := c[2][0];
SetVariable('fan2_x', n);
n := c[2][1];
SetVariable('fan2_y', n);
n := 0; // AV: it is 1 only for 2.09 'fan2'
SetVariable('fan2_old', n);
end
else if (v <> '') and (s <> '') then
MissingPlugin.MissingPluginList.Add('fan');
v := Attributes.Value('bent');
if (v <> '') then
begin
s := Attributes.Value('bent2');
if (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('bent2'), d);
n := 2;
SetVariable('bent2_x', n);
n := 0.5;
SetVariable('bent2_y', n);
n := 1;
SetVariable('bent2_z', n);
end
else MissingPlugin.MissingPluginList.Add('bent');
end;
v := Attributes.Value('waves');
s := Attributes.Value('waves2');
if (v <> '') and (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('waves2'), d);
n := c[1][0];
SetVariable('waves2_scalex', n);
n := 1/(sqr(c[2][0]) + 1E-300);
SetVariable('waves2_freqx', n);
n := c[1][1];
SetVariable('waves2_scaley', n);
n := 1/(sqr(c[2][1]) + 1E-300);
SetVariable('waves2_freqy', n);
n := 0;
SetVariable('waves2_scalez', n);
SetVariable('waves2_freqz', n);
end
else if (v <> '') and (s <> '') then
MissingPlugin.MissingPluginList.Add('waves');
v := Attributes.Value('popcorn');
if (v <> '') then
begin
s := Attributes.Value('popcorn2');
if (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('popcorn2'), d);
n := c[2][0];
SetVariable('popcorn2_x', n);
n := c[2][1];
SetVariable('popcorn2_y', n);
n := 3;
SetVariable('popcorn2_c', n);
end
else MissingPlugin.MissingPluginList.Add('popcorn');
end;
end; // oldApo
// AV: Droste into Escher
v := Attributes.Value('droste');
s := Attributes.Value('escher');
if (v <> '') and (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('escher'), d);
v := Attributes.Value('droste_r1');
l := Attributes.Value('droste_r2');
try
vl := StrToFloat(String(v)); // r1
d := StrToFloat(String(l)); // r2
if (vl <> d) then
n := 2 * arctan(ln(d / vl) / 2 / pi)
else n := 0;
SetVariable('escher_beta', n);
except
n := 0;
SetVariable('escher_beta', n);
end;
end
else if (v <> '') and (s <> '') then
begin
MissingPlugin.MissingPluginList.Add('droste');
MissingPlugin.MissingPluginList.Add('droste_r1');
MissingPlugin.MissingPluginList.Add('droste_r2');
end;
// Spherical3D into inversion3D
v := Attributes.Value('Spherical3D');
if (v <> '') and (GetVariationIndex('Spherical3D')< 0) then
// if plugin is NOT available
begin
s := Attributes.Value('inversion3D');
if (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('inversion3D'), d);
n := 1;
SetVariable('inversion3D_radius', n);
n := 0;
SetVariable('inversion3D_x0', n);
SetVariable('inversion3D_y0', n);
SetVariable('inversion3D_z0', n);
end
else MissingPlugin.MissingPluginList.Add('Spherical3D');
end;
// secant into secant2
v := Attributes.Value('secant');
if (v <> '') and (GetVariationIndex('secant') < 0) then
// if plugin is NOT available
begin
s := Attributes.Value('secant2');
if (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('secant2'), d);
n := 1;
SetVariable('secant2_old', n);
end
else MissingPlugin.MissingPluginList.Add('secant');
end;
// arch into Z_arch
v := Attributes.Value('arch');
if (v <> '') then
begin
s := Attributes.Value('Z_arch');
if (s = '') then
begin
d := StrToFloat(String(v));
SetVariation(GetVariationIndex('Z_arch'), d);
SetVariable('Z_arch_weight', d);
end
else MissingPlugin.MissingPluginList.Add('arch');
end;
{*****************************************************************************}
// legacy variation/variable notation
v := Attributes.Value('var1');
if v <> '' then
begin
for i := 0 to NRVAR - 1 do
SetVariation(i, 0);
SetVariation(StrToInt(String(v)), 1);
end;
v := Attributes.Value('var');
if v <> '' then
begin
for i := 0 to NRVAR - 1 do
SetVariation(i, 0);
GetTokens(String(v), tokens);
if Tokens.Count > NRVAR then Application.MessageBox(PChar(TextByKey('common-invalidformat')), 'Apophysis', MB_ICONERROR);
for i := 0 to Tokens.Count - 1 do
SetVariation(i, StrToFloat(Tokens[i]));
end;
end;
Inc(nXform);
end;
if TagName = 'color' then
begin
// disable generating palette
//if Parsecp.cmapindex = -2 then
Parsecp.cmapindex := -1;
i := StrToInt(String(Attributes.value('index')));
v := Attributes.value('rgb');
GetTokens(String(v), tokens);
floatcolor := StrToFloat(Tokens[0]);
Parsecp.cmap[i][0] := round(floatcolor);
floatcolor := StrToFloat(Tokens[1]);
Parsecp.cmap[i][1] := round(floatcolor);
floatcolor := StrToFloat(Tokens[2]);
Parsecp.cmap[i][2] := round(floatcolor);
end;
if TagName = 'colors' then
begin
ParseCompactcolors(Parsecp, StrToInt(String(Attributes.value('count'))),
String(Attributes.value('data')));
Parsecp.cmapindex := -1;
end;
if TagName = 'symmetry' then
begin
i := StrToInt(String(Attributes.value('kind')));
Parsecp.symmetry := i;
end;
if TagName = 'xdata' then
begin
Parsecp.xdata := Parsecp.xdata + String(Attributes.value('content'));
end;
finally
Tokens.free;
end;
end;
procedure TMainForm.mnuFlamepdfClick(Sender: TObject);
begin
WinShellOpen('http://www.flam3.com/flame_draves.pdf');
end;
procedure TMainForm.mnuFlattenClick(Sender: TObject);
var
i, j, t: integer;
v: double;
refresh: boolean;
flat: array of integer;
begin
StopThread;
refresh := False;
// AV: using new Delphi's feature for dynamic arrays
flat := [GetVariationIndex('crop'), GetVariationIndex('auger'),
GetVariationIndex('bipolar'), GetVariationIndex('blur'),
GetVariationIndex('blur_circle'), GetVariationIndex('blur_pixelize'),
GetVariationIndex('blur_zoom'), GetVariationIndex('horseshoe'),
GetVariationIndex('diamond'), GetVariationIndex('disc'),
GetVariationIndex('bent2'), GetVariationIndex('escher'),
GetVariationIndex('eyefish'), GetVariationIndex('fan2'),
GetVariationIndex('flux'), GetVariationIndex('foci'),
GetVariationIndex('log'), GetVariationIndex('bwraps'),
GetVariationIndex('juliascope'), GetVariationIndex('julian'),
GetVariationIndex('mobius'), GetVariationIndex('noise'),
GetVariationIndex('ngon'), GetVariationIndex('curl'),
GetVariationIndex('rings2'), GetVariationIndex('scry'),
GetVariationIndex('spherical'), GetVariationIndex('spiral'),
GetVariationIndex('circlecrop'), GetVariationIndex('swirl'),
GetVariationIndex('wedge'), GetVariationIndex('rectangles'),
GetVariationIndex('polar'), GetVariationIndex('polar2'),
GetVariationIndex('linear'), GetVariationIndex('cross'),
GetVariationIndex('pdj'), GetVariationIndex('hyperbolic'),
GetVariationIndex('radial_blur'), GetVariationIndex('elliptic'),
GetVariationIndex('lazysusan'), GetVariationIndex('checks'),
GetVariationIndex('cropn'), GetVariationIndex('post_smartcrop')];
if maincp.HasFinalXForm then t := Transforms
else t := Transforms - 1;
for i := 0 to t do
for j in flat do // AV: iterate only for chosen variation indices
begin
if (j < 0) then continue;
v := maincp.xform[i].GetVariation(j);
if (v <> 0) and (maincp.xform[i].GetVariation(1) = 0) then
begin
maincp.xform[i].SetVariation(1, 1); // apply flatten
refresh := True;
end;
end;
if refresh then
begin
UpdateUndo;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
SetLength(flat, 0);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
(*
if button = mbMiddle then begin
//FMouseMoveState := msHeight;
exit;
end else if button = mbRight then begin
//FMouseMoveState := msPitchYaw;
camDragValueY := MainCP.cameraPitch * 180.0 / PI;
camDragValueX := MainCP.cameraYaw * 180.0 / PI;
camDragMode := true;
camDragPos.x := 0;
camDragPos.y := 0;
camDragOld.x := x;
camDragOld.y := y;
camMM := false;
//SetCaptureControl(TControl(Sender));
//Screen.Cursor := crNone;
//GetCursorPos(mousepos); // hmmm
//mousePos := (Sender as TControl).ClientToScreen(Point(x, y));
camDragged := false;
exit;
end;
*)
if button <> mbLeft then exit;
FClickRect.TopLeft := Point(x, y);
FClickRect.BottomRight := FClickRect.TopLeft;
case FMouseMoveState of
msZoomWindow:
begin
FSelectRect.TopLeft := Point(x, y);
FSelectRect.BottomRight := Point(x, y);
DrawZoomWindow;
// if ssAlt in Shift then
// FMouseMoveState := msZoomOutWindowMove
// else
FMouseMoveState := msZoomWindowMove;
end;
msZoomOutWindow:
begin
FSelectRect.TopLeft := Point(x, y);
FSelectRect.BottomRight := Point(x, y);
DrawZoomWindow;
// if ssAlt in Shift then
// FMouseMoveState := msZoomWindowMove
// else
FMouseMoveState := msZoomOutWindowMove;
end;
msDrag:
begin
if not assigned(FViewImage) then exit;
// FSelectRect.TopLeft := Point(x, y);
// FSelectRect.BottomRight := Point(x, y);
FMouseMoveState := msDragMove;
end;
msRotate:
begin
FClickAngle := arctan2(y - Image.Height/2, Image.Width/2 - x);
FRotateAngle := 0;
// FSelectRect.Left := x;
DrawRotateLines(FRotateAngle);
FMouseMoveState := msRotateMove;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const
snap_angle = 0.261799387799149; // AV: the same as 15*pi/180;
var
dx, dy, cx, cy, sgn: integer;
sc, vx, vy, scale: double;
q : Extended;
begin
{
case FMouseMoveState of
msRotate, msRotateMove:
Image.Cursor := crEditRotate;
msDrag, msDragMove:
Image.Cursor := crEditMove;
else
Image.Cursor := crEditArrow;
end;
}
case FMouseMoveState of
msZoomWindowMove,
msZoomOutWindowMove:
begin
if DrawSelection then DrawZoomWindow;
FClickRect.BottomRight := Point(x, y);
dx := x - FClickRect.TopLeft.X;
dy := y - FClickRect.TopLeft.Y;
if ssShift in Shift then begin
if (dy = 0) or (abs(dx/dy) >= Image.Width/Image.Height) then
dy := Round(dx / Image.Width * Image.Height)
else
dx := Round(dy / Image.Height * Image.Width);
FSelectRect.Left := FClickRect.TopLeft.X - dx;
FSelectRect.Top := FClickRect.TopLeft.Y - dy;
FSelectRect.Right := FClickRect.TopLeft.X + dx;
FSelectRect.Bottom := FClickRect.TopLeft.Y + dy;
end
else if ssCtrl in Shift then begin
FSelectRect.TopLeft := FClickRect.TopLeft;
sgn := IfThen(dy*dx >=0, 1, -1);
if (dy = 0) or (abs(dx/dy) >= Image.Width/Image.Height) then begin
FSelectRect.Right := x;
FSelectRect.Bottom := FClickRect.TopLeft.Y + sgn * Round(dx / Image.Width * Image.Height);
end
else begin
FSelectRect.Right := FClickRect.TopLeft.X + sgn * Round(dy / Image.Height * Image.Width);
FSelectRect.Bottom := y;
end;
end
else begin
sgn := IfThen(dy*dx >=0, 1, -1);
if (dy = 0) or (abs(dx/dy) >= Image.Width/Image.Height) then begin
cy := (y + FClickRect.TopLeft.Y) div 2;
FSelectRect.Left := FClickRect.TopLeft.X;
FSelectRect.Right := x;
FSelectRect.Top := cy - sgn * Round(dx / 2 / Image.Width * Image.Height);
FSelectRect.Bottom := cy + sgn * Round(dx / 2 / Image.Width * Image.Height);
end
else begin
cx := (x + FClickRect.TopLeft.X) div 2;
FSelectRect.Left := cx - sgn * Round(dy / 2 / Image.Height * Image.Width);
FSelectRect.Right := cx + sgn * Round(dy / 2 / Image.Height * Image.Width);
FSelectRect.Top := FClickRect.TopLeft.Y;
FSelectRect.Bottom := y;
end;
end;
DrawZoomWindow;
DrawSelection := true;
end;
msDragMove:
begin
assert(assigned(FviewImage));
assert(FViewScale <> 0);
scale := FViewScale * Image.Width / FViewImage.Width;
FViewPos.X := FViewPos.X + (x - FClickRect.Right) / scale;
FViewPos.Y := FViewPos.Y + (y - FClickRect.Bottom) / scale;
//FClickRect.BottomRight := Point(x, y);
DrawImageView;
end;
{ msPitchYaw:
begin
if camDragMode and ( (x <> camDragOld.x) or (y <> camDragOld.y) ) then
begin
Inc(camDragPos.x, x - camDragOld.x);
Inc(camDragPos.y, y - camDragOld.y);
vx := Round6(camDragValueX + camDragPos.x / 10);
vy := Round6(camDragValueY - camDragPos.y / 10);
MainCP.cameraPitch := vy * PI / 180.0;
MainCP.cameraYaw := vx * PI / 180.0;
vx := Round(vx);
vy := Round(vy);
camDragged := True;
//StatusBar.Panels.Items[1].Text := Format('Pitch: %f<>, Yaw: %f<>', [vx,vy]);
end;
end; }
msRotateMove:
begin
if DrawSelection then DrawRotatelines(FRotateAngle);
FRotateAngle := arctan2(y-Image.Height/2, Image.Width/2-x) - FClickAngle;
if ssShift in Shift then // angle snap
FRotateAngle := Round(FRotateAngle/snap_angle)*snap_angle;
//SelectRect.Left := x;
// pdjpointgen.Rotate(FRotateAngle);
// FRotateAngle := 0;
DrawRotatelines(FRotateAngle);
DrawSelection := true;
{
Image.Refresh;
if AdjustForm.Visible then begin
MainCp.FAngle:=-FRotateAngle;
AdjustForm.UpdateDisplay;
end;
}
end;
end;
FClickRect.BottomRight := Point(x, y);
end;
function ScaleRect(r: TRect; scale: double): TSRect;
begin
Result.Left := r.Left * scale;
Result.Top := r.Top * scale;
Result.Right := r.Right * scale;
Result.Bottom := r.Bottom * scale;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
scale: double;
rs: TSRect;
begin
case FMouseMoveState of
msZoomWindowMove:
begin
DrawZoomWindow;
FMouseMoveState := msZoomWindow;
if (abs(FSelectRect.Left - FSelectRect.Right) < 10) or
(abs(FSelectRect.Top - FSelectRect.Bottom) < 10) then
Exit; // zoom to much or double clicked
StopThread;
UpdateUndo;
MainCp.ZoomtoRect(ScaleRect(FSelectRect, MainCP.Width / Image.Width));
FViewScale := FViewScale * Image.Width / abs(FSelectRect.Right - FSelectRect.Left);
FViewPos.x := FViewPos.x - ((FSelectRect.Right + FSelectRect.Left) - Image.Width)/2;
FViewPos.y := FViewPos.y - ((FSelectRect.Bottom + FSelectRect.Top) - Image.Height)/2;
DrawImageView;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
msZoomOutWindowMove:
begin
DrawZoomWindow;
FMouseMoveState := msZoomOutWindow;
if (abs(FSelectRect.Left - FSelectRect.Right) < 10) or
(abs(FSelectRect.Top - FSelectRect.Bottom) < 10) then
Exit; // zoom to much or double clicked
StopThread;
UpdateUndo;
MainCp.ZoomOuttoRect(ScaleRect(FSelectRect, MainCP.Width / Image.Width));
scale := Image.Width / abs(FSelectRect.Right - FSelectRect.Left);
FViewScale := FViewScale / scale;
FViewPos.x := scale * (FViewPos.x + ((FSelectRect.Right + FSelectRect.Left) - Image.Width)/2);
FViewPos.y := scale * (FViewPos.y + ((FSelectRect.Bottom + FSelectRect.Top) - Image.Height)/2);
DrawImageView;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
msDragMove:
begin
FClickRect.BottomRight := Point(x, y);
FMouseMoveState := msDrag;
if ((x = 0) and (y = 0)) or // double clicked
((FClickRect.left = FClickRect.right) and (FClickRect.top = FClickRect.bottom))
then Exit;
StopThread;
UpdateUndo;
MainCp.MoveRect(ScaleRect(FClickRect, MainCP.Width / Image.Width));
RedrawTimer.Enabled := True;
UpdateWindows;
end;
msRotateMove:
begin
DrawRotatelines(FRotateAngle);
FMouseMoveState := msRotate;
if (FRotateAngle = 0) then Exit; // double clicked
StopThread;
UpdateUndo;
if MainForm_RotationMode = 0 then MainCp.Rotate(FRotateAngle)
else MainCp.Rotate(-FRotateAngle);
if assigned(FViewImage) then begin
FViewImage.Free;
FViewImage := nil;
DrawImageView;
end;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
{ msPitchYaw:
begin
camDragMode := false;
Screen.Cursor := crDefault;
if camDragged then
begin
camDragged := False;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
end; }
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.DrawImageView;
var
i, j: integer;
bm: TBitmap;
r: TRect;
scale: double;
const
msg = #54; // 'NO PREVIEW';
var
ok: boolean;
GlobalMemoryInfo: TMemoryStatus; // holds the global memory status information
area: int64;
gridp: integer;
begin
bm := TBitmap.Create;
bm.Width := Image.Width;
bm.Height := Image.Height;
with bm.Canvas do begin
if ShowTransparency then begin
Brush.Color := $F0F0F0;
FillRect(Rect(0, 0, bm.Width, bm.Height));
Brush.Color := $C0C0C0;
for i := 0 to ((bm.Width - 1) shr 3) do begin
for j := 0 to ((bm.Height - 1) shr 3) do begin
if odd(i + j) then
FillRect(Rect(i shl 3, j shl 3, (i+1) shl 3, (j+1) shl 3));
end;
end;
end
else begin
Brush.Color := MainCP.background[0] or (MainCP.background[1] shl 8) or (MainCP.background[2] shl 16);
FillRect(Rect(0, 0, bm.Width, bm.Height));
end;
end;
ok := false;
if assigned(FViewImage) then begin
scale := FViewScale * Image.Width / FViewImage.Width;
r.Left := Image.Width div 2 + round(scale * (FViewPos.X - FViewImage.Width/2));
r.Right := Image.Width div 2 + round(scale * (FViewPos.X + FViewImage.Width/2));
r.Top := Image.Height div 2 + round(scale * (FViewPos.Y - FViewImage.Height/2));
r.Bottom := Image.Height div 2 + round(scale * (FViewPos.Y + FViewImage.Height/2));
GlobalMemoryInfo.dwLength := SizeOf(GlobalMemoryInfo);
GlobalMemoryStatus(GlobalMemoryInfo);
area := abs(r.Right - r.Left) * int64(abs(r.Bottom - r.Top));
if (area * 4 < GlobalMemoryInfo.dwAvailPhys div 2) or
(area <= Screen.Width*Screen.Height*4) then
try
FViewImage.Draw(bm.Canvas, r);
ok := true;
except
end;
// Gridlines for composition (taken from JK mod by Jed Kelsey)
if (EnableGuides) then begin
with bm.Canvas do begin
Pen.Width := 1;
Pen.Color := TColor(LineCenterColor); //$000000; // Center
MoveTo(0, bm.Height shr 1); LineTo(bm.Width, bm.Height shr 1);
MoveTo(bm.Width shr 1, 0); LineTo(bm.Width shr 1, bm.Height);
Pen.Color := TColor(LineThirdsColor); //$C000C0; // Thirds
gridp := Floor(bm.Height/3);
MoveTo(0, gridp); LineTo(bm.Width, gridp);
MoveTo(0, bm.Height-gridp); LineTo(bm.Width, bm.Height-gridp);
gridp := Floor(bm.Width/3);
MoveTo(gridp, 0); LineTo(gridp, bm.Height);
MoveTo(bm.Width-gridp, 0); LineTo(bm.Width-gridp, bm.Height);
Pen.Color := TColor(LineGRColor); //$0000F0; // "Golden Ratio" (per axis)
gridp := Floor(bm.Height * 0.61803399);
MoveTo(0, gridp); LineTo(bm.Width, gridp);
MoveTo(0, bm.Height-gridp); LineTo(bm.Width, bm.Height-gridp);
gridp := Floor(bm.Width * 0.61803399);
MoveTo(gridp, 0); LineTo(gridp, bm.Height);
MoveTo(bm.Width-gridp, 0); LineTo(bm.Width-gridp, bm.Height);
end;
end;
end;
if not ok then
with bm.Canvas do
begin
Font.Name := 'Wingdings'; // 'Arial';
Font.Height := bm.Height div 4;
Font.Color := $808080;
Brush.Style := bsClear;
i := (bm.Width - TextWidth(msg)) div 2;
j := (bm.Height - TextHeight(msg)) div 2;
Font.Color := 0;
TextOut(i+2,j+2, msg);
Font.Color := clWhite; //$808080;
TextOut(i,j, msg);
end;
Image.Picture.Graphic := bm;
//EditForm.PaintBackground;
Image.Refresh;
bm.Free;
end;
///////////////////////////////////////////////////////////////////////////////
(*
procedure TMainForm.DrawPitchYawLines(YawAngle: double; PitchAngle: double);
var
bkuPen: TPen;
points: array[0..3] of TPoint;
i: integer;
begin
bkuPen := TPen.Create;
bkuPen.Assign(Image.Canvas.Pen);
Image.Canvas.Pen.Mode := pmXor;
Image.Canvas.Pen.Color := clWhite;
Image.Canvas.Pen.Style := psDot; //psDash;
Image.Canvas.Brush.Style := bsClear;
// Image.Canvas.Rectangle(FSelectRect);
points[0].x := 0;
points[0].y := round((Image.Height / 2) * sin(PitchAngle));
points[1].x := Image.Width - 1;
points[1].y := points[0].y;
points[2].x := points[1].x;
points[2].y := round((Image.Height) - ((Image.Height / 2) * sin(PitchAngle)));
points[3].x := points[0].x;
points[3].y := points[2].y;
Image.Canvas.MoveTo(Points[3].x, Points[3].y);
for i := 0 to 3 do begin
Image.Canvas.LineTo(Points[i].x, Points[i].y);
end;
Image.Canvas.Pen.Assign(bkuPen);
bkuPen.Free;
end;
*)
procedure TMainForm.DrawRotateLines(Angle: double);
var
bkuPen: TPen;
points: array[0..3] of TPoint;
i,x,y: integer;
begin
bkuPen := TPen.Create;
bkuPen.Assign(Image.Canvas.Pen);
Image.Canvas.Pen.Mode := pmXor;
Image.Canvas.Pen.Color := clWhite;
Image.Canvas.Pen.Style := psDot; //psDash;
Image.Canvas.Brush.Style := bsClear;
// Image.Canvas.Rectangle(FSelectRect);
points[0].x := (Image.Width div 2)-1;
points[0].y := (Image.Height div 2)-1;
points[1].x := (Image.Width div 2)-1;
points[1].y := -Image.Height div 2;
points[2].x := -Image.Width div 2;
points[2].y := -Image.Height div 2;
points[3].x := -Image.Width div 2;
points[3].y := (Image.Height div 2)-1;
for i := 0 to 3 do begin
x := points[i].x;
y := points[i].y;
points[i].x := round(cos(Angle) * x + sin(Angle) * y) + Image.Width div 2;
points[i].y := round(-sin(Angle) * x + cos(Angle) * y) + Image.Height div 2;
end;
Image.Canvas.MoveTo(Points[3].x, Points[3].y);
for i := 0 to 3 do begin
Image.Canvas.LineTo(Points[i].x, Points[i].y);
end;
Image.Canvas.Pen.Assign(bkuPen);
bkuPen.Free;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.DrawZoomWindow;
const
cornerSize = 32;
var
bkuPen: TPen;
dx, dy, cx, cy: integer;
l, r, t, b: integer;
begin
bkuPen := TPen.Create;
bkuPen.Assign(Image.Canvas.Pen);
with Image.Canvas do begin
Pen.Mode := pmXor;
Pen.Color := clWhite;
Brush.Style := bsClear;
Pen.Style := psDot; //psDash;
if ssShift in FShiftState then
begin
dx := FClickRect.Right - FClickRect.Left;
dy := FClickRect.Bottom - FClickRect.Top;
Rectangle(FClickRect.Left - dx, FClickRect.Top - dy, FClickRect.Right, FClickRect.Bottom);
end
else Rectangle(FClickRect);
dx := FSelectRect.Right - FSelectRect.Left;
if dx >= 0 then begin
l := FSelectRect.Left - 1;
r := FSelectRect.Right;
end
else begin
dx := -dx;
l := FSelectRect.Right - 1;
r := FSelectRect.Left;
end;
dx := min(dx div 2 - 1, cornerSize);
dy := FSelectRect.Bottom - FSelectRect.Top;
if dy >= 0 then begin
t := FSelectRect.Top - 1;
b := FSelectRect.Bottom;
end
else begin
dy := -dy;
t := FSelectRect.Bottom - 1;
b := FSelectRect.Top;
end;
dy := min(dy div 2, cornerSize);
pen.Style := psSolid;
MoveTo(l + dx, t);
LineTo(l, t);
LineTo(l, t + dy);
MoveTo(r - dx, t);
LineTo(r, t);
LineTo(r, t + dy);
MoveTo(r - dx, b);
LineTo(r, b);
LineTo(r, b - dy);
MoveTo(l + dx, b);
LineTo(l, b);
LineTo(l, b - dy);
{
cx := (l + r) div 2;
cy := (t + b) div 2;
MoveTo(cx - dx div 2, cy);
LineTo(cx + dx div 2 + 1, cy);
MoveTo(cx, cy - dy div 2);
LineTo(cx, cy + dy div 2 + 1);
}
Pen.Assign(bkuPen);
end;
bkuPen.Free;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbzoomwindowClick(Sender: TObject);
begin
FMouseMoveState := msZoomWindow;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbzoomoutwindowClick(Sender: TObject);
begin
FMouseMoveState := msZoomOutWindow;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbDragClick(Sender: TObject);
begin
FMouseMoveState := msDrag;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbRotateClick(Sender: TObject);
begin
FMouseMoveState := msRotate;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FillVariantMenu;
var
i: integer;
s: string;
NewMenuItem : TMenuItem;
begin
SetLength(VarMenus, NrVar);
// AV: to prevent underlined letters with GUI themes
mnuBuiltinVars.AutoHotkeys := maManual;
mnuPluginVars.AutoHotkeys := maManual;
for i := 0 to NRVAR - 1 do begin
NewMenuItem := TMenuItem.Create(self);
s := varnames(i);
NewMenuItem.Caption := uppercase(s[1]) + copy(s, 2, length(s)-1);
NewMenuItem.OnClick := VariantMenuClick;
NewMenuItem.Enabled := True;
NewMenuItem.Name := 'var' + intTostr(i);
NewMenuItem.Tag := i;
NewMenuItem.GroupIndex := 2;
NewMenuItem.RadioItem := True;
// AV: exotic GUI styles not always work well :-/
if TStyleManager.ActiveStyle.Name <> 'Windows' then
if (i mod 30 = 0) then NewMenuItem.Break := mbBreak;
VarMenus[i] := NewMenuItem;
if i < NumBuiltinVars then
mnuBuiltinVars.Add(NewMenuItem)
else
mnuPluginVars.Add(NewMenuItem);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.VariantMenuClick(Sender: TObject);
var i: integer;
begin
TMenuItem(Sender).Checked := True;
// AV: only one variation type can be active,
// but Apo allows to check up to 3 menu items, confusing users...
mnuVRandom.Checked := False;
if (TMenuItem(Sender).Tag >= NumBuiltinVars) then
begin
for i := 0 to NumBuiltinVars-1 do
VarMenus[i].Checked := False; // AV
mnuBuiltinVars.Checked := False;
mnuPluginVars.Checked := True;
end
else begin
for i := NumBuiltinVars to NrVar - 1 do
VarMenus[i].Checked := False; // AV
mnuBuiltinVars.Checked := True;
mnuPluginVars.Checked := False;
end;
UpdateUndo;
Variation := TVariation(TMenuItem(Sender).Tag); // ?
SetVariation(maincp);
ResetLocation;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
////////// AV: Apo UI Appearance /////////////////////
procedure TMainForm.CreateStyleList;
var i: integer;
s: string;
apostyle : TMenuItem;
sm: TStyleManager;
begin
sm := TStyleManager.Create;
for i := 0 to Length(sm.StyleNames)-1 do
begin
apostyle := TMenuItem.Create(mnuApoStyle);
s := sm.StyleNames[i];
apostyle.Caption := s;
if (sm.ActiveStyle.Name = s) then
apostyle.Checked := True;
apostyle.Name := 'style' + IntToStr(i);
apostyle.RadioItem := True;
apostyle.Enabled := True;
apostyle.Tag := i;
apostyle.OnClick := StyleItemClick;
mnuApoStyle.Add(apostyle);
end;
sm.Free;
end;
procedure TMainForm.ShowStyledWindows(Sender: TObject);
begin
self.ApplyThemedColors;
ScriptEditor.AdjustScripterColors;
EditForm.RedrawButtons;
AboutForm.SetTitleColor;
end;
procedure TMainForm.StyleItemClick(Sender: TObject);
var
newGUI: string;
Registry: TRegistry;
begin
if not TMenuItem(Sender).Checked then
begin
TMenuItem(Sender).Checked := True;
newGUI := TStyleManager.StyleNames[TMenuItem(Sender).Tag];
try
StopThread;
self.OnShow := ShowStyledWindows;
if EditForm.Visible then EditForm.Close;
if AdjustForm.Visible then AdjustForm.Close;
if MutateForm.Visible then MutateForm.Close;
if ScriptEditor.Visible then ScriptEditor.Close;
TStyleManager.TrySetStyle(newGUI, false);
except on EAccessViolation do // hmmm...
Application.MessageBox(PChar(TextByKey('options-restartnotice')),
PChar('Apophysis AV'), MB_ICONWARNING);
end;
Registry := TRegistry.Create;
try
Registry.RootKey := HKEY_CURRENT_USER;
if Registry.OpenKey('\Software\' + APP_NAME + '\Defaults', True) then
Registry.WriteString('UIStyle', newGUI);
Registry.CloseKey;
finally
Registry.Free;
end;
end;
end;
//--Z--////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbQualityBoxKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = ',') then Key := '.'; // AV
if not CharinSet(Key,['0'..'9', #8, #13, #27, '.']) then Key := #0; // AV
if key = #13 then
begin
tbQualityBoxSet(Sender);
key := #0;
end
else if key = #27 then // AV: Esc
tbQualityBox.Text := FloatToStr(defSampleDensity);
end;
procedure TMainForm.tbQualityBoxSet(Sender: TObject);
var
q: double;
begin
try
q := StrToFloat(tbQualityBox.Text);
except
exit;
end;
defSampleDensity := q;
StopThread;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageDblClick(Sender: TObject);
begin
if FMouseMoveState = msRotateMove then
begin
StopThread;
UpdateUndo;
MainCp.FAngle := 0;
RedrawTimer.Enabled := True;
UpdateWindows;
end
else mnuResetLocationClick(Sender);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbShowAlphaClick(Sender: TObject);
begin
//tbShowAlpha.Down := not tbShowAlpha.Down;
ShowTransparency := tbShowAlpha.Down;
DrawImageView;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.tbShowTraceClick(Sender: TObject);
begin
TraceForm.Show;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormKeyUpDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
MousePos: TPoint;
begin
if Shift <> FShiftState then begin
if FMouseMoveState in [msZoomWindowMove, msZoomOutWindowMove, msRotateMove, msDragMove] then
begin
// hack: to generate MouseMove event
GetCursorPos(MousePos);
SetCursorPos(MousePos.x, MousePos.y);
end;
if (FMouseMoveState in [msZoomWindowMove, msZoomOutWindowMove]) then
begin
DrawZoomWindow;
FShiftState := Shift;
DrawZoomWindow;
end
else FShiftState := Shift;
end;
end;
{
procedure TMainForm.ListViewChanging(Sender: TObject; Item: TListItem;
Change: TItemChange; var AllowChange: Boolean);
var sc, fc: string;
begin
if (Item = nil) or (Sender <> ListView1) then exit;
sc := ''; fc := '';
if (ListView1.Selected <> nil) then sc := ListView1.Selected.Caption;
if (ListView1.ItemFocused <> nil) then fc := ListView1.ItemFocused.Caption;
if (Trim(Item.Caption) = Trim(maincp.name)) and (Item.Selected) and
(Item.Selected) and (Change = ctState) then
begin
if (DoNotAskAboutChange = true) then
begin
exit;
end;
if (UndoIndex <> 0) then
begin
// hack
if (LastCaptionSel = sc) and (LastCaptionFoc = fc) then begin
AllowChange := LastDecision;
if Not AllowChange then begin
ListView1.OnChange := nil;
ListView1.OnChanging := nil;
ListView1.Selected := Item;
ListView1.ItemFocused := Item;
ListView1.OnChanging := ListViewChanging;
ListView1.OnChange := ListViewChange;
end;
Exit;
end;
LastCaptionSel := sc;
LastCaptionFoc := fc;
if Application.MessageBox('Do you really want to open another flame? All changes made to the current flame will be lost.', 'Apophysis', MB_ICONWARNING or MB_YESNO) <> IDYES then
begin
AllowChange := false;
ListView1.OnChange := nil;
ListView1.OnChanging := nil;
ListView1.Selected := Item;
ListView1.ItemFocused := Item;
ListView1.OnChanging := ListViewChanging;
ListView1.OnChange := ListViewChange;
end
else
begin
AllowChange := true;
end;
LastDecision := AllowChange;
end;
end;
end;
procedure TMainForm.ListViewInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: String);
var
Bitmap: TBitmap;
lcp: TControlPoint;
begin
// flame preview in a tooltip...
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 100;
BitMap.Height := 100;
lcp := TControlPoint.Create;
lcp.Copy(mainCP);
lcp.cmap := mainCP.cmap;
if Assigned(Renderer) then begin
Renderer.WaitFor;
Renderer.Free;
end;
if not Assigned(Renderer) then
begin
lcp.sample_density := 1;
lcp.spatial_oversample := 1;
lcp.spatial_filter_radius := 0.3;
lcp.AdjustScale(100, 100);
lcp.Transparency := false;
end;
try
Renderer := TRenderThread.Create;
assert(Renderer <> nil);
Renderer.BitsPerSample := 0
Renderer.TargetHandle := self.Handle;
Renderer.SetCP(lcp);
Renderer.Priority := tpLower;
Renderer.NrThreads := 1
Renderer.Resume;
Renderer.WaitFor;
except
end;
lcp.Free;
Bitmap.Free;
end;
}
procedure TMainForm.btnViewIconsClick(Sender: TObject);
var thumbs: TThumbnailThread;
begin
ListView1.ViewStyle := vsIcon;
btnViewList.Down := false;
btnViewIcons.Down := true;
ClassicListMode := false;
// AV: refresh flame images ONLY if they didn't exist
if not GeneratingThumbs then
begin
thumbs := TThumbnailThread.Create;
thumbs.Start;
GeneratingThumbs := True;
end;
// AV: scroll down to the selected flame preview
if MainForm.ListView1.SelCount > 0 then
MainForm.ListView1.Selected.MakeVisible(True);
end;
procedure TMainForm.btnViewListClick(Sender: TObject);
begin
ListView1.ViewStyle := vsReport;
btnViewList.Down := true;
btnViewIcons.Down := false;
ClassicListMode := true;
ListView1.Column[1].Caption := IfThen(EnumerateFlames.Checked,' N ', '');
end;
procedure TMainForm.XmlScannerEndTag(Sender: TObject; TagName: String);
var sb : string;
begin
if (TagName = 'flame') then begin
EndParsing(ParseCP, sb);
MainForm.StatusBar.Panels[0].Text := sb;
end;
end;
procedure TMainForm.tbCurvesClick(Sender: TObject);
begin
AdjustForm.UpdateDisplay;
AdjustForm.PageControl.TabIndex:=4;
AdjustForm.Show;
end;
procedure TMainForm.tbMessagesClick(Sender: TObject);
begin
if (LoadForm.Showing = false) then LoadForm.Show;
end;
procedure TMainForm.btNewClick(Sender: TObject);
begin
StopThread; // AV
if AlwaysCreateBlankFlame then
EditForm.tbResetAll.Click // AV
else
if TemplateForm.ShowModal = mrOK then // AV
if AutoSaveXML then
// AV: create a flame from scratch (rather than replace the current) if needed
begin
MainCp.name := MainCp.name + FormatDateTime(' (MM-dd-yyyy hh-mm-ss)', Now);
if MainForm.SaveXMLFlame(MainCp, MainCp.name, OpenFile) then
if SortFlames.Checked then
ListXML(OpenFile, 2, MainCp.name) // show the new item
else
ListXML(OpenFile, 0); // show the last item
end;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
if (MainForm.Width <= TbBreakWidth) then
Toolbar.Height := 26 * 2 + 8
else Toolbar.Height := 26;
end;
{
// AV: exactly the same code exists in the Global module
function Split(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;
}
procedure TMainForm.mnuResetUIClick(Sender: TObject);
begin
ListBackPanel.Width := ThumbnailSize + 90;
Splitter.Left := ListBackPanel.Width;
ListView1.Columns[0].Width := ThumbnailSize + 30; // AV
ListView1.Columns[1].Width := 35; // AV
end;
procedure TMainForm.AutoSaveTimerTimer(Sender: TObject);
var
filename,title : string;
Tag: string;
IFile: TextFile;
FileList, FileListPre: TStringList;
i, p: integer;
erase : boolean;
bakname: string;
begin
erase := false;
filename := AutoSavePath;
title := CleanXMLName(maincp.name) + ' (' + FormatDateTime('MM-dd-yyyy hh:mm:ss', Now) + ')';
Tag := RemoveExt(filename);
if FileExists(filename) then begin
FileListPre := TStringList.create;
try
FileListPre.LoadFromFile(filename);
if (FileListPre.Count > 1000) then erase := true;
finally
FileListPre.Free;
end;
if (erase) then begin
bakname := ChangeFileExt(filename, '.bak');
if FileExists(bakname) then DeleteFile(bakname);
RenameFile(filename, bakname);
end;
end;
try
if FileExists(filename) then
begin
bakname := ChangeFileExt(filename, '.temp');
if FileExists(bakname) then DeleteFile(bakname);
RenameFile(filename, bakname);
FileList := TStringList.create;
try
FileList.LoadFromFile(bakname);
if Pos('<flame name="' + title + '"', FileList.Text) <> 0 then
begin
i := 0;
while Pos('<flame name="' + title + '"', Trim(FileList[i])) = 0 do
inc(i);
p := 0;
while p = 0 do
begin
p := Pos('</flame>', FileList[i]);
FileList.Delete(i);
end;
end;
// fix first line
if (FileList.Count > 0) then begin
FileList[0] := '<flames name="' + Tag + '">';
end;
if FileList.Count > 2 then
begin
if pos('<flame ', FileList.text) <> 0 then
repeat
FileList.Delete(FileList.Count - 1);
until (Pos('</flame>', FileList[FileList.count - 1]) <> 0)
else
repeat
FileList.Delete(FileList.Count - 1);
until (Pos('<' + Tag + '>', FileList[FileList.count - 1]) <> 0) or
(Pos('</flames>', FileList[FileList.count - 1]) <> 0);
end else
begin
FileList.Delete(FileList.Count - 1);
end;
FileList.Add(Trim(FlameToXMLAS(maincp, title, false)));
FileList.Add('</flames>');
FileList.SaveToFile(filename);
finally
if FileExists(bakname) and not FileExists(filename) then
RenameFile(bakname, filename);
FileList.Free;
if FileExists(bakname) then DeleteFile(bakname);
end;
end
else
begin
// New file ... easy
AssignFile(IFile, filename);
ReWrite(IFile);
Writeln(IFile, '<flames name="' + Tag + '">');
Write(IFile, FlameToXMLAS(maincp, title, false));
Writeln(IFile, '</flames>');
CloseFile(IFile);
end;
except on EInOutError do // AV
raise Exception.CreateFmt(TextByKey('common-genericsavefailure'),[title]);
end;
end;
procedure TMainForm.Restorelastautosave1Click(Sender: TObject);
var fn:string;
begin
if (not fileexists(AutoSavePath)) then
raise Exception.Create(TextByKey('main-status-noautosave')); // AV
//ScriptEditor.Stopped := True;
MainMenuClick(nil); // AV
fn := AutoSavePath;
MainForm.CurrentFileName := fn;
LastOpenFile := fn;
Maincp.name := '';
ParamFolder := ExtractFilePath(fn);
OpenFile := fn;
//MainForm.Caption := AppVersionString + ' - ' + OpenFile; // --Z--
if APP_BUILD = '' then MainForm.Caption := AppVersionString + ' - ' + openFile
else MainForm.Caption := AppVersionString + ' ' + APP_BUILD + ' - ' + openFile;
OpenFileType := ftXML;
ListXML(fn, 1)
end;
procedure TMainForm.mnuHelpTopicsClick(Sender: TObject);
var
URL, HelpTopic: string;
begin
{if EditForm.Active then HelpTopic := 'Transform editor.htm'
// else if GradientForm.Active then HelpTopic := 'Gradient window.htm'
else if AdjustForm.Active then HelpTopic := 'Adjust window.htm'
else if MutateForm.Active then HelpTopic := 'Mutation window.htm'
else if RenderForm.Active then HelpTopic := 'Render window.htm';
HtmlHelp(0, nil, HH_CLOSE_ALL, 0);
URL := AppPath + 'Apophysis 2.0.chm';
if HelpTopic <> '' then URL := URL + '::\' + HelpTopic;
HtmlHelp(0, PChar(URL), HH_DISPLAY_TOC, 0); }
//if (FileExists(HelpPath)) then
if (HelpPath <> '') then begin
if (not WinShellExecute('open', HelpPath)) then begin
MessageBox(self.Handle, PCHAR(Format(TextByKey('common-genericopenfailure'), [HelpPath])),
PCHAR('Apophysis AV'), MB_ICONHAND);
end;
end else MessageBox(self.Handle, PCHAR(TextByKey('main-status-nohelpfile')),
PCHAR('Apophysis AV'), MB_ICONHAND);
end;
function TMainForm.RetrieveXML(cp : TControlPoint):string;
begin
Result := FlameToXML(cp, false, false);
end;
procedure TMainForm.tbGuidesClick(Sender: TObject);
begin
// tbGuides.Down := not tbGuides.Down;
EnableGuides := tbGuides.Down;
DrawImageView;
end;
(*
function WinExecAndWait32(FileName: string): integer;
var
zAppName: array[0..1024] of Char;
zCurDir: array[0..255] of Char;
WorkDir: string;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
r : dword;
begin
StrPCopy(zAppName, FileName);
GetDir(0, WorkDir);
StrPCopy(zCurDir, WorkDir);
FillChar(StartupInfo, Sizeof(StartupInfo), #0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := 0;
if (not CreateProcess(nil, zAppName, nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo)) then
Result := -1
else begin
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, r);
result := r;
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
end;
*)
procedure TMainForm.mnuTurnFlameToScriptClick(Sender: TObject);
var
txt: string;
begin
txt := Trim(FlameToXML(Maincp, false, false));
ScriptEditor.ScriptFromFlame(txt);
ScriptEditor.Show;
end;
constructor TThumbnailThread.Create;
begin
inherited create(True); // AV: don't run the thread immediately
FCount := MainForm.ListView1.Items.Count - 1;
FreeOnTerminate := true; // AV: fixed - someone forgot to free the memory
Trace2('Creating ThumbnailThread #' + IntToStr(self.ThreadID));
end;
destructor TThumbnailThread.Destroy;
begin
// AV: added tracing to fix Apo7X memory leaks
Synchronize(
procedure
begin
Trace2('Destroying ThumbnailThread #' + IntToStr(self.ThreadID));
end);
inherited;
end;
procedure TThumbnailThread.Execute;
var
Renderer : TRenderer;
cp : TControlPoint;
Thumbnail : TBitmap;
flameXML, fCaption : string;
w, h, i : integer;
r : double;
{
stored_thumb : TJPegImage;
stored_thumb_data : TBinArray;
stored_thumb_size : integer;
memstream : TMemoryStream;
}
begin
inherited;
Renderer := TRenderer.Create;
cp := TControlPoint.Create;
Thumbnail := TBitmap.Create;
try // AV: added try-finally block
// AV: moved outside the loop for speed
Thumbnail.PixelFormat := pf24bit;
Thumbnail.HandleType := bmDIB;
Thumbnail.Width := FThumbnailSize;
Thumbnail.Height := FThumbnailSize;
Thumbnail.Canvas.Brush.Color := WinColor; // AV: theme-aware GetSysColor(5);
for i := 0 to FCount do
begin
cp.Clear;
fCaption := MainForm.ListView1.Items[i].Caption;
flameXML := LoadXMLFlameText(Openfile, fCaption);
MainForm.ParseXML(cp, PCHAR(flameXML), true);
{
// AV: great idea, but somehow it doesn't work and causes crashes :(
if (cp.xdata <> '') then
begin
stored_thumb := TJPegImage.Create;
B64Decode(cp.xdata, stored_thumb_data, stored_thumb_size);
memstream := TMemoryStream.Create;
memstream.Size := stored_thumb_size;
stored_thumb_size := Length(stored_thumb_data);
memstream.WriteBuffer(stored_thumb_data[0], stored_thumb_size);
memstream.Seek(0, soBeginning);
//-X- test thumbnail integrity... memstream.SaveToFile('C:\Test.jpg');
stored_thumb.LoadFromStream(memstream);
memstream.Free;
w := stored_thumb.Width;
h := stored_thumb.Height;
Thumbnail.Canvas.FillRect(Rect(0, 0, FThumbnailSize, FThumbnailSize));
Thumbnail.Canvas.Draw(round(FThumbnailSize / 2 - w / 2),
round(FThumbnailSize / 2 - h / 2), stored_thumb);
// AV: added thread synchronization for visual components
Synchronize(
procedure
begin
Trace2('Generating thumbnail for "' + fCaption + '"');
MainForm.UsedThumbnails.Add(Thumbnail, nil);
MainForm.ListView1.Items[i].ImageIndex := MainForm.UsedThumbnails.Count - 1;
end);
stored_thumb.Free;
end else }
begin
w := cp.Width;
h := cp.Height;
r := w / h;
if (w < h) then
begin
w := round(r * FThumbnailSize);
h := FThumbnailSize;
end else if (w > h) then
begin
h := round(FThumbnailSize / r);
w := FThumbnailSize;
end else
begin
w := FThumbnailSize;
h := FThumbnailSize;
end;
cp.AdjustScale(w, h);
cp.spatial_oversample := defOversample;
cp.spatial_filter_radius := defFilterRadius;
cp.sample_density := FPreviewDensity; // AV
Renderer.SetCP(cp);
Renderer.Render;
Thumbnail.Canvas.FillRect(Rect(0, 0, FThumbnailSize, FThumbnailSize));
Thumbnail.Canvas.Draw(round(FThumbnailSize / 2 - w / 2),
round(FThumbnailSize / 2 - h / 2), Renderer.GetImage);
// AV: added thread synchronization for updating visual components
Synchronize(
procedure
begin
MainForm.UsedThumbnails.Add(Thumbnail, nil);
MainForm.ListView1.Items[i].ImageIndex := MainForm.UsedThumbnails.Count - 1;
Trace2('Generating thumbnail for "' + fCaption + '"');
end);
end;
if Terminated then break; // AV
end;
finally
cp.Free;
Renderer.Free;
Thumbnail.Free;
Thumbnail := nil;
end;
end;
procedure ListXML(FileName: string; sel: integer; selname: string = '');
var
FStrings : TStringList;
i, p : integer;
title : string;
thread : TThumbnailThread;
item : TListItem;
begin
MainForm.ParseLoadingBatch := true;
FStrings := TStringList.Create;
FStrings.LoadFromFile(FileName);
MainForm.ListView1.Items.BeginUpdate;
try
// AV: moved all the main code inside try-finally block
// because Apo often crashes here
MainForm.ListView1.Items.Clear;
// AV: moved from TThumbnailThread.Execute - seems like it saves a lot of time
MainForm.UsedThumbnails.Clear;
MainForm.UsedThumbnails.Add(ThumbnailPlaceholder, nil);
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(TCharType(TStringType(FStrings[i])));
MainForm.ListXMLScanner.Execute;
if Trim(pname) = '' then
Title := '*untitled ' + ptime
else
Title := Trim(pname);
if Title <> '' then
begin
if ((i mod 5) = 0) then
MainForm.LoadSaveProgress.Position :=
round(100 * i / FStrings.Count);
item := MainForm.ListView1.Items.Add;
item.Caption := Title;
item.ImageIndex := 0; // AV: now we can load a hourglass icon
end;
end;
end;
end;
MainForm.LoadSaveProgress.Position := 0;
//MainForm.ListView1.AllocBy := MainForm.ListView1.Items.Count;
if ClassicListMode then // AV: thumbs are useless
GeneratingThumbs := False
else begin
thread := TThumbnailThread.Create;
thread.Start; // AV: thread.Resume method is deprecated here
GeneratingThumbs := True;
end;
finally
MainForm.ListView1.Items.EndUpdate;
FStrings.Free;
with MainForm.ListView1 do // AV
if Items.Count > 0 then // AV: added a check
case sel of
0: Selected := Items[Items.Count - 1];
1: Selected := Items[0];
2: if (selname <> '') then // AV: show the flame with the specified name
Selected := FindCaption(0, selname, false, true, false);
end;
if MainForm.EnumerateFlames.Checked then // AV: displaying indices
MainForm.EnumerateFlamesClick(MainForm.EnumerateFlames);
end;
MainForm.ParseLoadingBatch := false;
end;
procedure TMainForm.RefreshThumbnail;
var
Renderer : TRenderer;
Thumbnail : TBitmap;
r, sd: double;
i, w, h, w_old, h_old: integer;
begin
if not Assigned(ListView1.Selected) then exit;
i := ListView1.Selected.Index;
if (i > UsedThumbnails.Count) then exit;
w := Maincp.Width;
h := Maincp.Height;
w_old := w;
h_old := h;
r := w / h;
if (w < h) then
begin
w := round(r * ThumbnailSize);
h := ThumbnailSize;
end else if (w > h) then
begin
h := round(ThumbnailSize / r);
w := ThumbnailSize;
end else
begin
w := ThumbnailSize;
h := ThumbnailSize;
end;
sd := Maincp.sample_density;
Maincp.AdjustScale(w, h);
Maincp.spatial_oversample := defOversample;
Maincp.spatial_filter_radius := defFilterRadius;
Maincp.sample_density := TThumbnailThread.FPreviewDensity;
Renderer := TRenderer.Create;
Thumbnail := TBitmap.Create;
try
Renderer.SetCP(Maincp);
Renderer.Render;
Thumbnail.PixelFormat := pf24bit;
Thumbnail.HandleType := bmDIB;
Thumbnail.Width := ThumbnailSize;
Thumbnail.Height := ThumbnailSize;
Thumbnail.Canvas.Brush.Color := WinColor; // theme-aware system color
Thumbnail.Canvas.FillRect(Rect(0, 0, ThumbnailSize, ThumbnailSize));
Thumbnail.Canvas.Draw(round(ThumbnailSize / 2 - w / 2),
round(ThumbnailSize / 2 - h / 2), Renderer.GetImage);
try
UsedThumbnails.Replace(i + 1, Thumbnail, nil);
ListView1.Items.Item[i].Update;
Trace2('Updating thumbnail for "' + ListView1.Items[i].Caption + '"');
except
ListView1.Items[i].ImageIndex := 0;
end;
finally
Thumbnail.Free;
Thumbnail := nil;
Renderer.Free;
// restore old settings
Maincp.AdjustScale(w_old, h_old);
Maincp.sample_density := sd;
end;
end;
procedure TMainForm.UpdateThumbnails; // AV: refreshes images only
var
i: integer;
thumbs: TThumbnailThread;
begin
UsedThumbnails.Clear;
UsedThumbnails.Add(ThumbnailPlaceholder, nil);
with ListView1.Items do
begin
BeginUpdate;
for i := 0 to Count - 1 do Item[i].ImageIndex := 0; // hourglass icon
EndUpdate;
end;
thumbs := TThumbnailThread.Create;
thumbs.Start;
GeneratingThumbs := True;
// hightlight the item if possible
ListView1.Selected := ListView1.ItemFocused;
end;
procedure TMainForm.SetThumbnailProperties; // AV
begin
if UseSmallThumbnails then
ThumbnailSize := 96
else
ThumbnailSize := 128;
UsedThumbnails.Height := ThumbnailSize;
UsedThumbnails.Width := ThumbnailSize;
TThumbnailThread.FThumbnailSize := ThumbnailSize;
LoadThumbnailPlaceholder(ThumbnailSize);
mnuResetUI.Click;
end;
procedure TMainForm.mnuReportFlameClick(Sender: TObject);
var
str: string;
i : integer;
begin
if (not LoadForm.Visible) then LoadForm.Show;
str := MainCP.name + #13#10 + StringOfChar('=', length(MainCP.name)) + #13#10 +
Format(TextByKey('main-report-transformcount'), [MainCp.NumXForms]) + #13#10 +
Format(TextByKey('main-report-finaltransform'), [IfThen(maincp.finalXformEnabled, TextByKey('common-yes'), TextByKey('common-no'))]) + #13#10 +
TextByKey('main-report-usedplugins');
MainCP.FillUsedPlugins;
if MainCp.used_plugins.Count = 0 then begin
LoadForm.Output.Text := LoadForm.Output.Text + #13#10 + str + ' ' + TextByKey('main-report-noplugins') + #13#10;
exit;
end;
for i := 0 to MainCP.used_plugins.Count-1 do begin
str := str + #13#10 + ' - ' + MainCP.used_plugins[i];
end;
// AV: added 3D and DC status
str := str + #13#10 + TextByKey('main-report-directcoloring') + #32 +
IfThen((pos('dc', str) > 0) or (pos('falloff', str) > 0) or (pos('affine3D', str) > 0),
TextByKey('common-yes'), TextByKey('common-no'));
str := str + #13#10 + TextByKey('main-report-flame3d') + #32 +
IfThen((MainCP.cameraPitch <> 0) or (MainCP.cameraRoll <> 0) or (pos('_rotate_', str) > 0),
TextByKey('common-yes'), TextByKey('common-no'));
LoadForm.Output.Text := LoadForm.Output.Text + #13#10 + str + #13#10;
end;
procedure TMainForm.mnuExportChaoticaClick(Sender: TObject);
begin
MainCP.FillUsedPlugins;
C_ExecuteChaotica(FlameToXml(MainCp, false, false), MainCp.used_plugins, UseX64IfPossible);
end;
procedure TMainForm.mnuManualClick(Sender: TObject); // AV: Apo7X link is dead...
begin
// AV: first link is for Russian people only
// WinShellOpen('https://books.google.ru/books?id=PbMAAQAAQBAJ&printsec=frontcover&hl=ru#v=onepage&q&f=false');
WinShellOpen('https://www.amazon.com/Fractals-Everywhere-Dover-Books-Mathematics/dp/0486488705');
end;
procedure TMainForm.CalculateColorSpeed1Click(Sender: TObject); // AV
begin
StopThread;
UpdateUndo;
MainCp.CalculateColorSpeed;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.CalculateWeightsClick(Sender: TObject); // AV
begin
StopThread;
UpdateUndo;
MainCp.CalculateWeights;
RedrawTimer.Enabled := True;
UpdateWindows;
end;
procedure TMainForm.CreateSubstMap;
begin
// AV: set backward compatibility since both plugins crash the scripter
SubstSource.Add('epispiral'); SubstTarget.Add('Epispiral');
SubstSource.Add('epispiral_n'); SubstTarget.Add('Epispiral_n');
SubstSource.Add('epispiral_thickness'); SubstTarget.Add('Epispiral_thickness');
SubstSource.Add('epispiral_holes'); SubstTarget.Add('Epispiral_holes');
{ AV: Apo7X has a bug here: when a source variation
is avaliable as a plugin, the application internally sets both versions
(source and substitute). It gives wrong visual results. So I added a checking }
if (GetVariationIndex('cross2') < 0) then begin // only if plugin is not loaded
SubstSource.Add('cross2'); SubstTarget.Add('cross');
end;
if (GetVariationIndex('bwraps2') < 0) then begin
SubstSource.Add('bwraps2'); SubstTarget.Add('bwraps');
SubstSource.Add('bwraps2_cellsize'); SubstTarget.Add('bwraps_cellsize');
SubstSource.Add('bwraps2_space'); SubstTarget.Add('bwraps_space');
SubstSource.Add('bwraps2_gain'); SubstTarget.Add('bwraps_gain');
SubstSource.Add('bwraps2_inner_twist'); SubstTarget.Add('bwraps_inner_twist');
SubstSource.Add('bwraps2_outer_twist'); SubstTarget.Add('bwraps_outer_twist');
end;
if (GetVariationIndex('pre_bwraps2') < 0) then begin
SubstSource.Add('pre_bwraps2'); SubstTarget.Add('pre_bwraps');
SubstSource.Add('pre_bwraps2_cellsize'); SubstTarget.Add('pre_bwraps_cellsize');
SubstSource.Add('pre_bwraps2_space'); SubstTarget.Add('pre_bwraps_space');
SubstSource.Add('pre_bwraps2_gain'); SubstTarget.Add('pre_bwraps_gain');
SubstSource.Add('pre_bwraps2_inner_twist'); SubstTarget.Add('pre_bwraps_inner_twist');
SubstSource.Add('pre_bwraps2_outer_twist'); SubstTarget.Add('pre_bwraps_outer_twist');
end;
if (GetVariationIndex('post_bwraps2') < 0) then begin
SubstSource.Add('post_bwraps2'); SubstTarget.Add('post_bwraps');
SubstSource.Add('post_bwraps2_cellsize'); SubstTarget.Add('post_bwraps_cellsize');
SubstSource.Add('post_bwraps2_space'); SubstTarget.Add('post_bwraps_space');
SubstSource.Add('post_bwraps2_gain'); SubstTarget.Add('post_bwraps_gain');
SubstSource.Add('post_bwraps2_inner_twist'); SubstTarget.Add('post_bwraps_inner_twist');
SubstSource.Add('post_bwraps2_outer_twist'); SubstTarget.Add('post_bwraps_outer_twist');
end;
if (GetVariationIndex('bwraps7') < 0) then begin
SubstSource.Add('bwraps7'); SubstTarget.Add('bwraps');
SubstSource.Add('bwraps7_cellsize'); SubstTarget.Add('bwraps_cellsize');
SubstSource.Add('bwraps7_space'); SubstTarget.Add('bwraps_space');
SubstSource.Add('bwraps7_gain'); SubstTarget.Add('bwraps_gain');
SubstSource.Add('bwraps7_inner_twist'); SubstTarget.Add('bwraps_inner_twist');
SubstSource.Add('bwraps7_outer_twist'); SubstTarget.Add('bwraps_outer_twist');
end;
if (GetVariationIndex('logn') < 0) then begin
SubstSource.Add('logn'); SubstTarget.Add('log');
SubstSource.Add('logn_base'); SubstTarget.Add('log_base');
end;
if (GetVariationIndex('circleblur') < 0) then begin // AV
SubstSource.Add('circleblur'); SubstTarget.Add('blur_circle');
end;
if (GetVariationIndex('circle2') < 0) then begin // AV
SubstSource.Add('circle2'); SubstTarget.Add('blur_circle');
end;
if (GetVariationIndex('boarders') < 0) then begin // AV
SubstSource.Add('boarders'); SubstTarget.Add('boarders2');
end;
if (GetVariationIndex('dc_boarders') < 0) then begin // AV
SubstSource.Add('dc_boarders'); SubstTarget.Add('boarders2');
end;
if (GetVariationIndex('splits3D') < 0) then begin // AV
SubstSource.Add('splits3D'); SubstTarget.Add('splits');
SubstSource.Add('splits3D_x'); SubstTarget.Add('splits_x');
SubstSource.Add('splits3D_y'); SubstTarget.Add('splits_y');
SubstSource.Add('splits3D_z'); SubstTarget.Add('splits_z');
end;
if (GetVariationIndex('blob_fl') < 0) then // AV
begin
SubstSource.Add('blob_fl'); SubstTarget.Add('blob');
SubstSource.Add('blob_fl_high'); SubstTarget.Add('blob_fl_high');
SubstSource.Add('blob_fl_low'); SubstTarget.Add('blob_low');
SubstSource.Add('blob_fl_waves'); SubstTarget.Add('blob_waves');
end;
if (GetVariationIndex('twintrian2') < 0) then begin // AV
SubstSource.Add('twintrian2'); SubstTarget.Add('twintrian');
end;
if (GetVariationIndex('Z_disc2') < 0) then // AV
begin
SubstSource.Add('Z_disc2'); SubstTarget.Add('disc2');
SubstSource.Add('Z_disc2_rot'); SubstTarget.Add('disc2_rot');
SubstSource.Add('Z_disc2_twist'); SubstTarget.Add('disc2_twist');
end;
end;
function TMainForm.ReadWithSubst(Attributes: TAttrList; attrname: string): string;
var i: integer; v: TStringType;
begin
v := Attributes.Value(TStringType(attrname));
if (v <> '') then begin
Result := String(v);
Exit;
end;
for i := 0 to SubstTarget.Count - 1 do begin
if (SubstTarget[i] = attrname) then begin
v := Attributes.Value(TStringType(SubstSource[i]));
if (v <> '') then begin
Result := String(v);
Exit;
end;
end;
end;
Result := '';
end;
end.