{ 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-2022 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, StdCtrls, Classes, Messages, ExtCtrls, ImgList, System.ImageList, Vcl.Imaging.Jpeg, SyncObjs, SysUtils, Graphics, Math, Vcl.ToolWin, ExtDlgs, AppEvnts, ShellAPI, Registry, Global, Xform, XFormMan, ControlPoint, CMap, RenderThread, RenderingCommon, RenderingInterface, LibXmlParser, LibXmlComps, Vcl.Imaging.PngImage, StrUtils, LoadTracker, CommandLine, Translation, RegularExpressionsCore, RegexHelper, Vcl.Themes, Vcl.Styles; // AV const mbHeight = 30; // AV: height (in items) of all styled submenus {$ifdef CPUX86} randFilename = 'ApophysisAV.rand'; undoFilename = 'ApophysisAV.undo'; ApophysisSVN = 'Apophysis AV (32 bit)'; // AV: the caption for all dialogs {$else} randFilename = 'ApophysisAV_64.rand'; // AV undoFilename = 'ApophysisAV_64.undo'; // AV ApophysisSVN = 'Apophysis AV (64 bit)'; {$endif} templateFilename = 'ApophysisAV.temp'; //templatePath = '\templates'; // AV: hmm, we have a global variable with the same name... // scriptPath = '\scripts'; type TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove, msZoomOutWindowMove, msDrag, msDragMove, msRotate, msRotateMove, msPitchYaw, msHeight); type TThumbnailThread = class(TThread) private FlameItems: TListItems; 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; 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; Splitter: TSplitter; ListBackPanel: TPanel; 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; mnuAnimator: TMenuItem; tbAnimate: TToolButton; // 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 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 RedrawTimerTimer(Sender: TObject); procedure FormShow(Sender: TObject); procedure ShowStyledWindows(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 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 XmlScannerComment(Sender: TObject; Comment: string); // AV 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 btnViewIconsClick(Sender: TObject); procedure btnViewListClick(Sender: TObject); procedure XmlScannerEndTag(Sender: TObject; TagName: String); procedure tbMessagesClick(Sender: TObject); procedure btNewClick(Sender: TObject); procedure ToolBarResize(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); procedure mnuAnimatorClick(Sender: TObject); procedure ListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); 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 SetAutoSaveTimer; // AV procedure RunThumbnailThread; inline; procedure FillVariantMenu; procedure VariantMenuClick(Sender: TObject); procedure FavoriteClick(Sender: TObject); procedure ScriptItemClick(Sender: TObject); procedure StopScripter; // AV // 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; StartTime: TDateTime; ParseLoadingBatch : boolean; SurpressHandleMissingPlugins : boolean; VarMenus: array of TMenuItem; ListXmlScanner : TEasyXmlScanner; XmlScanner : TXmlScanner; function ReadWithSubst(Attributes: TAttrList; attrname: string): 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; // AV: we can call it directly 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; procedure AddFlameToList(const title: string = ''); end; procedure ListXML(FileName: string; sel: integer; selname: string = ''); // AV procedure ListIFS(FileName: string; sel: integer); // AV: for loading Undo flame files function FlameToXML(const cp1: TControlPoint; exporting: boolean = false; title: string = ''): string; // AV: make global function LoadXMLFlameText(filename, name: string) : string; function FindFlameXML(const FlameStr: string; const Title: string) : Integer; // AV procedure FlameFromUndo(cp: TControlPoint; const FlameName: string; const ParamFile: 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 RotateCMapHue(var cp: TControlPoint); // AV function FlameInClipboard: boolean; // AV function RemoveExt(filename: string): string; // AV function WinShellExecute(const Operation, AssociatedFile: string): Boolean; // 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; MainCp: TControlPoint; ParseCp: TControlPoint; MemCp: TControlPoint; ThumbnailSize: integer; GeneratingThumbs: boolean; // AV AppVersionString: string; implementation uses ClipBrd, Editor, Options, Settings, Template, MissingPlugin, Chaotica, FullScreen, FormRender, Mutate, Adjust, Browser, Save, About, CmapData, ScriptForm, FormFavorites, FormExport, RndFlame, Tracer, Types, SplashForm, Animate; const TbBreakWidth = 810; // AV {$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)])), ApophysisSVN, MB_ICONINFORMATION); except Application.MessageBox(PChar(TextByKey('common-screenshot-error')), ApophysisSVN, MB_ICONERROR); 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('', flamestr); if (isstart > 0) and (isend > 0) and (isstart < isend) then Result := true; end; 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.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'); 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'); tbAnimate.Hint := TextByKey('main-toolbar-animator'); mnuAnimator.Caption := TextByKey('main-menu-view-animator'); // AV mnuAnimator.Hint := GetLongHint(tbAnimate.Hint); // AV 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; 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: smallint; 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'); if (CurrentStyle = 'Windows') then mb := mbNone else mb := mbBreak; i := 0; while i < mnuBuiltinVars.Count do begin mnuBuiltinVars[i].Break := mb; inc(i, mbHeight); end; i := 0; while i < mnuPluginVars.Count do begin mnuPluginVars[i].Break := mb; inc(i, mbHeight); 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; *) (* // AV: commented out since we have the same methods in RndFlame unit! 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 := ' '' then FlameStart := ' '' then begin i := Pos(FlameStart, Lowercase(FlameStr)); while i > 0 do if PosEx(' i then begin Result := i; break; end; end; end; /////////////////////////////////////////////////////////////////////////////// procedure TMainForm.RandomizeColorSpeed1Click(Sender: TObject); var i: smallint; 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; 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; function GradTitle(str: string): string; var p: integer; begin p := pos('{', str); GradTitle := Trim(copy(str, 1, p - 1)); 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 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 CleanIdentifier(ident: string): string; { Strips unwanted characters from an identifier} var i: integer; begin for i := 1 to Length(ident) do if (ident[i] = #32) or (ident[i] = '}') or (ident[i] = '{') then ident[i] := '_'; Result := ident; end; function CleanUPRTitle(ident: string): string; { Strips braces but leave spaces } var i: integer; begin for i := 1 to Length(ident) do if (ident[i] = '}') or (ident[i] = '{') then ident[i] := '_'; 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 EInOutError do begin Result := False; raise Exception.CreateFmt(TextByKey('common-genericsavefailure'), [FileName]); end; end; end; (* // AV: outdated, for affine coefs only 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(CleanIdentifier(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; *) procedure RotateCMapHue(var cp: TControlPoint); // AV var i: byte; h, s, v: real; hue: double; begin hue := cp.hue_rotation; if (hue > 0) and (hue < 1) then // has visual effect for i := 0 to 255 do begin RGBToHSV(cp.cmap[i][0], cp.cmap[i][1], cp.cmap[i][2], h, s, v); h := Round(360 + h + (hue * 360)) mod 360; HSVToRGB(h, s, v, cp.cmap[i][0], cp.cmap[i][1], cp.cmap[i][2]); 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 Result := False; raise Exception.CreateFmt(TextByKey('common-genericsavefailure'), [FileName]); end; end; end; function ColorToXmlCompact(cp1: TControlPoint): string; var i: integer; begin Result := ' '; 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 + ' '; end; function ColorToXml(cp1: TControlPoint): string; var i: integer; begin Result := ''; for i := 0 to 255 do begin Result := Result + ' ' + #13#10; 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)])), ApophysisSVN, MB_ICONWARNING or MB_OK); end; end; end; function TMainForm.LoadXMLFlameTextPNG(FileName: string): string; var PngObject: TPNGObject; ChunkList: TPngList; TextChunk: TChunkTEXT; flameXML: string; 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 flameXML := string(TextChunk.Text); if FindFlameXML(flameXML, '') > 0 then begin PngObject.Free; // AV: free the memory if search is succeed Exit(flameXML); // AV: XML-flame is found end; break; end else ChunkList.RemoveChunk(TextChunk); // AV: text is not an XML-flame end; // AV: XML-parameters are not found Application.MessageBox(PChar(Format(TextByKey('common-openpngerror2'), [ExtractFileName(FileName)])), ApophysisSVN, MB_ICONWARNING or MB_OK); end; except // AV: error in reading parameters Application.MessageBox(PChar(Format(TextByKey('common-openpngerror3'), [ExtractFileName(FileName)])), ApophysisSVN, MB_ICONWARNING or MB_OK); end; PngObject.Free; // AV: free the memory if search is failed 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; *) // AV: added default parameter values to get rid of duplicated code function FlameToXML(const cp1: TControlPoint; exporting: boolean = false; title: string = ''): string; var t, i: integer; FileList: TStringList; x, y: double; parameters: string; curves, str, cpName: string; begin FileList := TStringList.create; x := cp1.center[0]; y := cp1.center[1]; if title = '' then // AV cpName := CleanXMLName(cp1.name) else cpName := CleanXMLName(title); 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(''); if cp1.comment <> '' then FileList.Add(''); // AV { 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; (* // AV: too bugged... and not extremely useful thing 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(' '); buf := ''; end; end; if (Length(buf) > 0) then FileList.Add(' '); end; *) { Write palette data } if exporting or OldPaletteFormat then FileList.Add(ColorToXml(cp1)) else FileList.Add(ColorToXmlCompact(cp1)); FileList.Add(''); 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, 1, p - 1); // AV: 1 <-- 0 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(' 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); { AV: fixed a bug with data corruption when the name of file or transform is the same as the flame name! Was: 'name="'} while Pos('', 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; 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(' 0 then begin i := 0; while Pos('', FileList[i]); FileList.Delete(i); end; end; // fix first line if (FileList.Count > 0) then begin //FileList[0] := ''; // AV: fix fixed :-) Apo 2.09 uses capital F in this tag if (pos(' 0) then FileList[0] := '' else // single-flame support FileList.Insert(0, ''); end else // AV: if the existing file is empty FileList.Add(''); // AV if FileList.Count > 2 then begin // AV fix last line :-) if (pos('', FileList[FileList.Count - 1]) = 0) then FileList.Add(''); if pos(' 0 then repeat FileList.Delete(FileList.Count - 1); until (Pos('', FileList[FileList.count - 1]) <> 0) else repeat // AV: now condition will be true anyway FileList.Delete(FileList.Count - 1); until (Pos('', FileList[FileList.count - 1]) <> 0) or (Pos('<' + Tag + '>', FileList[FileList.count - 1]) <> 0); end else if (FileList.count > 1) then // AV FileList.Delete(FileList.Count - 1); FileList.Add(Trim(FlameToXML(cp1, false, title))); FileList.Add(''); 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.Add(''); FileList.Add(FlameToXML(cp1, false, title)); FileList.Add(''); FileList.SaveToFile(filename, TEncoding.UTF8); FileList.Free; end; except // AV: fixed multi-updating of the flame Result := False; // AV: first assign the value, then exit raise Exception.CreateFmt(TextByKey('common-genericsavefailure'), [FileName]); 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 := CleanIdentifier(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); { AV: List identifiers in Undo 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; // AV: hack - remember the creation order in an unused field ListItem.OverlayIndex := MainForm.ListView1.Items.Count; end; end; end; end; MainForm.LoadSaveProgress.Position := 0; // AV if ClassicListMode then // AV: thumbs are useless GeneratingThumbs := False else // AV: added thumbnails support for Undo list MainForm.RunThumbnailThread; 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 MainForm.ListView1.Items.EndUpdate; FStrings.Free; end; MainForm.ParseLoadingBatch := false; // AV if AnimateForm.Visible then AnimateForm.UpdateControls; // 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; const {$ifdef CPUX86} bs = 16; {$else} bs = 32; {$endif} var GlobalMemoryInfo: TMemoryStatus; // holds the global memory status information RenderCP: TControlPoint; Mem, ApproxMem: cardinal; 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); 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 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; procedure TMainForm.RandomBatch; { Write a series of random flames to a file } var i: integer; F: TextFile; b, RandFile: string; begin b := IntToStr(BatchSize); inc(MainSeed); RandSeed := MainSeed; RandFile := AppPath + randFilename; try AssignFile(F, RandFile); OpenFile := RandFile; ReWrite(F); WriteLn(F, ''); // AV: fixed ''); 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)); end; Write(F, ''); // AV: fixed ''); CloseFile(F); except on EInOutError do Application.MessageBox(PChar(TextByKey('main-status-batcherror')), ApophysisSVN, 16); end; 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(' 0) then begin MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(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('', Lowercase(FileStrings[i])) <> 0; Result := ParamStrings.Text; finally FileStrings.free; ParamStrings.free; end; 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 StopScripter; // 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 := ''; OpenDialog.Title := ''; // AV // AV: turn back classic dialog since OpenSaveFileDialog looks ugly then themed if OpenDialog.Execute then begin fn := OpenDialog.FileName; // AV LastOpenFile := fn; Maincp.name := ''; ParamFolder := ExtractFilePath(fn); OpenFile := fn; if APP_BUILD = '' then MainForm.Caption := AppVersionString + ' - ' + OpenFile else MainForm.Caption := AppVersionString + ' ' + APP_BUILD + ' - ' + OpenFile; fn := UpperCase(ExtractFileExt(fn)); if (fn = '.UNDO') or (fn = '.APO') then begin OpenFileType := ftApo; // AV ListIFS(OpenDialog.FileName, 1); end else begin OpenFileType := ftXML; ListXML(OpenDialog.FileName, 1); end; 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); begin if ListView1.Selected <> nil then ListView1.Items[ListView1.Selected.Index].EditCaption; 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')), ApophysisSVN, 36) = IDYES else c := Application.MessageBox( PChar(Format(TextByKey('common-confirmdelete'), [ListView1.Selected.Caption])), ApophysisSVN, 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); { // AV: do not change the sequence in order to display all icons properly 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); if AnimateForm.Visible then AnimateForm.UpdateControls; // AV (* // 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 // AV: update flame ONLY if settings were changed if OptionsForm.ShowModal = mrOK then begin StopThread; // --Z-- 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 SetAutoSaveTimer; // AV: to enable autosave without restarting Apophysis if ConfirmResetUndo then ListView1.OnSelectItem := ListViewSelectItem else ListView1.OnSelectItem := nil; DrawImageView; UpdateWindows; end; 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); var i: smallint; begin StopThread; UpdateUndo; inc(MainSeed); RandSeed := MainSeed; for i := 0 to Transforms - 1 do maincp.xform[i].density := random; RedrawTimer.Enabled := True; UpdateWindows; end; procedure TMainForm.mnuRandomBatchClick(Sender: TObject); begin // StopScripter; 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(CleanIdentifier(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); var i: smallint; begin StopThread; UpdateUndo; RedrawTimer.Enabled := True; for i := 0 to Transforms - 1 do maincp.xform[i].density := 0.5; UpdateWindows; end; procedure TMainForm.mnuEditorClick(Sender: TObject); begin EditForm.Show; end; procedure TMainForm.mnuExitClick(Sender: TObject); begin Close; end; procedure TMainForm.mnuSaveUPRClick(Sender: TObject); { Write a UPR to a file } begin SaveForm.SaveType := stExportUPR; SaveForm.Filename := UPRPath; SaveForm.Title := maincp.name; if SaveForm.ShowModal = mrOK then begin UPRPath := SaveForm.FileName; SaveUPR(SaveForm.Title, SaveForm.Filename); end; end; procedure FlameFromUndo(cp: TControlPoint; const FlameName: string; const ParamFile: string); { AV: common method for loading internal-formatted flames } var FStrings, IFSStrings, EntryStrings, Tokens: TStringList; SavedPal: Boolean; i, j: integer; floatcolor: double; s: string; Palette: TColorMap; begin SavedPal := false; FStrings := TStringList.Create; IFSStrings := TStringList.Create; Tokens := TStringList.Create; EntryStrings := TStringList.Create; try FStrings.LoadFromFile(ParamFile); for i := 0 to FStrings.count - 1 do if Pos(FlameName + ' {', 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(FlameName + ' {', 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; cp.ParseString(EntryStrings.Text); if SavedPal then cp.cmap := Palette; cp.name := FlameName; finally IFSStrings.Free; FStrings.Free; Tokens.free; EntryStrings.free; end; end; procedure TMainForm.mnuSaveAsClick(Sender: TObject); { Save fractal parameters to a file } var saved: boolean; // AV ext: string; begin SaveForm.SaveType := stSaveParameters; SaveForm.Filename := SavePath; SaveForm.Title := maincp.name; SaveForm.Comment := maincp.comment; // AV if SaveForm.ShowModal = mrOK then begin maincp.name := SaveForm.Title; SavePath := SaveForm.Filename; maincp.comment := SaveForm.Comment; ext := LowerCase(ExtractFileExt(SavePath)); if ext = '' then SavePath := SavePath + '.flame'; if (ext = '.undo') or (ext = '.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 // AV: fixed re-saving error with OpenDialog.FileName! AddFlameToList; // AV: show the new item end; end; procedure TMainForm.mnuSaveAllAsClick(Sender: TObject); { Save all parameters to a file } var i, current: integer; currentXML : string; cp: TControlPoint; begin SaveForm.SaveType := stSaveAllParameters; SaveForm.Filename := SavePath; if SaveForm.ShowModal = mrOK then begin SavePath := SaveForm.Filename; if ExtractFileExt(SavePath) = '' then SavePath := SavePath + '.flame'; // AV: added support for saving all Undo flames as XML if OpenFileType = ftApo then begin cp := TControlPoint.Create; try for i := 0 to ListView1.Items.Count-1 do begin cp.Clear; FlameFromUndo(cp, ListView1.Items[i].Caption, OpenFile); SaveXMLFlame(cp, cp.name, SavePath); LoadSaveProgress.Position := round(100 * i /(ListView1.Items.Count - 1)); end; finally LoadSaveProgress.Position := 0; // AV cp.Free; end; exit; end; current := ListView1.ItemIndex; // AV: hmm, what if ListView1.Selected = nil? currentXML := Trim(FlameToXML(Maincp)); 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, currentXML, true); // AV: fixed - was PChar instead String SaveXMLFlame(maincp, maincp.name, SavePath); end else begin // AV: cancel useless multiple preview updated LoadXMLFlame(OpenFile, ListView1.Items[i].Caption, false); SaveXMLFlame(maincp, maincp.name, SavePath); end; LoadSaveProgress.Position := round(100 * i / (ListView1.Items.Count - 1)); // AV: display progress end; 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; 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(Sender); end; procedure TMainForm.StopScripter; begin try with ScriptEditor do begin if btnPause.Down then btnPause.Click; Stopped := True; end; except // Beep; 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, MenuItem: TMenuItem; searchResult: TSearchRec; i: integer; s, path: 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; // AV: MainForm.OnClick - why?! 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 NewItem := TMenuItem.Create(Directory1); // (Self); s := searchResult.Name; if (sl.IndexOf(s) < 0) then begin s := RemoveExt(s); NewItem.AutoHotkeys := maManual; // AV: to prevent underlined letters NewItem.Caption := s; NewItem.Hint := Format(TextByKey('main-menu-script-run3'), [s]); NewItem.OnClick := ScriptItemClick; if (Directory1.Find(s) = nil) then Directory1.Add(NewItem); 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 NewItem := TMenuItem.Create(Directory1); // (Self); s := searchResult.Name; if (sl.IndexOf(s) < 0) then begin s := RemoveExt(s); NewItem.AutoHotkeys := maManual; // AV: to prevent underlined letters NewItem.Caption := s; NewItem.Tag := 1; // AV: to identify scripts with different extensions NewItem.Hint := Format(TextByKey('main-menu-script-run3'), [s]); NewItem.OnClick := ScriptItemClick; if (Directory1.Find(s) = nil) then Directory1.Add(NewItem); end; until (FindNext(searchResult) <> 0); FindClose(searchResult); end; if (Directory1.Count = 0) then Directory1.Enabled := False; // AV sl.Free; i := 0; while i < FavouriteScripts1.Count do begin FavouriteScripts1[i].Break := mbBreak; inc(i, mbHeight); end; i := 0; while i < Directory1.Count do begin Directory1[i].Break := mbBreak; inc(i, mbHeight); end; end; procedure TMainForm.FormCreate(Sender: TObject); var dte: string; Registry: TRegistry; apoUI: string; Layouts: array[0..7] of THandle; lnum, i: byte; ExtSM: HMenu; extStyle: TSearchRec; begin AppVersionString := APP_NAME + ' ' + APP_VERSION; SubstSource := TStringList.Create; SubstTarget := TStringList.Create; CreateSubstMap; 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; MainForm.XmlScanner.OnComment := XmlScannerComment; // AV AppPath := ExtractFilePath(Application.ExeName); // AV: moved here ReadSettings; //SaveSettings; LoadLanguage(LanguageFile); InsertStrings; AvailableLanguages := TStringList.Create; AvailableLanguages.Add(''); ListLanguages; SplashWindow.SetInfo(TextByKey('splash-loadingplugins')); MissingPluginList := TStringList.Create; // AV C_SyncDllPlugins; // for Chaotica export if (NXFORMS > 100) then AppVersionString := AppVersionString + ' (' + TextByKey('main-common-title-t500') + ')' else if (NXFORMS < 100) then AppVersionString := AppVersionString + ' (' + TextByKey('main-common-title-lite') + ')'; SplashWindow.SetInfo(TextByKey('splash-loadingui')); // AV: prevent reloading of the splash window after style changing SplashWindow.OnShow := nil; { //*************** 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; 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 ClassicListMode = true then btnViewListClick(nil) else btnViewIconsClick(nil); if ConfirmResetUndo = False then ListView1.OnSelectItem := nil; // AV SaveSettings; // AV: moved back from top to the end end; procedure TMainForm.FormShow(Sender: TObject); var Registry: TRegistry; i: integer; index: 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; SplashWindow.SetInfo(TextByKey('splash-initrenderer')); Application.ProcessMessages; // AV: added to update the status properly { Synchronize menus etc..} // should be defaults.... 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; fn := AppPath + randFilename; if FileExists(fn) then DeleteFile(fn); fn := AppPath + ChangeFileExt(randFilename, '.bak'); // AV if FileExists(fn) then DeleteFile(fn); cmdl := TCommandLine.Create; cmdl.Load; openScript := ''; SplashWindow.SetInfo(TextByKey('splash-initbatch')); // get filename from command line argument 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; // AV: we must precalc the string that is used so often fn := LowerCase(ExtractFileExt(OpenFile)); if FileExists(openFile) and (not ((fn = '.asc') or (fn = '.aposcript'))) then begin LastOpenFile := openFile; LastOpenFileEntry := index; end; if (openFile = '') or (not FileExists(openFile)) and (not ((fn = '.asc') or (fn = '.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; OpenFileType := ftXML; ListXML(OpenFile, 1); if batchsize = 1 then DrawFlame; end else begin if (fn = '.apo') or (fn = '.undo') then begin OpenFileType := ftApo; // AV: we must choose a file type BEFORE updating list view ListIFS(OpenFile, 1); // ListFlames(OpenFile, 1); end else if (fn = '.asc') or (fn = '.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; OpenFileType := ftXML; ListXML(OpenFile, 1); if batchsize = 1 then DrawFlame; end else begin OpenFileType := ftXML; ListXML(OpenFile, 2); 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; SetAutoSaveTimer; // AV: a code block is replaced by a method // 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; ParseXML(MainCP, flameXML, false); //InvokeLoadXML(flameXML); Transforms := MainCp.TrianglesFromCP(MainTriangles); Statusbar.Panels[3].Text := MainCp.name; ResizeImage; RedrawTimer.Enabled := True; Application.ProcessMessages; UpdateWindows; 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; fn: string; begin if ConfirmExit and (UndoIndex <> 0) then if Application.MessageBox(PChar(TextByKey('common-confirmexit')), ApophysisSVN, MB_ICONWARNING or MB_YESNO) <> IDYES then begin Action := caNone; exit; end; AutoSaveTimer.Enabled := False; // AV StopScripter; // AV: stopping the scripter's animation // 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; fn := AppPath + randFilename; if FileExists(fn) then DeleteFile(fn); fn := AppPath + ChangeFileExt(randFilename, '.bak'); // AV if FileExists(fn) then DeleteFile(fn); fn := AppPath + undoFilename; if FileExists(fn) then DeleteFile(fn); fn := APPDATA + export_flame; // AV if FileExists(fn) then DeleteFile(fn); 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 try StopThread; if CanDrawOnResize then reDrawTimer.Enabled := True; ResizeImage; DrawImageView; except end; 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(' 0) then begin ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(FileStrings[i]))); // AV 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('', Lowercase(FileStrings[i])) <> 0; //ScriptEditor.Stopped := True; // <-- AV: I hate this... // If script preview isn't 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.ListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); begin if (UndoIndex <> 0) and (not Selected) then if Application.MessageBox(PChar(TextByKey('common-confirmselect')), ApophysisSVN, 36) = IDYES then mnuSaveUndo.Click; // AV end; procedure TMainForm.ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange); var i: smallint; begin if (ListView1.Selected <> nil) and (Trim(ListView1.Selected.Caption) <> Trim(maincp.name)) then begin LastOpenFileEntry := ListView1.Selected.Index + 1; RedrawTimer.Enabled := False; //? StopThread; if OpenFileType = ftXML then begin // ParseLoadingBatch := false; // AV: ? LoadXMLFlame(OpenFile, ListView1.Selected.caption); AnnoyUser; end else // if OpenFileType = ftApo then // AV: Undo flame list begin maincp.Clear; // initialize control point for new flame; // AV: deleted all duplicated code here FlameFromUndo(maincp, ListView1.Selected.caption, OpenFile); maincp.sample_density := defSampleDensity; maincp.spatial_oversample := defOversample; maincp.spatial_filter_radius := defFilterRadius; //Transforms := MainCP.NumXForms; // we'll change it later 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; 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; 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; 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; maincp.zoom := 0; maincp.center[0] := 0; maincp.center[0] := 0; maincp.ParseString(EntryStrings.Text); 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: smallint; 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: smallint; 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')), ApophysisSVN, 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])), ApophysisSVN, 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 begin MainCp.name := s; // AV: prevent unnecessary flame redrawing StatusBar.Panels[3].Text := s; // AV Application.ProcessMessages; if AnimateForm.Visible then AnimateForm.Close; // TODO if SortFlames.Checked and EnumerateFlames.Checked then EnumerateFlamesClick(EnumerateFlames); // hmm end; 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); begin mnuVRandom.Checked := True; // AV: only one variation can be active here if Variation > vRandom then begin VarMenus[Variation].Checked := False; mnuBuiltinVars.Checked := False; mnuPluginVars.Checked := False; end; 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; //**************** Smooth Palette *********************// 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; PNG: TPNGImage; // AV 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; strings := TStringList.Create; try begin inc(MainSeed); RandSeed := MainSeed; OpenDialog.Filter := RenderForm.SaveDialog.Filter; // AV: added precalc OpenDialog.InitialDir := ImageFolder; OpenDialog.Title := TextByKey('common-selectimage'); // AV OpenDialog.FileName := ''; if OpenDialog.Execute then begin fn := OpenDialog.FileName; // AV ImageFolder := ExtractFilePath(fn); Application.ProcessMessages; len_best := 0; ident := UpperCase(ExtractFileExt(fn)); // AV: added precalc if (ident = '.BMP') or (ident = '.DIB') then Bitmap.LoadFromFile(fn) else if (ident = '.JPG') or (ident = '.JPEG') then begin JPEG := TJPEGImage.Create; try JPEG.LoadFromFile(fn); with Bitmap do begin Width := JPEG.Width; Height := JPEG.Height; Canvas.Draw(0, 0, JPEG); end; finally JPEG.Free; end; end else // if (ident = '.PNG') then // <-- AV: added PNG support here begin PNG := TPNGImage.Create; // AV try PNG.LoadFromFile(fn); with Bitmap do begin Width := PNG.Width; Height := PNG.Height; Canvas.Draw(0, 0, PNG); end; finally PNG.Free; 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 := CleanIdentifier(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; strings.Free; 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; //**********************************************************************// { AV: quick sort to switch between alphabetical and chronological flame order } function ChronoSort(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall; begin Result := (Item1.OverlayIndex - Item2.OverlayIndex); // hacky, but fast... end; procedure TMainForm.SortFlamesClick(Sender: TObject); begin SortFlames.Checked := not SortFlames.Checked; if SortFlames.Checked then begin ListView1.SortType := stText; // AV: to use Morph scripting method properly ScriptForm.ScFileList.Sorted := True; if ListView1.Items.Count > 1 then begin ListView1.AlphaSort; if EnumerateFlames.Checked then EnumerateFlamesClick(EnumerateFlames); end; end else begin ListView1.SortType := stNone; ScriptForm.ScFileList.Sorted := False; if ListView1.Items.Count > 1 then begin ListView1.CustomSort(@ChronoSort, 0); if EnumerateFlames.Checked then EnumerateFlamesClick(EnumerateFlames); end; end; if AnimateForm.Visible then AnimateForm.UpdateControls; 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 <> '') 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: smallint; 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: TPNGImage; begin SaveDialog.DefaultExt := 'png'; SaveDialog.Filter := Format('%s|*.png', [TextByKey('common-filter-png')]); SaveDialog.Filename := maincp.name; if SaveDialog.Execute then begin try pic := TPNGImage.Create; try pic.Assign(Image.Picture.Bitmap); pic.AddtEXt('ApoFlame', AnsiString(Trim(FlameToXML(Maincp)))); 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 // AV: screen size never changed while app works - moved into OnCreate handler { FullScreenForm.Width := Screen.Width; FullScreenForm.Height := Screen.Height; FullScreenForm.Top := 0; FullScreenForm.Left := 0; } FullScreenForm.ActiveForm := Screen.ActiveForm; FullScreenForm.cp.Copy(maincp); FullScreenForm.cp.cmap := maincp.cmap; 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')), ApophysisSVN, 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.bRenderAll := False; //RenderForm.caption := 'Render ' + #39 + maincp.name + #39 + ' to Disk'; RenderForm.Caption := RenderForm.Hint; // AV 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; if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #2 end; RenderForm.Show; end; procedure TMainForm.mnuRenderAllClick(Sender: TObject); var Ext: string; NewRender: Boolean; i: smallint; begin NewRender := True; if Assigned(RenderForm.Renderer) then if Application.MessageBox(PChar(TextByKey('render-status-confirmstop')), ApophysisSVN, 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 := GetShortHint(tbRenderAll.Hint); // AV RenderForm.bRenderAll := true; RenderForm.Filename := RenderPath + maincp.name + Ext; RenderForm.SaveDialog.FileName := RenderForm.Filename; RenderForm.txtFilename.Text := ChangeFileExt(RenderForm.SaveDialog.Filename, Ext); //AV: added support here for any flame-file (not only opened) RenderForm.RenderFlameFile := OpenFile; SetLength(RenderForm.FlameNames, ListView1.Items.Count); for i := 0 to ListView1.Items.Count - 1 do RenderForm.FlameNames[i] := ListView1.Items[i].Caption; { 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.mnuAnimatorClick(Sender: TObject); begin StopScripter; AnimateForm.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 := 'apo'; SaveDialog.Filter := TextByKey('common-filter-undofiles') + '|*undo;*.apo'; SaveDialog.InitialDir := ParamFolder; 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')), ApophysisSVN, 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: smallint; begin StopThread; UpdateUndo; if Transforms > 1 then // AV: fixed divide-by-zero bug for i := 0 to Transforms - 1 do maincp.xform[i].color := i / (transforms - 1) else maincp.xform[0].color := 0; // AV RedrawTimer.Enabled := True; UpdateWindows; end; procedure TMainForm.mnuRandomizeColorValuesClick(Sender: TObject); var i: smallint; 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.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; StatusBar.Panels[3].Text := maincp.name; if SaveXMLFlame(maincp, maincp.name, Filename) and (FileName = OpenFile) then AddFlameToList; 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; begin 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(PAnsiChar(Utf8String(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')}; RotateCMapHue(cp1); // AV 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; // StopScripter; StopThread; ParseXML(MainCP, flameXML, false); // AV: fixed - was PChar instead String AnnoyUser; Transforms := MainCp.TrianglesFromCP(MainTriangles); Statusbar.Panels[3].Text := MainCp.name; if AutoSaveXML then // AV: saving loaded parameters in the current file begin while XMLEntryExists(MainCp.name, OpenFile) do 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 AddFlameToList; // AV: show the new item 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)); 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.PasteTransform.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: string; cp1: TControlPoint; begin if not FileExists(flam3Path) then begin Application.MessageBox(PChar(TextByKey('main-status-noflam3')), ApophysisSVN, 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 Ext := ExtractFileExt(ExportDialog.Filename); if Ext = '.ppm' then ExportFileFormat := 2 else if Ext = '.png' then ExportFileFormat := 3 else // if Ext = '.jpg' then ExportFileFormat := 1; Delete(Ext, 1, 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; ExportEstimator := ExportDialog.Estimator; ExportEstimatorMin := ExportDialog.EstimatorMin; ExportEstimatorCurve := ExportDialog.EstimatorCurve; ExportGammaTreshold := ExportDialog.GammaTreshold; // AV: user cannot change the following, anyway //ExportJitters := ExportDialog.Jitters; //ExportBatches := ExportDialog.Batches; cp1.sample_density := ExportDensity; cp1.spatial_oversample := ExportOversample; cp1.spatial_filter_radius := ExportFilter; cp1.nbatches := 1; //ExportBatches; cp1.jitters := 1; //ExportJitters; 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.gamma_threshold := ExportGammaTreshold; FileList.Text := FlameToXML(cp1, true); 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') + '"'); FileList.SaveToFile(ChangeFileExt(ExportDialog.Filename, '.bat')); if ExportDialog.chkRender.Checked then begin SetCurrentDir(ExtractFilePath(ExportDialog.Filename)); WinShellOpen(ChangeFileExt(ExportDialog.Filename, '.bat')); end; end; finally FileList.Free; cp1.free; ExportDialog.Free; // AV: destroying unnecessary form 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 if (TagName = 'flame') then begin // AV: fixed pname := string(Attributes.value('name')); ptime := string(Attributes.value('time')); // pversion := string(Attributes.value('version')); end; end; procedure TMainForm.XMLScannerStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); var Tokens: TStringList; v: string; //TStringType; ParsePos, i : integer; begin Tokens := TStringList.Create; try if TagName='xformset' then // unused in this release... begin v := string(Attributes.Value('enabled')); if v <> '' then ParseCP.finalXformEnabled := (StrToInt(v) <> 0) else ParseCP.finalXformEnabled := true; inc(activeXformSet); end else if TagName='flame' then begin BeginParsing; v := string(Attributes.value('version')); // AV if (pos('Apophysis 2.0', v) > 0) or (v = '') then oldApo := true else oldApo := false; v := string(Attributes.value('name')); if v <> '' then Parsecp.name := v else Parsecp.name := 'untitled'; v := string(Attributes.Value('time')); if v <> '' then Parsecp.Time := StrToFloat(v); v := string(Attributes.value('palette')); if v <> '' then Parsecp.cmapindex := StrToInt(v) else Parsecp.cmapindex := -1; v := string(Attributes.value('gradient')); if v <> '' then Parsecp.cmapindex := StrToInt(v) else Parsecp.cmapindex := -1; //ParseCP.hue_rotation := 1; v := string(Attributes.value('hue')); // AV: to animate the palette if v <> '' then Parsecp.hue_rotation := StrToFloat(v) else ParseCP.hue_rotation := 1; v := string(Attributes.Value('brightness')); if v <> '' then Parsecp.Brightness := StrToFloat(v); v := string(Attributes.Value('gamma')); if v <> '' then Parsecp.gamma := StrToFloat(v); v := string(Attributes.Value('contrast')); // AV if v <> '' then Parsecp.contrast := StrToFloat(v); v := string(Attributes.Value('vibrancy')); if v <> '' then Parsecp.vibrancy := StrToFloat(v); if (LimitVibrancy) and (Parsecp.vibrancy > 1) then Parsecp.vibrancy := 1; v := string(Attributes.Value('gamma_threshold')); if v <> '' then Parsecp.gamma_threshold := StrToFloat(v) else Parsecp.gamma_threshold := 0; v := string(Attributes.Value('zoom')); if v <> '' then Parsecp.zoom := StrToFloat(v); v := string(Attributes.Value('scale')); if v <> '' then Parsecp.pixels_per_unit := StrToFloat(v); v := string(Attributes.Value('rotate')); if v <> '' then Parsecp.FAngle := -PI * StrToFloat(v)/180; v := string(Attributes.Value('angle')); if v <> '' then Parsecp.FAngle := StrToFloat(v); // 3d v := string(Attributes.Value('cam_pitch')); if v <> '' then Parsecp.cameraPitch := StrToFloat(v); v := string(Attributes.Value('cam_yaw')); if v <> '' then Parsecp.cameraYaw := StrToFloat(v); v := string(Attributes.Value('cam_roll')); if v <> '' then Parsecp.cameraRoll := StrToFloat(v); v := string(Attributes.Value('cam_dist')); if v <> '' then Parsecp.cameraPersp := 1/StrToFloat(v); v := string(Attributes.Value('cam_perspective')); if v <> '' then Parsecp.cameraPersp := StrToFloat(v); v := string(Attributes.Value('cam_zpos')); if v <> '' then Parsecp.cameraZpos := StrToFloat(v); v := string(Attributes.Value('cam_dof')); if v <> '' then Parsecp.cameraDOF := abs(StrToFloat(v)); //density estimation v := string(Attributes.Value('estimator_radius')); if v <> '' then Parsecp.estimator := StrToFloat(v); v := string(Attributes.Value('estimator_minimum')); if v <> '' then Parsecp.estimator_min := StrToFloat(v); v := string(Attributes.Value('estimator_curve')); if v <> '' then Parsecp.estimator_curve := StrToFloat(v); v := string(Attributes.Value('enable_de')); if (v = '1') then Parsecp.enable_de := true; v := string(Attributes.Value('new_linear')); if (v = '1') then // AV Parsecp.noLinearFix := true else ParseCp.noLinearFix := false; v := string(Attributes.Value('curves')); if (v <> '') then begin GetTokens(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 := string(Attributes.Value('center')); GetTokens(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 := string(Attributes.Value('size')); GetTokens(v, tokens); Parsecp.width := StrToInt(Tokens[0]); Parsecp.height := StrToInt(Tokens[1]); try v := string(Attributes.Value('background')); GetTokens(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 := string(Attributes.Value('soloxform')); if v <> '' then Parsecp.soloXform := StrToInt(v); v := string(Attributes.Value('plugins')); GetTokens(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(v) = '' then v := SheepNick; Parsecp.Nick := v; v := Attributes.Value('url'); if Trim(v) = '' then v := SheepUrl; Parsecp.URL := 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 GetComment(str: string): string; { AV: Extracts comment from XML-file } begin try Result := Trim(Copy(str, 5, Length(str) - 7)); except Result := ''; end; end; procedure TMainForm.XmlScannerComment(Sender: TObject; Comment: string); begin ParseCP.comment := GetComment(Comment); 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(Utf8String(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(Utf8String(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); begin if XMLPaletteCount <= 0 then //ShowMessage('ERROR: No colors in palette!'); raise Exception.Create(TextByKey('common-invalidformat') + ': palette'); // AV if XMLPaletteFormat = 'RGB' then begin ParseCompactColors(ParseCP, XMLPaletteCount, Content, false); end else if XMLPaletteFormat = 'RGBA' then begin ParseCompactColors(ParseCP, XMLPaletteCount, Content); end else raise Exception.Create(TextByKey('common-invalidformat') + ': palette'); // AV Parsecp.cmapindex := -1; // AV: restored hue rotation support, useful for animation RotateCMapHue(Parsecp); 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: string; //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')), ApophysisSVN, MB_ICONERROR) // ShowMessage('ERROR: No xforms allowed after FinalXform!') else begin // AV 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 := string(Attributes.Value('weight')); if (v <> '') and (TagName = 'xform') then density := StrToFloat(v); if (TagName = 'finalxform') then begin v := string(Attributes.Value('enabled')); if v <> '' then ParseCP.finalXformEnabled := (StrToInt(v) <> 0) else ParseCP.finalXformEnabled := true; end; if activexformset > 0 then density := 0; // tmp... //**************** AV: checking variation order ***********// v := string(Attributes.Value('var_order')); if v <> '' then begin GetTokens(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 := string(Attributes.Value('color')); if v <> '' then color := StrToFloat(v); v := string(Attributes.Value('var_color')); if v <> '' then pluginColor := StrToFloat(v); v := string(Attributes.Value('symmetry')); if v <> '' then symmetry := StrToFloat(v); v := string(Attributes.Value('coefs')); if v <> '' then begin GetTokens(v, tokens); if Tokens.Count < 6 then Application.MessageBox(PChar(TextByKey('common-invalidformat') + ': coefs'), ApophysisSVN, 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]); end; v := string(Attributes.Value('post')); if v <> '' then begin GetTokens(v, tokens); if Tokens.Count < 6 then Application.MessageBox(PChar(TextByKey('common-invalidformat') + ': post'), ApophysisSVN, 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 := string(Attributes.Value('chaos')); if v <> '' then begin GetTokens(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 := string(Attributes.Value('opacity')); if v <> '' then begin if StrToFloat(v) = 0.0 then begin transOpacity := 0; end else begin transOpacity := StrToFloat(v); end; end; // 7x.9 name tag v := string(Attributes.Value('name')); if v <> '' then begin TransformName := v; end; v := string(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 v := ReadWithSubst(Attributes, varnames(i)); if v <> '' then SetVariation(i, StrToFloat(v)) else SetVariation(i, 0); 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 v := ReadWithSubst(Attributes, varnames(i)); if v <> '' then SetVariation(i, StrToFloat(v)) else SetVariation(i, 0); end; // and the variables for i := 0 to GetNrVariableNames - 1 do begin s := GetVariableNameAt(i); v := ReadWithSubst(Attributes, s); if v <> '' then begin {$ifndef VAR_STR} d := StrToFloat(v); SetVariable(s, d); {$else} SetVariableStr(s, 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 := string(Attributes.Value('perspective')); s := string(Attributes.Value('projective')); if (v <> '') and (s = '') then // avoid to overwrite begin d := StrToFloat(v); SetVariation(GetVariationIndex('projective'), d); v := string(Attributes.Value('perspective_dist')); l := string(Attributes.Value('perspective_angle')); vl := StrToFloat(v); // dist d := StrToFloat(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 := string(Attributes.Value('rings')); s := string(Attributes.Value('rings2')); if (v <> '') and (s = '') then begin d := StrToFloat(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 := string(Attributes.Value('fan')); s := string(Attributes.Value('fan2')); if (v <> '') and (s = '') then begin d := StrToFloat(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 := string(Attributes.Value('bent')); if (v <> '') then begin s := string(Attributes.Value('bent2')); if (s = '') then begin d := StrToFloat(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 := string(Attributes.Value('waves')); s := string(Attributes.Value('waves2')); if (v <> '') and (s = '') then begin d := StrToFloat(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 := string(Attributes.Value('popcorn')); if (v <> '') then begin s := string(Attributes.Value('popcorn2')); if (s = '') then begin d := StrToFloat(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 := string(Attributes.Value('droste')); s := string(Attributes.Value('escher')); if (v <> '') and (s = '') then begin d := StrToFloat(v); SetVariation(GetVariationIndex('escher'), d); v := string(Attributes.Value('droste_r1')); l := string(Attributes.Value('droste_r2')); try vl := StrToFloat(v); // r1 d := StrToFloat(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 := string(Attributes.Value('Spherical3D')); if (v <> '') and (GetVariationIndex('Spherical3D')< 0) then // if plugin is NOT available begin s := string(Attributes.Value('inversion3D')); if (s = '') then begin d := StrToFloat(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 := string(Attributes.Value('secant')); if (v <> '') and (GetVariationIndex('secant') < 0) then // if plugin is NOT available begin s := string(Attributes.Value('secant2')); if (s = '') then begin d := StrToFloat(v); SetVariation(GetVariationIndex('secant2'), d); n := 1; SetVariable('secant2_old', n); end else MissingPlugin.MissingPluginList.Add('secant'); end; // arch into Z_arch v := string(Attributes.Value('arch')); if (v <> '') then begin s := string(Attributes.Value('Z_arch')); if (s = '') then begin d := StrToFloat(v); SetVariation(GetVariationIndex('Z_arch'), d); SetVariable('Z_arch_weight', d); end else MissingPlugin.MissingPluginList.Add('arch'); end; {********************************************************} // legacy variation/variable notation v := string(Attributes.Value('var1')); if v <> '' then begin for i := 0 to NRVAR - 1 do SetVariation(i, 0); SetVariation(StrToInt(v), 1); end; v := string(Attributes.Value('var')); if v <> '' then begin for i := 0 to NRVAR - 1 do SetVariation(i, 0); GetTokens(v, tokens); if Tokens.Count > NRVAR then Application.MessageBox(PChar(TextByKey('common-invalidformat')), ApophysisSVN, MB_ICONERROR); for i := 0 to Tokens.Count - 1 do SetVariation(i, StrToFloat(Tokens[i])); end; end; // AV: prevent crash with flames containing over 100 xforms {$ifndef T500} if nXform < NXFORMS then {$endif} 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 := string(Attributes.value('rgb')); GetTokens(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, j: smallint; s: string; NewMenuItem : TMenuItem; svars: TStringList; begin SetLength(VarMenus, NrVar); // AV: to prevent underlined letters with GUI themes mnuBuiltinVars.AutoHotkeys := maManual; mnuPluginVars.AutoHotkeys := maManual; svars := TStringList.Create; svars.Sorted := True; 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; VarMenus[i] := NewMenuItem; if i < NumBuiltinVars then begin // AV: creating sorted menu j := svars.Add(NewMenuItem.Caption); // AV: remember the position... mnuBuiltinVars.Insert(j, NewMenuItem); // ...and put it at the right place end else // AV: plugin variations are already sorted mnuPluginVars.Add(NewMenuItem); end; svars.Free; // AV: exotic GUI styles not always work well :-/ if TStyleManager.ActiveStyle.Name <> 'Windows' then begin i := 0; while i < mnuBuiltinVars.Count do begin mnuBuiltinVars[i].Break := mbBreak; inc(i, mbHeight); end; i := 0; while i < mnuPluginVars.Count do begin mnuPluginVars[i].Break := mbBreak; inc(i, mbHeight); end; end; end; procedure TMainForm.VariantMenuClick(Sender: TObject); 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... if Variation > vRandom then VarMenus[Variation].Checked := False else mnuVRandom.Checked := False; if (TMenuItem(Sender).Tag >= NumBuiltinVars) then begin mnuBuiltinVars.Checked := False; mnuPluginVars.Checked := True; end else begin mnuBuiltinVars.Checked := True; mnuPluginVars.Checked := False; end; UpdateUndo; // AV: changed Variation to integer - no more ugly type-casting here! Variation := TMenuItem(Sender).Tag; SetVariation(maincp); ResetLocation; RedrawTimer.Enabled := True; UpdateWindows; end; { /////////////////////////////////////////////////////////////////////////// } // AV: make it a separate method to be able to call it later procedure TMainForm.SetAutoSaveTimer; var mins: shortint; begin 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; end; // AV: Apo UI Appearance ///////////////////////////// procedure TMainForm.CreateStyleList; var i: smallint; s: string; apostyle : TMenuItem; begin for i := 0 to Length(TStyleManager.StyleNames)-1 do begin apostyle := TMenuItem.Create(mnuApoStyle); s := TStyleManager.StyleNames[i]; apostyle.Caption := s; if (TStyleManager.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; 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 := TMenuItem(Sender).Caption; 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... MessageBox(0, PChar(TextByKey('options-restartnotice')), ApophysisSVN, 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.btnViewIconsClick(Sender: TObject); 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 RunThumbnailThread; // 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); var saved: boolean; begin StopThread; // AV if AlwaysCreateBlankFlame then EditForm.mnuResetAllClick(Sender) // 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 (OpenFileType = ftXML) then saved := SaveXMLFlame(MainCp, MainCp.name, OpenFile) else saved := SaveFlame(MainCp, MainCp.name, OpenFile); if saved then AddFlameToList; // AV: show the new item end; end; procedure TMainForm.ToolBarResize(Sender: TObject); begin if (Toolbar.Width <= TbBreakWidth) then Toolbar.Height := 60 // 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, bakname : string; FileListPre: TStringList; begin filename := AutoSavePath; title := CleanXMLName(maincp.name) + FormatDateTime(' (MM-dd-yyyy hh-mm-ss)', Now); if FileExists(filename) then begin FileListPre := TStringList.create; try FileListPre.LoadFromFile(filename); if (FileListPre.Count > 100000) then // increased nr of flames // AV: if user working on auto-saved flame, we must NOT delete it if (AutoSavePath <> OpenFile) then begin bakname := ChangeFileExt(filename, '.tmp'); if FileExists(bakname) then DeleteFile(bakname); RenameFile(filename, bakname); end; finally FileListPre.Free; end; end; if SaveXMLFlame(maincp, title, filename) then // AV: added ListView updating if (FileName = OpenFile) then AddFlameToList(title); bakname := ChangeFileExt(filename, '.bak'); if FileExists(bakname) then DeleteFile(bakname); end; procedure TMainForm.Restorelastautosave1Click(Sender: TObject); var fn: string; begin if (not FileExists(AutoSavePath)) then raise Exception.Create(TextByKey('main-status-noautosave')); // AV // StopScripter; fn := AutoSavePath; LastOpenFile := fn; Maincp.name := ''; // AV: ? ParamFolder := ExtractFilePath(fn); OpenFile := fn; 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 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 + Application.HelpFile; if HelpTopic <> '' then URL := URL + '::\' + HelpTopic; HtmlHelp(0, PChar(URL), HH_DISPLAY_TOC, 0); } if (HelpPath <> '') then begin if not (FileExists(HelpPath)) then // AV MessageBox(self.Handle, PCHAR(TextByKey('common-noparamfile')), ApophysisSVN, MB_ICONHAND) else if (not WinShellExecute('open', HelpPath)) then begin MessageBox(self.Handle, PCHAR(Format(TextByKey('common-genericopenfailure'), [HelpPath])), ApophysisSVN, MB_ICONHAND); end; end else MessageBox(self.Handle, PCHAR(TextByKey('main-status-nohelpfile')), ApophysisSVN, 48); end; { function TMainForm.RetrieveXML(cp : TControlPoint):string; begin // AV: commented out since we can call it directly Result := FlameToXML(cp, 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)); ScriptEditor.ScriptFromFlame(txt); ScriptEditor.Show; end; procedure TMainForm.RunThumbnailThread; var thumbs: TThumbnailThread; begin thumbs := TThumbnailThread.Create; thumbs.Start; // AV: Resume method is deprecated here GeneratingThumbs := True; end; constructor TThumbnailThread.Create; begin inherited create(True); // AV: don't run the thread immediately FreeOnTerminate := true; // AV: fixed - someone forgot to free the memory Trace2('Creating ThumbnailThread #' + IntToStr(self.ThreadID)); FlameItems := MainForm.ListView1.Items; // AV: keep the reference to flame list 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: integer; r : double; Fitem: TListItem; FlameProc: TProc; 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.SetSize(FThumbnailSize, FThumbnailSize); Thumbnail.PixelFormat := pf24bit; Thumbnail.HandleType := bmDIB; Thumbnail.Canvas.Lock; // AV: added thread-safe handling Thumbnail.Canvas.Brush.Color := WinColor; // AV: theme-aware GetSysColor(5); if (OpenFileType = ftXML) then FlameProc := procedure begin flameXML := LoadXMLFlameText(Openfile, fCaption); MainForm.ParseXML(cp, flameXML, true); end else // added thumbs support for Undo (*.apo) flames FlameProc := procedure begin FlameFromUndo(cp, fCaption, OpenFile); end; for Fitem in FlameItems do // hope this is more safety loop begin cp.Clear; fCaption := Fitem.Caption; FlameProc; // AV r := cp.Width / cp.Height; w := ThumbnailSize; h := w; if (r < 1) then w := round(r * w) else if (r > 1) then h := round(h / r); 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((ThumbnailSize - w) shr 1, (ThumbnailSize - h) shr 1, Renderer.GetImage); // AV: added thread synchronization for updating visual components Synchronize( procedure begin MainForm.UsedThumbnails.Add(Thumbnail, nil); Fitem.ImageIndex := MainForm.UsedThumbnails.Count - 1; Trace2('Generating thumbnail for "' + fCaption + '"'); end); if Terminated then break; // AV end; finally Thumbnail.Canvas.UnLock; // AV: added thread-safe handling Thumbnail.Free; Thumbnail := nil; cp.Free; Renderer.Free; end; end; procedure ListXML(FileName: string; sel: integer; selname: string = ''); var FStrings : TStringList; i, p : integer; title : string; 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(' 0) then begin for i := 0 to FStrings.Count - 1 do begin p := Pos(' 0) then begin MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(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 // AV: hack - remember the creation order in an unused field item.OverlayIndex := MainForm.ListView1.Items.Count; 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 MainForm.RunThumbnailThread; // AV: wrap it into a separate method 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; if AnimateForm.Visible then AnimateForm.UpdateControls; // AV end; // AV: the fast way to refresh ListView procedure TMainForm.AddFlameToList(const title: string = ''); var item: TListItem; i: integer; fname: string; begin if title = '' then fname := MainCp.name else fname := title; ListView1.Items.BeginUpdate; try // first check for duplicates item := ListView1.FindCaption(max(ListView1.ItemIndex, 0), fname, false, true, true); if item <> nil then ListView1.Items.Delete(item.Index); // AV: temporary prevent all preview updates ListView1.OnChange := nil; ListView1.OnSelectItem := nil; item := ListView1.Items.Add; item.Caption := fname; ListView1.Selected := ListView1.Items[item.Index]; UsedThumbnails.Add(ThumbnailPlaceholder, nil); // add dummy hourglass icon item.ImageIndex := UsedThumbnails.Count - 1; item.OverlayIndex := ListView1.Items.Count; // remember the creation order // if some flames were deleted from the list, max index is greater than the last one for i := 0 to ListView1.Items.Count - 1 do if ListView1.Items[i].OverlayIndex > item.OverlayIndex then item.OverlayIndex := ListView1.Items[i].OverlayIndex + 1; ListView1.Selected := ListView1.Items[item.Index]; ListView1.ItemFocused := ListView1.Selected; if GeneratingThumbs then RefreshThumbnail; finally // AV: restore the default event handlers ListView1.OnChange := ListViewChange; if ConfirmResetUndo then ListView1.OnSelectItem := ListViewSelectItem; ListView1.Items.EndUpdate; end; // refreshing flame indices if EnumerateFlames.Checked then EnumerateFlamesClick(EnumerateFlames); // scroll to the new item if ListView1.Selected <> nil then ListView1.Selected.MakeVisible(true); if AnimateForm.Visible then AnimateForm.UpdateControls; 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.ImageIndex; if (i >= UsedThumbnails.Count) then exit; w_old := Maincp.Width; h_old := Maincp.Height; r := w_old / h_old; w := ThumbnailSize; h := w; if (r < 1) then w := round(r * w) else if (r > 1) then h := round(h / r); 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.SetSize(ThumbnailSize, ThumbnailSize); Thumbnail.Canvas.Brush.Color := WinColor; // theme-aware system color Thumbnail.Canvas.FillRect(Rect(0, 0, ThumbnailSize, ThumbnailSize)); Thumbnail.Canvas.Draw((ThumbnailSize - w) shr 1, (ThumbnailSize - h) shr 1, Renderer.GetImage); try UsedThumbnails.Replace(i, Thumbnail, nil); i := ListView1.Selected.Index; 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; 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; RunThumbnailThread; // 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 str := str + #13#10 + ' - ' + MainCP.used_plugins[i]; // 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')); if MainCp.Comment <> '' then str := str + #13#10 + TextByKey('common-comment') + ': '#13#10'"' + MainCp.Comment + '"'; LoadForm.Output.Text := LoadForm.Output.Text + #13#10 + str + #13#10; end; procedure TMainForm.mnuExportChaoticaClick(Sender: TObject); begin MainCP.FillUsedPlugins; C_ExecuteChaotica(FlameToXml(MainCp), 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: string; //TStringType; begin v := string(Attributes.Value(Utf8String(attrname))); if (v <> '') then begin Result := v; Exit; end; for i := 0 to SubstTarget.Count - 1 do begin if (SubstTarget[i] = attrname) then begin v := string(Attributes.Value(Utf8String(SubstSource[i]))); if (v <> '') then begin Result := v; Exit; end; end; end; Result := ''; end; end.