{ 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. } unit ScriptForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ControlPoint, Buttons, ComCtrls, ToolWin, Menus, Math, XFormMan, XForm, GradientHlpr, cmap, LibXmlParser, LibXmlComps, Translation, atScript, atPascal, Vcl.ScripterInit, ScrMemo, Scrmps, ScrCodeList; const NCPS = 10; // AV: max number of flames for animation scriptFavsFilename = 'scriptsAV.fav'; type TOptions = class public { TOptions class is used only as an interface to user's preferencies } end; TFlame = class public { The TFlame class is used only as an interface. The control point parameters are read and set directly. Parameter ranges aren't limited but values not in the correct range are ignored. } end; TTransform = class public { TTransform class only serves as an interface to active transform } end; TScriptRender = class public MaxMemory, Width, Height: integer; Filename: string; EmbedParameters: boolean; // AV: to write flame params into PNG end; TPivot = class public { TPivot class only serves as an interface to active transform's pivot point } end; TScriptEditor = class(TForm) MainOpenDialog: TOpenDialog; MainSaveDialog: TSaveDialog; ToolBar: TToolBar; btnOpen: TToolButton; btnSave: TToolButton; btnRun: TToolButton; StatusBar: TStatusBar; btnNew: TToolButton; PopupMenu: TPopupMenu; mnuCut: TMenuItem; mnuCopy: TMenuItem; mnuPaste: TMenuItem; mnuUndo: TMenuItem; N1: TMenuItem; BackPanel: TPanel; Editor: TScrMemo; Scripter: TatPascalScripter; Splitter1: TSplitter; Console: TMemo; btnStop: TToolButton; btnBreak: TToolButton; OpenDialog: TOpenDialog; SaveDialog: TSaveDialog; Styler: TScrPascalMemoStyler; Panel1: TPanel; ScrCodeList1: TScrCodeList; CodeButton: TToolButton; btnPause: TToolButton; ScrMemoFindReplaceDialog1: TScrMemoFindReplaceDialog; FindReplace: TMenuItem; N2: TMenuItem; ShowCodeHints: TMenuItem; N3: TMenuItem; CommentOut: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; SurroundBlock: TMenuItem; N7: TMenuItem; BeginEnd1: TMenuItem; TryExcept1: TMenuItem; mnuRedo: TMenuItem; AddFromClipboard: TMenuItem; CodeBlockPopup: TPopupMenu; mnuDeleteBlock: TMenuItem; Editcaption1: TMenuItem; btnFavorite: TToolButton; N8: TMenuItem; CollapseBlocks: TMenuItem; ExpandBlocks: TMenuItem; procedure F2SXMLStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); procedure F2SXMLEmptyTag(Sender: TObject; TagName: string; Attributes: TAttrList); procedure F2SXMLContent(Sender: TObject; Content: string); // procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure btnOpenClick(Sender: TObject); procedure btnSaveClick(Sender: TObject); procedure btnRunClick(Sender: TObject); procedure btnNewClick(Sender: TObject); procedure mnuCutClick(Sender: TObject); procedure mnuCopyClick(Sender: TObject); procedure mnuPasteClick(Sender: TObject); procedure mnuUndoClick(Sender: TObject); procedure EditorChange(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ScripterCompileError(Sender: TObject; var msg: string; row, col: Integer; var ShowException: Boolean); procedure btnStopClick(Sender: TObject); procedure btnBreakClick(Sender: TObject); procedure btnFavoriteClick(Sender: TObject); procedure EditorGetAutoCompletionList(Sender: TObject; AToken: string; AList: TStringList); procedure ScrCodeList1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure ScrCodeList1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure EditorDragDrop(Sender, Source: TObject; X, Y: Integer); procedure EditorDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure CodeButtonClick(Sender: TObject); procedure btnPauseClick(Sender: TObject); procedure ScripterRuntimeError(Sender: TObject; var msg: string; row, col: Integer; var ShowException: Boolean); procedure FindReplaceClick(Sender: TObject); procedure ShowCodeHintsClick(Sender: TObject); procedure SurroundByClick(Sender: TObject); procedure mnuRedoClick(Sender: TObject); procedure ScrCodeList1BlockDblClick(Sender: TObject; ACodeBlock: TCodeBlock); procedure AddFromClipboardClick(Sender: TObject); procedure mnuDeleteBlockClick(Sender: TObject); procedure ScrCodeList1BlockRightClick(Sender: TObject; ACodeBlock: TCodeBlock); procedure ScrCodeList1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure Editcaption1Click(Sender: TObject); procedure CollapseBlocksClick(Sender: TObject); procedure ExpandBlocksClick(Sender: TObject); private //cmap: TColorMap; Flame: TFlame; Transform: TTransform; Options: TOptions; Pivot: TPivot; Another: TScriptRender; { Flame interface } procedure SetFlameNameProc(AMachine: TatVirtualMachine); procedure GetFlameNameProc(AMachine: TatVirtualMachine); procedure SetFlameHueProc(AMachine: TatVirtualMachine); procedure GetFlameHueProc(AMachine: TatVirtualMachine); procedure GetFlameGammaProc(AMachine: TatVirtualMachine); procedure SetFlameGammaProc(AMachine: TatVirtualMachine); procedure GetFlameGammaThresholdProc(AMachine: TatVirtualMachine); procedure SetFlameGammaThresholdProc(AMachine: TatVirtualMachine); procedure GetFlameBrightnessProc(AMachine: TatVirtualMachine); procedure SetFlameBrightnessProc(AMachine: TatVirtualMachine); procedure GetFlameVibrancyProc(AMachine: TatVirtualMachine); procedure SetFlameVibrancyProc(AMachine: TatVirtualMachine); procedure GetFlameContrastProc(AMachine: TatVirtualMachine); procedure SetFlameContrastProc(AMachine: TatVirtualMachine); procedure GetFlameTimeProc(AMachine: TatVirtualMachine); procedure SetFlameTimeProc(AMachine: TatVirtualMachine); procedure GetFlameDensityProc(AMachine: TatVirtualMachine); procedure SetFlameDensityProc(AMachine: TatVirtualMachine); procedure GetFlameOversampleProc(AMachine: TatVirtualMachine); procedure SetFlameOversampleProc(AMachine: TatVirtualMachine); procedure GetFlameFilterRadiusProc(AMachine: TatVirtualMachine); procedure SetFlameFilterRadiusProc(AMachine: TatVirtualMachine); procedure GetFlameWidthProc(AMachine: TatVirtualMachine); procedure SetFlameWidthProc(AMachine: TatVirtualMachine); procedure GetFlameHeightProc(AMachine: TatVirtualMachine); procedure SetFlameHeightProc(AMachine: TatVirtualMachine); procedure GetFlameZoomProc(AMachine: TatVirtualMachine); procedure SetFlameZoomProc(AMachine: TatVirtualMachine); procedure GetFlameXProc(AMachine: TatVirtualMachine); procedure SetFlameXProc(AMachine: TatVirtualMachine); procedure GetFlameYProc(AMachine: TatVirtualMachine); procedure SetFlameYProc(AMachine: TatVirtualMachine); procedure GetFlamePixelsPerUnitProc(AMachine: TatVirtualMachine); procedure SetFlamePixelsPerUnitProc(AMachine: TatVirtualMachine); procedure GetFlamePaletteProc(AMachine: TatVirtualMachine); procedure SetFlamePaletteProc(AMachine: TatVirtualMachine); procedure GetFlameBackgroundProc(AMachine: TatVirtualMachine); procedure SetFlameBackgroundProc(AMachine: TatVirtualMachine); procedure GetFlameCommentProc(AMachine: TatVirtualMachine); procedure SetFlameCommentProc(AMachine: TatVirtualMachine); // procedure SetFlameNickProc(AMachine: TatVirtualMachine); // procedure GetFlameNickProc(AMachine: TatVirtualMachine); // procedure SetFlameURLProc(AMachine: TatVirtualMachine); // procedure GetFlameURLProc(AMachine: TatVirtualMachine); procedure SetFlameBatchesProc(AMachine: TatVirtualMachine); procedure GetFlameBatchesProc(AMachine: TatVirtualMachine); procedure GetFlameFinalxformEnabledProc(AMachine: TatVirtualMachine); procedure SetFlameFinalxformEnabledProc(AMachine: TatVirtualMachine); procedure GetFlameSoloXformProc(AMachine: TatVirtualMachine); procedure SetFlameSoloXformProc(AMachine: TatVirtualMachine); procedure GetFlameAngleProc(AMachine: TatVirtualMachine); procedure SetFlameAngleProc(AMachine: TatVirtualMachine); procedure GetFlamePitchProc(AMachine: TatVirtualMachine); procedure SetFlamePitchProc(AMachine: TatVirtualMachine); procedure GetFlameRollProc(AMachine: TatVirtualMachine); procedure SetFlameRollProc(AMachine: TatVirtualMachine); procedure GetFlameYawProc(AMachine: TatVirtualMachine); procedure SetFlameYawProc(AMachine: TatVirtualMachine); procedure GetFlameCamZposProc(AMachine: TatVirtualMachine); procedure SetFlameCamZposProc(AMachine: TatVirtualMachine); procedure GetFlamePerspectiveProc(AMachine: TatVirtualMachine); procedure SetFlamePerspectiveProc(AMachine: TatVirtualMachine); procedure GetFlameDOFProc(AMachine: TatVirtualMachine); procedure SetFlameDOFProc(AMachine: TatVirtualMachine); procedure GetPreviewHeightProc(AMachine: TatVirtualMachine); procedure SetPreviewHeightProc(AMachine: TatVirtualMachine); procedure GetPreviewWidthProc(AMachine: TatVirtualMachine); procedure SetPreviewWidthProc(AMachine: TatVirtualMachine); { Transform interface } procedure GetTransformAProc(AMachine: TatVirtualMachine); procedure SetTransformAProc(AMachine: TatVirtualMachine); procedure GetTransformBProc(AMachine: TatVirtualMachine); procedure SetTransformBProc(AMachine: TatVirtualMachine); procedure GetTransformCProc(AMachine: TatVirtualMachine); procedure SetTransformCProc(AMachine: TatVirtualMachine); procedure GetTransformDProc(AMachine: TatVirtualMachine); procedure SetTransformDProc(AMachine: TatVirtualMachine); procedure GetTransformEProc(AMachine: TatVirtualMachine); procedure SetTransformEProc(AMachine: TatVirtualMachine); procedure GetTransformFProc(AMachine: TatVirtualMachine); procedure SetTransformFProc(AMachine: TatVirtualMachine); procedure GetTransformVarProc(AMachine: TatVirtualMachine); procedure SetTransformVarProc(AMachine: TatVirtualMachine); procedure GetTransformVariProc(AMachine: TatVirtualMachine); procedure SetTransformVariProc(AMachine: TatVirtualMachine); procedure GetTransformChaosProc(AMachine: TatVirtualMachine); procedure SetTransformChaosProc(AMachine: TatVirtualMachine); procedure GetTransformPlotModeProc(AMachine: TatVirtualMachine); procedure SetTransformPlotModeProc(AMachine: TatVirtualMachine); procedure GetTransformOpacityProc(AMachine: TatVirtualMachine); procedure SetTransformOpacityProc(AMachine: TatVirtualMachine); procedure GetTransformColorProc(AMachine: TatVirtualMachine); procedure SetTransformColorProc(AMachine: TatVirtualMachine); procedure GetTransformVarColorProc(AMachine: TatVirtualMachine); procedure SetTransformVarColorProc(AMachine: TatVirtualMachine); procedure GetTransformWeightProc(AMachine: TatVirtualMachine); procedure SetTransformWeightProc(AMachine: TatVirtualMachine); procedure GetTransformSymProc(AMachine: TatVirtualMachine); procedure SetTransformSymProc(AMachine: TatVirtualMachine); // AV: something new procedure GetTransformNameProc(AMachine: TatVirtualMachine); procedure SetTransformNameProc(AMachine: TatVirtualMachine); procedure TransformSwapCoefsProc(AMachine: TatVirtualMachine); procedure TransformResetVariables(AMachine: TatVirtualMachine); // AV: variation order editing procedure TransformMoveVarProc(AMachine: TatVirtualMachine); procedure TransformExchangeVarsProc(AMachine: TatVirtualMachine); procedure TransformCopyVarOrderProc(AMachine: TatVirtualMachine); procedure TransformSortVarsProc(AMachine: TatVirtualMachine); procedure TransformDefaultVarOrderProc(AMachine: TatVirtualMachine); procedure TransformGetVarOrderProc(AMachine: TatVirtualMachine); procedure TransformDisplayVarsProc(AMachine: TatVirtualMachine); procedure GetTransformVariationProc(AMachine: TatVirtualMachine); procedure SetTransformVariationProc(AMachine: TatVirtualMachine); procedure GetTransformVariableProc(AMachine: TatVirtualMachine); procedure SetTransformVariableProc(AMachine: TatVirtualMachine); procedure GetTransformCoefsProc(AMachine: TatVirtualMachine); procedure SetTransformCoefsProc(AMachine: TatVirtualMachine); procedure GetTransformPostCoefsProc(AMachine: TatVirtualMachine); procedure SetTransformPostCoefsProc(AMachine: TatVirtualMachine); procedure TransformClearProc(AMachine: TatVirtualMachine); procedure TransformRotateProc(AMachine: TatVirtualMachine); procedure TransformScaleProc(AMachine: TatVirtualMachine); procedure TransformRotateOriginProc(AMachine: TatVirtualMachine); // AV: added reflections procedure TransformFlipHorizProc(AMachine: TatVirtualMachine); procedure TransformFlipVertProc(AMachine: TatVirtualMachine); // AV: post-affine transformations procedure TransformRotatePXOriginProc(AMachine: TatVirtualMachine); procedure TransformRotatePXProc(AMachine: TatVirtualMachine); procedure TransformFlipPXHorizProc(AMachine: TatVirtualMachine); procedure TransformFlipPXVertProc(AMachine: TatVirtualMachine); procedure TransformScalePXProc(AMachine: TatVirtualMachine); procedure GetTransformPostxformEnabledProc(AMachine: TatVirtualMachine); procedure SetTransformPostxformEnabledProc(AMachine: TatVirtualMachine); { Render interface } procedure GetRenderFilenameProc(AMachine: TatVirtualMachine); procedure SetRenderFilenameProc(AMachine: TatVirtualMachine); procedure GetRenderWidthProc(AMachine: TatVirtualMachine); procedure SetRenderWidthProc(AMachine: TatVirtualMachine); procedure GetRenderHeightProc(AMachine: TatVirtualMachine); procedure SetRenderHeightProc(AMachine: TatVirtualMachine); procedure GetRenderMaxMemoryProc(AMachine: TatVirtualMachine); procedure SetRenderMaxMemoryProc(AMachine: TatVirtualMachine); procedure GetRenderEmbedParams(AMachine: TatVirtualMachine); // AV procedure SetRenderEmbedParams(AMachine: TatVirtualMachine); // AV procedure FillFileList; { Options interface } procedure GetJPEGQuality(AMachine: TatVirtualMachine); procedure SetJPEGQuality(AMachine: TatVirtualMachine); procedure GetMultithreading(AMachine: TatVirtualMachine); procedure SetMultithreading(AMachine: TatVirtualMachine); procedure GetBatchSize(AMachine: TatVirtualMachine); procedure SetBatchSize(AMachine: TatVirtualMachine); procedure GetParameterFile(AMachine: TatVirtualMachine); procedure SetParameterFile(AMachine: TatVirtualMachine); procedure GetSmoothPaletteFile(AMachine: TatVirtualMachine); procedure SetSmoothPaletteFile(AMachine: TatVirtualMachine); procedure GetNumTries(AMachine: TatVirtualMachine); procedure SetNumTries(AMachine: TatVirtualMachine); procedure GetTryLength(AMachine: TatVirtualMachine); procedure SetTryLength(AMachine: TatVirtualMachine); procedure GetConfirmDelete(AMachine: TatVirtualMachine); procedure SetConfirmDelete(AMachine: TatVirtualMachine); // procedure GetFixedReference(AMachine: TatVirtualMachine); // procedure SetFixedReference(AMachine: TatVirtualMachine); procedure GetSampleDensity(AMachine: TatVirtualMachine); procedure SetSampleDensity(AMachine: TatVirtualMachine); procedure GetGamma(AMachine: TatVirtualMachine); procedure SetGamma(AMachine: TatVirtualMachine); procedure GetGammaThreshold(AMachine: TatVirtualMachine); procedure SetGammaThreshold(AMachine: TatVirtualMachine); procedure GetRandomGradientFile(AMachine: TatVirtualMachine); procedure SetRandomGradientFile(AMachine: TatVirtualMachine); procedure GetBrightness(AMachine: TatVirtualMachine); procedure SetBrightness(AMachine: TatVirtualMachine); procedure GetContrast(AMachine: TatVirtualMachine); procedure SetContrast(AMachine: TatVirtualMachine); procedure GetVibrancy(AMachine: TatVirtualMachine); procedure SetVibrancy(AMachine: TatVirtualMachine); procedure GetOversample(AMachine: TatVirtualMachine); procedure SetOversample(AMachine: TatVirtualMachine); procedure GetFilterRadius(AMachine: TatVirtualMachine); procedure SetFilterRadius(AMachine: TatVirtualMachine); procedure GetTransparency(AMachine: TatVirtualMachine); procedure SetTransparency(AMachine: TatVirtualMachine); procedure GetLowQuality(AMachine: TatVirtualMachine); procedure SetLowQuality(AMachine: TatVirtualMachine); procedure GetMediumQuality(AMachine: TatVirtualMachine); procedure SetMediumQuality(AMachine: TatVirtualMachine); procedure GetHighQuality(AMachine: TatVirtualMachine); procedure SetHighQuality(AMachine: TatVirtualMachine); procedure GetMinTransforms(AMachine: TatVirtualMachine); procedure SetMinTransforms(AMachine: TatVirtualMachine); procedure GetMaxTransforms(AMachine: TatVirtualMachine); procedure SetMaxTransforms(AMachine: TatVirtualMachine); procedure GetMutateMinTransforms(AMachine: TatVirtualMachine); procedure SetMutateMinTransforms(AMachine: TatVirtualMachine); procedure GetMutateMaxTransforms(AMachine: TatVirtualMachine); procedure SetMutateMaxTransforms(AMachine: TatVirtualMachine); procedure GetPrefix(AMachine: TatVirtualMachine); procedure SetPrefix(AMachine: TatVirtualMachine); procedure GetKeepBackground(AMachine: TatVirtualMachine); procedure SetKeepBackground(AMachine: TatVirtualMachine); procedure GetSymmetryType(AMachine: TatVirtualMachine); procedure SetSymmetryType(AMachine: TatVirtualMachine); procedure GetSymmetryOrder(AMachine: TatVirtualMachine); procedure SetSymmetryOrder(AMachine: TatVirtualMachine); procedure GetVariations(AMachine: TatVirtualMachine); procedure SetVariations(AMachine: TatVirtualMachine); procedure GetRandomGradient(AMachine: TatVirtualMachine); procedure SetRandomGradient(AMachine: TatVirtualMachine); // AV: new gradient options procedure GetGradientBlending(AMachine: TatVirtualMachine); procedure SetGradientBlending(AMachine: TatVirtualMachine); procedure GetEqualGradient(AMachine: TatVirtualMachine); procedure SetEqualGradient(AMachine: TatVirtualMachine); procedure GetMinNodes(AMachine: TatVirtualMachine); procedure SetMinNodes(AMachine: TatVirtualMachine); procedure GetMaxNodes(AMachine: TatVirtualMachine); procedure SetMaxNodes(AMachine: TatVirtualMachine); procedure GetMinHue(AMachine: TatVirtualMachine); procedure SetMinHue(AMachine: TatVirtualMachine); procedure GetMaxHue(AMachine: TatVirtualMachine); procedure SetMaxHue(AMachine: TatVirtualMachine); procedure GetMinSat(AMachine: TatVirtualMachine); procedure SetMinSat(AMachine: TatVirtualMachine); procedure GetMaxSat(AMachine: TatVirtualMachine); procedure SetMaxSat(AMachine: TatVirtualMachine); procedure GetMinLum(AMachine: TatVirtualMachine); procedure SetMinLum(AMachine: TatVirtualMachine); procedure GetMaxLum(AMachine: TatVirtualMachine); procedure SetMaxLum(AMachine: TatVirtualMachine); procedure GetUPRSampleDensity(AMachine: TatVirtualMachine); procedure SetUPRSampleDensity(AMachine: TatVirtualMachine); procedure GetUPROversample(AMachine: TatVirtualMachine); procedure SetUPROversample(AMachine: TatVirtualMachine); procedure GetUPRFilterRadius(AMachine: TatVirtualMachine); procedure SetUPRFilterRadius(AMachine: TatVirtualMachine); procedure GetUPRColoringIdent(AMachine: TatVirtualMachine); procedure SetUPRColoringIdent(AMachine: TatVirtualMachine); procedure GetUPRColoringFile(AMachine: TatVirtualMachine); procedure SetUPRColoringFile(AMachine: TatVirtualMachine); procedure GetUPRFormulaIdent(AMachine: TatVirtualMachine); procedure SetUPRFormulaIdent(AMachine: TatVirtualMachine); procedure GetUPRFormulaFile(AMachine: TatVirtualMachine); procedure SetUPRFormulaFile(AMachine: TatVirtualMachine); procedure GetUPRAdjustDensity(AMachine: TatVirtualMachine); procedure SetUPRAdjustDensity(AMachine: TatVirtualMachine); procedure GetUPRWidth(AMachine: TatVirtualMachine); procedure SetUPRWidth(AMachine: TatVirtualMachine); procedure GetUPRHeight(AMachine: TatVirtualMachine); procedure SetUPRHeight(AMachine: TatVirtualMachine); procedure GetExportPath(AMachine: TatVirtualMachine); procedure SetExportPath(AMachine: TatVirtualMachine); { Pivot interface } procedure GetPivotModeProc(AMachine: TatVirtualMachine); procedure SetPivotModeProc(AMachine: TatVirtualMachine); procedure GetPivotXProc(AMachine: TatVirtualMachine); procedure SetPivotXProc(AMachine: TatVirtualMachine); procedure GetPivotYProc(AMachine: TatVirtualMachine); procedure SetPivotYProc(AMachine: TatVirtualMachine); procedure SetPivotProc(AMachine: TatVirtualMachine); procedure ResetPivotProc(AMachine: TatVirtualMachine); // AV: moved here from TOperationLibrary procedure CopyFileProc(AMachine: TatVirtualMachine); public cp: TControlPoint; Stopped: boolean; Renderer: TScriptRender; procedure LoadRunAndClear(scriptFile:string); procedure LoadScriptFile(filename:string); procedure ScriptFromFlame(flameXML:string); procedure UpdateFlame; procedure PrepareScripter; procedure OpenScript; procedure RunScript; procedure AdjustScripterColors; end; // TMatrix = array[0..2, 0..2] of double; // AV: we already have such a type EFormatInvalid = class(Exception); var ScriptEditor: TScriptEditor; ScFileList: TStringList; // AV: renamed due to sporadic name-space conflicts LastError: string; implementation uses Main, Editor, Adjust, Global, Mutate, Registry, Preview, LoadTracker, ScriptRender, ap_math, ap_classes, ap_sysutils, ap_Dialogs, ap_windows, ap_FileCtrl, ap_Forms; {$R *.DFM} var ErrorOutOfRange, RTError, DTError: string; // AV chaosLines : TStringList; cps: array[0..NCPS - 1] of TControlPoint; ResetLocation, UpdateIt: Boolean; NumTransforms: integer; // Keeps track of number of xforms in flame. ActiveTransform: integer; // Operations affect this transform. ParamFile: string; AddedXForms : integer; type TOperationLibrary = class(TatScripterLibrary) protected procedure RotateFlameProc(AMachine: TatVirtualMachine); procedure RotateReferenceProc(AMachine: TatVirtualMachine); procedure RotateProc(AMachine: TatVirtualMachine); procedure ScaleProc(AMachine: TatVirtualMachine); procedure MulProc(AMachine: TatVirtualMachine); procedure TranslateProc(AMachine: TatVirtualMachine); // AV: added for completeness procedure MulPXProc(AMachine: TatVirtualMachine); procedure TranslatePXProc(AMachine: TatVirtualMachine); procedure GetActiveTransformProc(AMachine: TatVirtualMachine); procedure SetActiveTransformProc(AMachine: TatVirtualMachine); procedure GetSelectedTransformProc(AMachine: TatVirtualMachine); // AV procedure SetSelectedTransformProc(AMachine: TatVirtualMachine); // AV procedure TransformsProc(AMachine: TatVirtualMachine); procedure FileCountProc(AMachine: TatVirtualMachine); procedure AddTransformProc(AMachine: TatVirtualMachine); procedure DeleteTransformProc(AMachine: TatVirtualMachine); procedure CopyTransformProc(AMachine: TatVirtualMachine); procedure ClearProc(AMachine: TatVirtualMachine); procedure PreviewProc(AMachine: TatVirtualMachine); procedure Print(AMachine: TatVirtualMachine); procedure PrepareToMorphProc(AMachine: TatVirtualMachine); // AV procedure MorphProc(AMachine: TatVirtualMachine); procedure RenderProc(AMachine: TatVirtualMachine); procedure AddSymmetryProc(AMachine: TatVirtualMachine); procedure StoreFlameProc(AMachine: TatVirtualMachine); procedure GetFlameProc(AMachine: TatVirtualMachine); procedure LoadFlameProc(AMachine: TatVirtualMachine); procedure SetRenderBounds(AMachine: TatVirtualMachine); procedure GetFileName(AMachine: TatVirtualMachine); procedure ListFileProc(AMachine: TatVirtualMachine); procedure SetParamFileProc(AMachine: TatVirtualMachine); procedure SaveFlameProc(AMachine: TatVirtualMachine); procedure ShowStatusProc(AMachine: TatVirtualMachine); procedure RandomFlame(AMachine: TatVirtualMachine); procedure RandomGradientProc(AMachine: TatVirtualMachine); procedure PresetGradientProc(AMachine: TatVirtualMachine); // AV procedure SaveGradientProc(AMachine: TatVirtualMachine); procedure GetVariation(AMachine: TatVirtualMachine); procedure SetVariation(AMachine: TatVirtualMachine); procedure VariationIndexProc(AMachine: TatVirtualMachine); procedure VariationNameProc(AMachine: TatVirtualMachine); procedure VariableIndexProc(AMachine: TatVirtualMachine); procedure VariableNameProc(AMachine: TatVirtualMachine); procedure CalculateScale(AMachine: TatVirtualMachine); procedure NormalizeVars(AMachine: TatVirtualMachine); procedure CalculateBounds(AMachine: TatVirtualMachine); procedure GetSaveFileName(AMachine: TatVirtualMachine); // procedure CopyFileProc(AMachine: TatVirtualMachine); procedure GetCurrentFile(AMachine: TatVirtualMachine); // AV: added Flame Menu items procedure CalculateColors(AMachine: TatVirtualMachine); procedure CalculateWeights(AMachine: TatVirtualMachine); procedure RandomizeColors(AMachine: TatVirtualMachine); procedure RandomizeColorSpeed(AMachine: TatVirtualMachine); procedure CalculateColorSpeed(AMachine: TatVirtualMachine); procedure RandomizeWeights(AMachine: TatVirtualMachine); procedure NormalizeWeights(AMachine: TatVirtualMachine); procedure EqualizeWeights(AMachine: TatVirtualMachine); procedure Init; override; end; procedure TScriptEditor.ScriptFromFlame(flameXML: string); var i : integer; xml : TXmlScanner; begin // Clear & Set caption to "New Script" btnNewClick(btnNew); chaosLines := TStringList.Create; xml := TXmlScanner.Create(nil); xml.Normalize := True; xml.OnContent := F2SXMLContent; // AV: temporary unused xml.OnEmptyTag := F2SXMLEmptyTag; // xml.OnEndTag := F2SXMLEndTag; xml.OnStartTag := F2SXMLStartTag; xml.LoadFromBuffer(PAnsiChar(Utf8String(flameXML))); xml.Execute; xml.Destroy; // use chaosLines... for i := 0 to chaosLines.Count - 1 do Editor.Lines.Add(chaosLines.Strings[i]); chaosLines.Destroy; end; { ************************ Options interface ********************************* } procedure TScriptEditor.GetJPEGQuality(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(JPEGQuality); end; procedure TScriptEditor.SetJPEGQuality(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v > 0) and (v <= 100) then JPEGQuality := v; end; end; procedure TScriptEditor.GetBatchSize(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(BatchSize); end; procedure TScriptEditor.SetBatchSize(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 10) and (v <= 100) then BatchSize := v; end; end; procedure TScriptEditor.GetParameterFile(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defFlameFile); end; procedure TScriptEditor.SetParameterFile(AMachine: TatVirtualMachine); var s: string; i: integer; begin with AMachine do begin s := GetInputArgAsString(0); if (s = '') or FileExists(s) then defFlameFile := s else begin LastError := 'SetFlameFile: ' + TextByKey('common-noparamfile'); i := LineNumberFromInstruction(AMachine.CurrentInstruction); Editor.ActiveLine := i; // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; end; procedure TScriptEditor.GetRandomGradientFile(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(randGradientFile); end; procedure TScriptEditor.SetRandomGradientFile(AMachine: TatVirtualMachine); begin with AMachine do randGradientFile := GetInputArgAsString(0); end; procedure TScriptEditor.GetSmoothPaletteFile(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defSmoothPaletteFile); end; procedure TScriptEditor.SetSmoothPaletteFile(AMachine: TatVirtualMachine); begin with AMachine do defSmoothPaletteFile := GetInputArgAsString(0); end; procedure TScriptEditor.GetNumTries(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(NumTries); end; procedure TScriptEditor.SetNumTries(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v > 0) and (v <= 100) then NumTries := v; end; end; procedure TScriptEditor.GetTryLength(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(TryLength); end; procedure TScriptEditor.SetTryLength(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 100) and (v <= 1000000) then TryLength := v; end; end; procedure TScriptEditor.GetConfirmDelete(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(ConfirmDelete); end; procedure TScriptEditor.SetConfirmDelete(AMachine: TatVirtualMachine); begin with AMachine do ConfirmDelete := GetInputArgAsBoolean(0); end; procedure TScriptEditor.GetContrast(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defContrast); end; procedure TScriptEditor.SetContrast(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.1) and (v <= 10) then defContrast := v; end; end; (* procedure TScriptEditor.GetFixedReference(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(true); //ReferenceMode = 0); end; procedure TScriptEditor.SetFixedReference(AMachine: TatVirtualMachine); begin // with AMachine do // if GetInputArgAsBoolean(0) then ReferenceMode := 0 // else ReferenceMode := 1; end; *) procedure TScriptEditor.GetSampleDensity(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defSampleDensity); end; procedure TScriptEditor.SetSampleDensity(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.1) and (v <= 100) then defSampleDensity := v; end; end; procedure TScriptEditor.GetGamma(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defGamma); end; procedure TScriptEditor.SetGamma(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.1) and (v <= 10) then defGamma := v; end; end; procedure TScriptEditor.GetGammaThreshold(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defGammaThreshold); end; procedure TScriptEditor.SetGammaThreshold(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v > 0) then defGammaThreshold := v; end; end; procedure TScriptEditor.SetGradientBlending(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v < 3) then randColorBlend := v; end; end; procedure TScriptEditor.GetGradientBlending(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(randColorBlend); end; procedure TScriptEditor.GetBrightness(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defBrightness); end; procedure TScriptEditor.SetBrightness(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.1) and (v <= 100) then defBrightness := v; end; end; procedure TScriptEditor.GetVibrancy(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defVibrancy); end; procedure TScriptEditor.SetVibrancy(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0) and (v <= 100) then defVibrancy := v; end; end; procedure TScriptEditor.ShowCodeHintsClick(Sender: TObject); begin ScrCodeList1.ShowHint := ShowCodeHints.Checked; Panel1.ShowHint := not ShowCodeHints.Checked; end; procedure TScriptEditor.GetOversample(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defOversample); end; procedure TScriptEditor.SetOversample(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 1) and (v <= 4) then defOversample := v; end; end; procedure TScriptEditor.GetFilterRadius(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(defFilterRadius); end; procedure TScriptEditor.SetFilterRadius(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.1) then defFilterRadius := v; end; end; procedure TScriptEditor.GetTransparency(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(PNGTransparency); end; procedure TScriptEditor.SetTransparency(AMachine: TatVirtualMachine); var v: double; begin if AMachine.GetInputArgAsInteger(0) = 0 then PNGTransparency := 0 else PNGTransparency := 1; end; procedure TScriptEditor.GetLowQuality(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(prevLowQuality); end; procedure TScriptEditor.SetLowQuality(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.01) and (v <= 100) then prevLowQuality := v; end; end; procedure TScriptEditor.GetMediumQuality(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(prevMediumQuality); end; procedure TScriptEditor.SetMediumQuality(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.01) and (v <= 100) then prevMediumQuality := v; end; end; procedure TScriptEditor.GetHighQuality(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(prevHighQuality); end; procedure TScriptEditor.SetHighQuality(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.01) and (v <= 100) then prevHighQuality := v; end; end; procedure TScriptEditor.GetMinTransforms(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(randMinTransforms); end; procedure TScriptEditor.SetMinTransforms(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= NXFORMS) and (v <= randMaxTransforms) then randMinTransforms := v; end; end; procedure TScriptEditor.GetMaxTransforms(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(randMaxTransforms); end; procedure TScriptEditor.SetMaxTransforms(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= NXFORMS) and (v >= randMinTransforms) then randMaxTransforms := v; end; end; procedure TScriptEditor.GetMutateMinTransforms(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(mutantMinTransforms); end; procedure TScriptEditor.SetMutateMinTransforms(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= NXFORMS) and (v <= mutantMaxTransforms) then mutantMinTransforms := v; end; end; procedure TScriptEditor.GetMutateMaxTransforms(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(mutantMaxTransforms); end; procedure TScriptEditor.SetMutateMaxTransforms(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= NXFORMS) and (v >= mutantMinTransforms) then mutantMaxTransforms := v; end; end; procedure TScriptEditor.GetMultithreading(AMachine: TatVirtualMachine); var v: integer; begin AMachine.ReturnOutputArg(NrTreads); end; procedure TScriptEditor.SetMultithreading(AMachine: TatVirtualMachine); var v: integer; begin v := AMachine.GetInputArgAsInteger(0); if (v > 0) and (v <= UseNrThreads) then // AV: changed max MT value NrTreads := v else begin LastError := 'Options.Multithreading: ' + TextByKey('script-status-varoutofrange'); v := LineNumberFromInstruction(AMachine.CurrentInstruction); Editor.ActiveLine := v; // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; procedure TScriptEditor.GetPrefix(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(RandomPrefix); end; procedure TScriptEditor.SetPrefix(AMachine: TatVirtualMachine); begin with AMachine do RandomPrefix := GetInputArgAsString(0); end; procedure TScriptEditor.GetKeepBackground(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(KeepBackground); end; procedure TScriptEditor.SetKeepBackground(AMachine: TatVirtualMachine); begin with AMachine do KeepBackground := GetInputArgAsBoolean(0); end; procedure TScriptEditor.GetSymmetryType(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(SymmetryType); end; procedure TScriptEditor.SetSymmetryType(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 3) then SymmetryType := v; end; end; procedure TScriptEditor.GetSymmetryOrder(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(SymmetryOrder); end; procedure TScriptEditor.SetSymmetryOrder(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= 2000) then SymmetryOrder := v; end; end; procedure TScriptEditor.GetVariations(AMachine: TatVirtualMachine); var I: Integer; begin with AMachine do begin i := GetArrayIndex(0); if (i >= 0) and (i < NRVAR) then ReturnOutPutArg(Variations[i]); end; end; procedure TScriptEditor.SetVariations(AMachine: TatVirtualMachine); var v: boolean; i, vars: integer; begin with AMachine do begin v := GetInputArgAsBoolean(0); i := GetArrayIndex(0); if (i >= 0) and (i < NRVAR) then begin Variations[i] := v; end; end; end; procedure TScriptEditor.GetRandomGradient(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(randGradient); end; procedure TScriptEditor.SetRandomGradient(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 4) then randGradient := v; // AV: fixed - was max=3 end; end; procedure TScriptEditor.GetMinNodes(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MinNodes); end; procedure TScriptEditor.SetMinNodes(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= 64) and (v <= MaxNodes) then MinNodes := v; end; end; procedure TScriptEditor.GetMaxNodes(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MaxNodes); end; procedure TScriptEditor.SetMaxNodes(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 2) and (v <= 64) and (v >= MinNodes) then MaxNodes := v; end; end; procedure TScriptEditor.GetMinHue(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MinHue); end; procedure TScriptEditor.SetMinHue(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 600) and (v <= MaxHue) then MinHue := v; end; end; procedure TScriptEditor.GetMaxHue(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MaxHue); end; procedure TScriptEditor.SetMaxHue(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 600) and (v >= MinHue) then MaxHue := v; end; end; procedure TScriptEditor.GetMinSat(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MinSat); end; procedure TScriptEditor.SetMinSat(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 100) and (v <= MaxSat) then MinSat := v; end; end; procedure TScriptEditor.GetMaxSat(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MaxSat); end; procedure TScriptEditor.SetMaxSat(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 100) and (v >= MinSat) then MaxSat := v; end; end; procedure TScriptEditor.GetMinLum(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MinLum); end; procedure TScriptEditor.SetMinLum(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 100) and (v <= MaxLum) then MinLum := v; end; end; procedure TScriptEditor.GetMaxLum(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(MaxLum); end; procedure TScriptEditor.SetMaxLum(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) and (v <= 100) and (v >= MinLum) then MaxLum := v; end; end; procedure TScriptEditor.GetUPRSampleDensity(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRSampleDensity); end; procedure TScriptEditor.SetUPRSampleDensity(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v > 0) then UPRSampleDensity := v; end; end; procedure TScriptEditor.GetUPROversample(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPROversample); end; procedure TScriptEditor.SetUPROversample(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v > 0) then UPROversample := v; end; end; procedure TScriptEditor.GetUPRFilterRadius(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRFilterRadius); end; procedure TScriptEditor.SetUPRFilterRadius(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v > 0) then UPRFilterRadius := v; end; end; procedure TScriptEditor.GetUPRColoringIdent(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRColoringIdent); end; procedure TScriptEditor.SetUPRColoringIdent(AMachine: TatVirtualMachine); begin with AMachine do UPRColoringIdent := GetInputArgAsString(0); end; procedure TScriptEditor.GetUPRColoringFile(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRColoringFile); end; procedure TScriptEditor.SetUPRColoringFile(AMachine: TatVirtualMachine); begin with AMachine do UPRColoringFile := GetInputArgAsString(0); end; procedure TScriptEditor.GetUPRFormulaFile(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRFormulaFile); end; procedure TScriptEditor.SetUPRFormulaFile(AMachine: TatVirtualMachine); begin with AMachine do UPRFormulaFile := GetInputArgAsString(0); end; procedure TScriptEditor.GetUPRFormulaIdent(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRFormulaIdent); end; procedure TScriptEditor.SetUPRFormulaIdent(AMachine: TatVirtualMachine); begin with AMachine do UPRFormulaIdent := GetInputArgAsString(0); end; procedure TScriptEditor.GetUPRAdjustDensity(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRAdjustDensity); end; procedure TScriptEditor.SetUPRAdjustDensity(AMachine: TatVirtualMachine); begin with AMachine do UPRAdjustDensity := GetInputArgAsBoolean(0); end; procedure TScriptEditor.GetUPRWidth(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRWidth); end; procedure TScriptEditor.SetUPRWidth(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v > 0) then UPRWidth := v; end; end; procedure TScriptEditor.GetUPRHeight(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(UPRHeight); end; procedure TScriptEditor.SetUPRHeight(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v > 0) then UPRHeight := v; end; end; procedure TScriptEditor.GetEqualGradient(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(EqualStripes); end; procedure TScriptEditor.SetEqualGradient(AMachine: TatVirtualMachine); begin with AMachine do EqualStripes := GetInputArgAsBoolean(0); end; procedure TScriptEditor.GetExportPath(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(flam3Path); end; procedure TScriptEditor.SetExportPath(AMachine: TatVirtualMachine); begin with AMachine do flam3Path := GetInputArgAsString(0); end; { ***************************** Operation Library **************************** } procedure TOperationLibrary.Init; begin Scripter.DefineMethod('RotateFlame', 1, tkNone, nil, RotateFlameProc); Scripter.DefineMethod('RotateReference', 1, tkNone, nil, RotateReferenceProc); Scripter.DefineMethod('Rotate', 1, tkNone, nil, RotateProc); Scripter.DefineMethod('Multiply', 4, tkNone, nil, MulProc); Scripter.DefineMethod('StoreFlame', 1, tkNone, nil, StoreFlameProc); Scripter.DefineMethod('GetFlame', 1, tkNone, nil, GetFlameProc); Scripter.DefineMethod('LoadFlame', 1, tkNone, nil, LoadFlameProc); Scripter.DefineMethod('Scale', 1, tkNone, nil, ScaleProc); Scripter.DefineMethod('Translate', 2, tkNone, nil, TranslateProc); Scripter.DefineMethod('MultiplyPX', 4, tkNone, nil, MulPXProc); Scripter.DefineMethod('TranslatePX', 2, tkNone, nil, TranslatePXProc); Scripter.DefineProp('SelectedTransform', tkInteger, GetSelectedTransformProc, SetSelectedTransformProc); // AV Scripter.DefineProp('ActiveTransform', tkInteger, GetActiveTransformProc, SetActiveTransformProc); Scripter.DefineMethod('SetActiveTransform', 1, tkInteger, nil, SetActiveTransformProc); Scripter.DefineMethod('Transforms', 0, tkInteger, nil, TransformsProc); Scripter.DefineMethod('FileCount', 0, tkInteger, nil, FileCountProc); Scripter.DefineMethod('AddTransform', 0, tkNone, nil, AddTransformProc); Scripter.DefineMethod('DeleteTransform', 0, tkNone, nil, DeleteTransformProc); Scripter.DefineMethod('CopyTransform', 0, tkNone, nil, CopyTransformProc); Scripter.DefineMethod('Clear', 0, tkNone, nil, ClearProc); Scripter.DefineMethod('Preview', 0, tkNone, nil, PreviewProc); Scripter.DefineMethod('Render', 0, tkNone, nil, RenderProc); Scripter.DefineMethod('Print', 1, tkNone, nil, Print); Scripter.DefineMethod('AddSymmetry', 1, tkNone, nil, AddSymmetryProc); Scripter.DefineMethod('PrepareToMorph', 2, tkNone, nil, PrepareToMorphProc); // AV Scripter.DefineMethod('Morph', 4, tkNone, nil, MorphProc, false, 1); Scripter.DefineMethod('SetRenderBounds', 0, tkNone, nil, SetRenderBounds); Scripter.DefineMethod('SetFlameFile', 1, tkNone, nil, SetParamFileProc); Scripter.DefineMethod('ListFile', 1, tkNone, nil, ListFileProc); Scripter.DefineMethod('SaveFlame', 1, tkNone, nil, SaveFlameProc); Scripter.DefineMethod('GetFileName', 0, tkString, nil, GetFileName); Scripter.DefineMethod('ShowStatus', 1, tkNone, nil, ShowStatusProc); Scripter.DefineMethod('RandomFlame', 1, tkNone, nil, RandomFlame); Scripter.DefineMethod('RandomGradient', 0, tkNone, nil, RandomGradientProc); Scripter.DefineMethod('PresetGradient', 1, tkNone, nil, PresetGradientProc); // AV Scripter.DefineMethod('SaveGradient', 2, tkNone, nil, SaveGradientProc); Scripter.DefineMethod('Variation', 0, tkInteger, nil, GetVariation); // AV: fixed Scripter.DefineMethod('SetVariation', 1, tkInteger, nil, SetVariation); // AV: fixed Scripter.AddConstant('ProgramVersionString', AppVersionString); Scripter.DefineMethod('VariationIndex', 1, tkInteger, nil, VariationIndexProc); Scripter.DefineMethod('VariationName', 1, tkString, nil, VariationNameProc); Scripter.DefineMethod('VariableIndex', 1, tkInteger, nil, VariableIndexProc); Scripter.DefineMethod('VariableName', 1, tkString, nil, VariableNameProc); Scripter.DefineMethod('CalculateScale', 0, tkNone, nil, CalculateScale); Scripter.DefineMethod('CalculateBounds', 0, tkNone, nil, CalculateBounds); Scripter.DefineMethod('NormalizeVars', 0, tkNone, nil, NormalizeVars); Scripter.DefineMethod('GetSaveFileName', 0, tkString, nil, GetSaveFileName); // Scripter.DefineMethod('CopyFile', 2, tkString, nil, CopyFileProc); Scripter.DefineMethod('CalculateColors', 0, tkNone, nil, CalculateColors); Scripter.DefineMethod('CalculateColorSpeed', 0, tkNone, nil, CalculateColorSpeed); Scripter.DefineMethod('CalculateWeights', 0, tkNone, nil, CalculateWeights); Scripter.DefineMethod('NormalizeWeights', 0, tkNone, nil, NormalizeWeights); Scripter.DefineMethod('RandomizeColors', 0, tkNone, nil, RandomizeColors); Scripter.DefineMethod('RandomizeColorSpeed', 0, tkNone, nil, RandomizeColorSpeed); Scripter.DefineMethod('RandomizeWeights', 0, tkNone, nil, RandomizeWeights); Scripter.DefineMethod('EqualizeWeights', 0, tkNone, nil, EqualizeWeights); Scripter.DefineProp('CurrentFile', tkString, GetCurrentFile, nil); //Scripter.DefineMethod('BM_Open', 1, tkInteger, nil, BM_OpenProc); //Scripter.DefineMethod('BM_DllCFunc', 2, tkInteger, nil, BM_DllCFuncProc); end; procedure TOperationLibrary.RandomFlame(AMachine: TatVirtualMachine); var i: integer; begin try i := AMachine.GetInputArgAsInteger(0); MainForm.RandomizeCP(ScriptEditor.cp, i); for i := 0 to NXFORMS - 1 do if ScriptEditor.cp.xform[i].density = 0 then break; NumTransforms := i; except on EMathError do end; end; procedure TOperationLibrary.RandomGradientProc(AMachine: TatVirtualMachine); begin ScriptEditor.cp.cmap := GradientHelper.RandomGradient; end; procedure TOperationLibrary.PresetGradientProc(AMachine: TatVirtualMachine); var i: integer; begin i := AMachine.GetInputArgAsInteger(0); if (i >= -1) and (i < NRCMAPS) then GetCMap(i, 1, ScriptEditor.cp.cmap); end; procedure TOperationLibrary.CalculateScale(AMachine: TatVirtualMachine); var x, y: double; begin x := ScriptEditor.cp.center[0]; y := ScriptEditor.cp.center[1]; ScriptEditor.cp.CalcBoundBox; ScriptEditor.cp.center[0] := x; ScriptEditor.cp.center[1] := y; end; procedure TOperationLibrary.CalculateBounds(AMachine: TatVirtualMachine); begin ScriptEditor.cp.CalcBoundBox; end; procedure TOperationLibrary.CalculateColors(AMachine: TatVirtualMachine); var i: smallint; begin if NumTransforms > 1 then // fixed divide-by-zero bug for i := 0 to NumTransforms-1 do ScriptEditor.cp.xform[i].color := i / (NumTransforms-1) else ScriptEditor.cp.xform[0].color := 0; end; procedure TOperationLibrary.CalculateWeights(AMachine: TatVirtualMachine); begin ScriptEditor.cp.CalculateWeights; end; procedure TOperationLibrary.RandomizeColors(AMachine: TatVirtualMachine); var i: smallint; begin for i := 0 to NumTransforms-1 do ScriptEditor.cp.xform[i].color := random; end; procedure TOperationLibrary.RandomizeColorSpeed(AMachine: TatVirtualMachine); var i: smallint; begin for i := 0 to NumTransforms-1 do ScriptEditor.cp.xform[i].symmetry := 2 * random - 1; end; procedure TOperationLibrary.CalculateColorSpeed(AMachine: TatVirtualMachine); begin ScriptEditor.cp.CalculateColorSpeed; end; procedure TOperationLibrary.EqualizeWeights(AMachine: TatVirtualMachine); var i: smallint; begin for i := 0 to NumTransforms-1 do ScriptEditor.cp.xform[i].density := 0.5; end; procedure TOperationLibrary.RandomizeWeights(AMachine: TatVirtualMachine); var i: smallint; begin for i := 0 to NumTransforms-1 do ScriptEditor.cp.xform[i].density := random; end; procedure TOperationLibrary.NormalizeWeights(AMachine: TatVirtualMachine); begin ScriptEditor.cp.NormalizeProbabilities; end; procedure TOperationLibrary.SetRenderBounds(AMachine: TatVirtualMachine); begin // AV: it actually does nothing special... just waste of time ScriptRenderForm.SetRenderBounds; end; procedure TOperationLibrary.SetSelectedTransformProc(AMachine: TatVirtualMachine); var i: integer; begin try with AMachine do i := GetInputArgAsInteger(0); if (i >= 0) and (i < EditForm.cbTransforms.Items.Count) then EditForm.SelectedTriangle := i else raise EFormatInvalid.Create('SelectedTransform: ' + ErrorOutOfRange); except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := E.Message; ScriptEditor.Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TOperationLibrary.GetFileName(AMachine: TatVirtualMachine); begin if ScriptEditor.OpenDialog.Execute then with AMachine do ReturnOutputArg(ScriptEditor.OpenDialog.Filename) else begin LastError := 'GetFileName: ' + TextByKey('save-status-invalidfilename'); ScriptEditor.Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; procedure TOperationLibrary.GetSaveFileName(AMachine: TatVirtualMachine); begin if ScriptEditor.SaveDialog.Execute then with AMachine do ReturnOutputArg(ScriptEditor.SaveDialog.Filename) else begin LastError := 'GetSaveFileName: ' + TextByKey('save-status-invalidfilename'); ScriptEditor.Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; procedure TOperationLibrary.GetSelectedTransformProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutputArg(EditForm.SelectedTriangle); end; (* procedure TOperationLibrary.CopyFileProc(AMachine: TatVirtualMachine); var src, dest: string; FileList: TStringList; begin { // AV: this doesn't work with Unicode strings and conflicts with Windows.CopyFile src := AMachine.GetInputArgAsString(0); dest := AMachine.GetInputArgAsString(1); FileList := TStringList.Create; try if FileExists(src) then begin FileList.LoadFromFile(src); try FileList.SaveToFile(dest); except LastError := 'CopyFile: ' + TextByKey('common-genericcopyfailure'); AMachine.Halt; end; end else begin LastError := 'CopyFile: ' + TextByKey('common-genericcopyfailure'); AMachine.Halt; end; finally FileList.free; end; end; *) procedure TOperationLibrary.SetParamFileProc(AMachine: TatVirtualMachine); var filen: string; begin filen := AMachine.GetInputArgAsString(0); if FileExists(filen) then begin ParamFile := filen; ScriptEditor.FillFileList; end else begin LastError := 'SetFlameFile: ' + TextByKey('common-noparamfile'); AMachine.RuntimeError(LastError); // AV AMachine.Halt; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV end; end; procedure TOperationLibrary.RotateProc(AMachine: TatVirtualMachine); begin try if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then raise EFormatInvalid.Create(ErrorOutOfRange); with ScriptEditor.cp.xform[ActiveTransform] do Rotate(c, AMachine.GetInputArgAsFloat(0)); except on E: EFormatInvalid do begin // ScriptEditor.Console.Lines.Add('Rotate: ' + E.message); LastError := 'Rotate: ' + E.Message; Application.ProcessMessages; end; end; end; procedure TOperationLibrary.MulPXProc(AMachine: TatVirtualMachine); var k, m, l, n: double; begin try if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then raise EFormatInvalid.Create(ErrorOutOfRange); with AMachine do begin k := GetInputArgAsFloat(0); m := GetInputArgAsFloat(1); l := GetInputArgAsFloat(2); n := GetInputArgAsFloat(3); end; with ScriptEditor.cp.xform[ActiveTransform] do Multiply(p, k, l, m, n); // AV: my common method for both matrices except on E: EFormatInvalid do begin // ScriptEditor.Console.Lines.Add('MultiplyPX: ' + E.message); LastError := 'MultiplyPX: ' + E.Message; Application.ProcessMessages; end; end; end; procedure TOperationLibrary.MulProc(AMachine: TatVirtualMachine); var k, m, l, n: double; begin try if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then raise EFormatInvalid.Create(ErrorOutOfRange); with AMachine do // ScriptEditor.cp.xform[ActiveTransform].Multiply(GetInputArgAsFloat(0), GetInputArgAsFloat(1), GetInputArgAsFloat(2), GetInputArgAsFloat(3)); begin k := GetInputArgAsFloat(0); m := GetInputArgAsFloat(1); l := GetInputArgAsFloat(2); n := GetInputArgAsFloat(3); end; with ScriptEditor.cp.xform[ActiveTransform] do if postXswap then Multiply(p, k, l, m, n) // AV: my common method for both matrices else Multiply(c, k, l, m, n); except on E: EFormatInvalid do begin // ScriptEditor.Console.Lines.Add('Multiply: ' + E.message); LastError := 'Multiply: ' + E.Message; Application.ProcessMessages; end; end; end; procedure TOperationLibrary.Print(AMachine: TatVirtualMachine); begin ScriptEditor.Console.Lines.Add(AMachine.GetInputArg(0)); Application.ProcessMessages; end; procedure TOperationLibrary.ShowStatusProc(AMachine: TatVirtualMachine); begin MainForm.StatusBar.Panels[0].Text := AMachine.GetInputArg(0); Application.ProcessMessages; end; procedure TOperationLibrary.SaveFlameProc(AMachine: TatVirtualMachine); var filename, ext: string; begin with AMachine do begin filename := GetInputArgAsString(0); ext := LowerCase(ExtractFileExt(filename)); if (ext = '.apo') or (ext = '.fla') then // AV MainForm.SaveFlame(ScriptEditor.cp, ScriptEditor.cp.name, filename) else MainForm.SaveXMLFlame(ScriptEditor.cp, ScriptEditor.cp.name, filename) end; end; procedure TOperationLibrary.SaveGradientProc(AMachine: TatVirtualMachine); var gradstr: TStringList; gradname: string; begin gradstr := TStringList.Create; try gradname := AMachine.GetInputArgAsString(1); // AV gradstr.add(CleanIdentifier(gradname) + ' {'); gradstr.add(MainForm.GradientFromPalette(ScriptEditor.cp.cmap, gradname)); gradstr.add('}'); MainForm.SaveGradient(gradstr.text, gradname, AMachine.GetInputArgAsString(0)); finally gradstr.free; end; end; procedure TOperationLibrary.ListFileProc(AMachine: TatVirtualMachine); var flafile, ext: string; i: integer; begin flafile := AMachine.GetInputArgAsString(0); if FileExists(flafile) then begin OpenFile := flafile; MainForm.Caption := AppVersionString + ' - ' + OpenFile; ext := LowerCase(ExtractFileExt(flafile)); if (ext = '.apo') or (ext = '.undo') then begin OpenFileType := ftApo; ListIFS(OpenFile, 1); end else begin OpenFileType := ftXML; ListXML(OpenFile, 1); end; MainForm.SetFocus; end else begin try LastError := 'ListFile: ' + Format(TextByKey('common-genericopenfailure'), [Flafile]); except LastError := 'Cannot list file: ' + Flafile; end; i := LineNumberFromInstruction(AMachine.CurrentInstruction); ScriptEditor.Editor.ActiveLine := i; // AV ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; procedure TOperationLibrary.StoreFlameProc(AMachine: TatVirtualMachine); var v: integer; begin v := AMachine.GetInputArgAsInteger(0); if (v >= 0) and (v < NCPS) then begin cps[v].copy(ScriptEditor.cp); // <-- AV: optimized for speed cps[v].cmap := ScriptEditor.cp.cmap; end else begin LastError := 'StoreFlame(' + IntToStr(v) + '): ' + TextByKey('script-status-varoutofrange'); ScriptEditor.Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; procedure TOperationLibrary.GetFlameProc(AMachine: TatVirtualMachine); var i, j: integer; begin j := AMachine.GetInputArgAsInteger(0); if (j >= 0) and (j < NCPS) then begin ScriptEditor.cp.copy(cps[j]); // <-- AV: optimized for speed ScriptEditor.cp.cmap := cps[j].cmap; for i := 0 to NXFORMS - 1 do if ScriptEditor.cp.xform[i].density = 0 then break; NumTransforms := i; // AV: added a special method for easy gradient animation RotateCMapHue(ScriptEditor.cp); end else begin LastError := 'GetFlame(' + IntToStr(j) + '): ' + TextByKey('script-status-varoutofrange'); ScriptEditor.Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV AMachine.Halt; end; end; procedure LoadXMLFlame(index: integer); var FStrings: TStringList; IFSStrings: TStringList; i: integer; begin FStrings := TStringList.Create; IFSStrings := TStringList.Create; try FStrings.LoadFromFile(ParamFile); for i := 0 to FStrings.count - 1 do begin if Pos('', FStrings[i]) <> 0; MainForm.ParseXML(ScriptEditor.Cp, IFSStrings.Text, true); for i := 0 to NXFORMS - 1 do if ScriptEditor.cp.xform[i].density = 0 then break; NumTransforms := i; // ScriptEditor.cp.name := FileList[index]; finally IFSStrings.Free; FStrings.Free; end; end; procedure LoadFlame(index: integer); var i: integer; begin ScriptEditor.cp.Clear; // initialize control point for new flame; ScriptEditor.cp.background[0] := 0; ScriptEditor.cp.background[1] := 0; ScriptEditor.cp.background[2] := 0; ScriptEditor.cp.sample_density := defSampleDensity; ScriptEditor.cp.spatial_oversample := defOversample; ScriptEditor.cp.spatial_filter_radius := defFilterRadius; FlameFromUndo(ScriptEditor.cp, ScFileList[index], ParamFile); // AV for i := 0 to NXFORMS - 1 do if ScriptEditor.cp.xform[i].density = 0 then break; NumTransforms := i; end; procedure TOperationLibrary.LoadFlameProc(AMachine: TatVirtualMachine); var i: integer; ext: string; begin i := AMachine.GetInputArgAsInteger(0); if (i >= 0) and (i < ScFileList.count) then begin ext := LowerCase(ExtractFileExt(ParamFile)); if (ext = '.apo') or (ext = '.undo') then LoadFlame(i) // AV: added support for Undo files else LoadXMLFlame(i); end; end; procedure TOperationLibrary.RotateFlameProc(AMachine: TatVirtualMachine); var Triangles: TTriangles; i: integer; r: double; tx: TXForm; begin tx := TXForm.Create; tx.Assign(scripteditor.cp.xform[NumTransforms]); ScriptEditor.cp.TrianglesFromCp(Triangles); r := AMachine.GetInputArgAsFloat(0) * pi / 180; for i := -1 to NumTransforms - 1 do begin Triangles[i] := RotateTriangle(Triangles[i], r); end; ScriptEditor.cp.GetFromTriangles(Triangles, NumTransforms); scripteditor.cp.xform[NumTransforms].Assign(tx); tx.Free; end; procedure TOperationLibrary.AddSymmetryProc(AMachine: TatVirtualMachine); var i: integer; tx: TXForm; begin tx := TXForm.Create; tx.Assign(scripteditor.cp.xform[NumTransforms]); ScriptEditor.cp.NormalizeProbabilities; // AV add_symmetry_to_control_point(ScriptEditor.cp, AMachine.GetInputArgAsInteger(0)); for i := 0 to NXFORMS - 1 do if ScriptEditor.cp.xform[i].density = 0 then break; NumTransforms := i; scripteditor.cp.xform[i].Assign(tx); tx.Free; end; procedure TOperationLibrary.RotateReferenceProc(AMachine: TatVirtualMachine); var Triangles: TTriangles; r: double; tx: TXForm; begin tx := TXForm.Create; tx.Assign(scripteditor.cp.xform[NumTransforms]); ScriptEditor.cp.TrianglesFromCp(Triangles); r := AMachine.GetInputArgAsFloat(0) * pi / 180; Triangles[-1] := RotateTriangle(Triangles[-1], r); ScriptEditor.cp.GetFromTriangles(Triangles, NumTransforms); scripteditor.cp.xform[NumTransforms].Assign(tx); tx.Free; end; procedure TOperationLibrary.ScaleProc(AMachine: TatVirtualMachine); begin try if (ActiveTransform < 0) or (ActiveTransform >= ScriptEditor.cp.NumXForms) then raise EFormatInvalid.Create(ErrorOutOfRange); with ScriptEditor.cp.xform[ActiveTransform] do Scale(c, AMachine.GetInputArgAsFloat(0)); except on E: EFormatInvalid do begin //ScriptEditor.Console.Lines.Add('Scale: ' + E.message); LastError := 'Scale: ' + E.Message; Application.ProcessMessages; end; end; end; procedure TOperationLibrary.GetActiveTransformProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutputArg(ActiveTransform); end; procedure TOperationLibrary.GetCurrentFile(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutputArg(OpenFile); end; procedure TOperationLibrary.TransformsProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutputArg(NumTransforms); end; procedure TOperationLibrary.GetVariation(AMachine: TatVirtualMachine); begin // AV: changed Variation to integer - no more ugly type-casting here! AMachine.ReturnOutputArg(Variation); end; procedure TOperationLibrary.SetVariation(AMachine: TatVirtualMachine); var i: integer; begin with AMachine do begin i := GetInputArgAsInteger(0); if (i < 0) or (i >= NRVAR) then begin MainForm.mnuVRandom.Checked := True; // AV: only one variation type can be active if Variation > vRandom then begin MainForm.VarMenus[Variation].Checked := False; MainForm.mnuBuiltinVars.Checked := False; MainForm.mnuPluginVars.Checked := False; end; Variation := vRandom; // AV: outdated type, I changed it to integer end else begin MainForm.VarMenus[i].Checked := True; MainForm.mnuVRandom.Checked := False; if Variation > vRandom then MainForm.VarMenus[Variation].Checked := False else MainForm.mnuVRandom.Checked := False; // AV: changed Variation to integer - no more ugly type-casting here! Variation := i; if (i >= NumBuiltinVars) then // AV: fixme begin MainForm.mnuBuiltinVars.Checked := False; MainForm.mnuPluginVars.Checked := True; end else begin MainForm.mnuBuiltinVars.Checked := True; MainForm.mnuPluginVars.Checked := False; end; end; end end; procedure TOperationLibrary.VariationIndexProc(AMachine: TatVirtualMachine); var i: integer; str: string; begin with AMachine do begin { str := LowerCase(GetInputArgAsString(0)); i := NRVAR-1; while (i >= 0) and (LowerCase(varnames(i)) <> str) do Dec(i); } str := GetInputArgAsString(0); // AV i := GetVariationIndex(str); // AV ReturnOutputArg(i); end; end; procedure TOperationLibrary.VariationNameProc(AMachine: TatVirtualMachine); var i: integer; str: string; begin with AMachine do begin i := GetInputArgAsInteger(0); if (i >= 0) and (i < NRVAR) then ReturnOutputArg(varnames(i)) else ReturnOutputArg(''); end; end; procedure TOperationLibrary.VariableIndexProc(AMachine: TatVirtualMachine); var i: integer; str: string; begin with AMachine do begin str := GetInputArgAsString(0); i := GetNrVariableNames-1; while (i >= 0) and (GetVariableNameAt(i) <> str) do Dec(i); ReturnOutputArg(i); end; end; procedure TOperationLibrary.VariableNameProc(AMachine: TatVirtualMachine); var i: integer; begin with AMachine do begin i := GetInputArgAsInteger(0); if (i >= 0) and (i < GetNrVariableNames) then ReturnOutputArg(GetVariableNameAt(i)) else ReturnOutputArg(''); end; end; procedure TOperationLibrary.FileCountProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutputArg(ScFileList.Count); end; procedure TOperationLibrary.ClearProc(AMachine: TatVirtualMachine); var i: integer; begin NumTransforms := 0; ActiveTransform := -1; ScriptEditor.cp.Clear; ScriptEditor.cp.xform[0].symmetry := 1; // AV: why? with ScriptEditor.cp do begin // AV: added 3D-camera resetting for new flames cameraPitch := 0; cameraYaw := 0; cameraRoll := 0; cameraPersp := 0; cameraZPos := 0; cameraDOF := 0; end; end; procedure TOperationLibrary.PrepareToMorphProc(AMachine: TatVirtualMachine); var a, b: integer; begin with AMachine do begin a := GetInputArgAsInteger(0); b := GetInputArgAsInteger(1); if (a >= 0) and (a < NCPS) and (b >= 0) and (b < NCPS) then begin PrepareToInterpolation(cps[a], cps[b]); // adjust flame parameters end else begin LastError := Format('PrepareToMorph(%d, %d): ', [a, b]) + TextByKey('script-status-varoutofrange'); RuntimeError(LastError); Scripter.Halt; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV: show errors end; end; end; procedure TOperationLibrary.MorphProc(AMachine: TatVirtualMachine); var a, b, i: integer; v: double; begin with AMachine do begin a := GetInputArgAsInteger(0); b := GetInputArgAsInteger(1); v := GetInputArgAsFloat(2); if (a >= 0) and (a < NCPS) and (b >= 0) and (b < NCPS) then begin // AV: added interpolation type, with default value "linear / HSV" case InputArgCount of 3: ScriptEditor.cp.InterpolateAll(cps[a], cps[b], v, 3); 4: ScriptEditor.cp.InterpolateAll(cps[a], cps[b], v, GetInputArgAsInteger(3)); else Exit; end; for i := 0 to NXFORMS - 1 do if ScriptEditor.cp.xform[i].density = 0 then break; NumTransforms := i; end else begin LastError := Format('Morph(%d, %d, %g): ', [a, b, v]) + TextByKey('script-status-varoutofrange'); RuntimeError(LastError); Scripter.Halt; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV: show errors end; end; end; procedure TOperationLibrary.PreviewProc(AMachine: TatVirtualMachine); begin if NumTransforms > 0 then begin //AMachine.Paused := True; // AV: it doesn't let to pause the animation PreviewForm.cp.Copy(ScriptEditor.cp); // <-- AV: optimized for speed PreviewForm.cp.AdjustScale(PreviewForm.Image.Width, PreviewForm.Image.Height); PreviewForm.Show; PreviewForm.DrawFlame; //AMachine.Paused := False; // AV: it doesn't let to pause the animation Application.ProcessMessages; end else AMachine.Halt; end; procedure TOperationLibrary.RenderProc(AMachine: TatVirtualMachine); begin if NumTransforms > 0 then begin ScriptRenderForm.cp.Copy(ScriptEditor.cp); try ScriptRenderForm.Caption := Format(ScriptRenderForm.Hint, [ExtractFileName(ScriptEditor.Renderer.Filename)]); // AV except ScriptRenderForm.Caption := TextByKey('common-trace-rendering-oneslice'); end; ScriptRenderForm.Show; ScriptRenderForm.Render; end else AMachine.Halt; end; procedure TOperationLibrary.SetActiveTransformProc(AMachine: TatVirtualMachine); var i: integer; begin try with AMachine do i := GetInputArgAsInteger(0); if (i >= 0) and (i < NXFORMS) then ActiveTransform := i else raise EFormatInvalid.Create('SetActiveTransform: ' + ErrorOutOfRange); except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := E.Message; Scripter.Halt; end; end; end; procedure TOperationLibrary.AddTransformProc(AMachine: TatVirtualMachine); var i: integer; begin try if NumTransforms < NXFORMS then begin ActiveTransform := NumTransforms; inc(NumTransforms); scriptEditor.cp.xform[NumTransforms].Assign(scriptEditor.cp.xform[ActiveTransform]); scriptEditor.cp.xform[ActiveTransform].Clear; ScriptEditor.cp.xform[ActiveTransform].density := 0.5; end else raise EFormatInvalid.Create('AddTransform: ' + TextByKey('script-status-toomanytransforms')); except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := E.Message; Scripter.Halt; end; end; end; procedure TOperationLibrary.DeleteTransformProc(AMachine: TatVirtualMachine); var i, j: integer; begin try // I'm not sure, but *maybe* this will help scripts not to screw up finalXform if ActiveTransform = NumTransforms then // final xform - just clear it begin scriptEditor.cp.xform[NumTransforms].Clear; scriptEditor.cp.xform[NumTransforms].symmetry := 1; scriptEditor.cp.finalXformEnabled := false; exit; end; if NumTransforms <= 1 then exit; // delete xform from all probability tables for i := 0 to NumTransforms-1 do with scriptEditor.cp.xform[i] do begin for j := ActiveTransform to NumTransforms-1 do modWeights[j] := modWeights[j+1]; modWeights[NumTransforms-1] := 1; end; // with scriptEditor.cp do begin if ActiveTransform = (NumTransforms - 1) then Dec(ActiveTransform) else begin for i := ActiveTransform to NumTransforms - 2 do xform[i].Assign(xform[i + 1]); end; Dec(NumTransforms); xform[NumTransforms].Assign(xform[NumTransforms+1]); xform[NumTransforms+1].Clear; end; except Application.ProcessMessages; LastError := 'DeleteTransform: Oops!'; i := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV ScriptEditor.Editor.ActiveLine := i; ScriptEditor.Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; procedure TOperationLibrary.CopyTransformProc(AMachine: TatVirtualMachine); var old, i: integer; begin try if NumTransforms < NXFORMS then with ScriptEditor.cp do begin old := ActiveTransform; ActiveTransform := NumTransforms; inc(NumTransforms); xform[NumTransforms].Assign(xform[ActiveTransform]); // final xform xform[ActiveTransform].Assign(xform[old]); for i := 0 to NumTransforms-1 do xform[i].modWeights[ActiveTransform] := xform[i].modWeights[old]; xform[ActiveTransform].modWeights[ActiveTransform] := xform[old].modWeights[old]; end else raise EFormatInvalid.Create(TextByKey('script-status-toomanytransforms')); except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := 'CopyTransform: ' + E.Message; Scripter.Halt; end; end; end; procedure TOperationLibrary.TranslateProc(AMachine: TatVirtualMachine); var x, y: double; begin try if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then // was: NXFORMS-1 raise EFormatInvalid.Create(ErrorOutOfRange); // AV: matrix multiplication must not affect the translation // ScriptEditor.cp.xform[ActiveTransform].Translate(GetInputArgAsFloat(0), GetInputArgAsFloat(1)); x := AMachine.GetInputArgAsFloat(0); y := AMachine.GetInputArgAsFloat(1); with ScriptEditor.cp.xform[ActiveTransform] do if postXswap then Translate(p, x, y) else Translate(c, x, y); except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := 'Translate: ' + E.Message; Scripter.Halt; end; end; end; procedure TOperationLibrary.TranslatePXProc(AMachine: TatVirtualMachine); var x, y: double; begin try if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then raise EFormatInvalid.Create(ErrorOutOfRange); x := AMachine.GetInputArgAsFloat(0); y := AMachine.GetInputArgAsFloat(1); with ScriptEditor.cp.xform[ActiveTransform] do Translate(p, x, y); except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := 'TranslatePX:' + E.Message; Scripter.Halt; end; end; end; procedure NormalizeVariations(var cp1: TControlPoint); // AV: moved from Main var totvar, v: double; i, j: integer; begin for i := 0 to cp1.NumXForms do begin totvar := 0; for j := 0 to NRVAR - 1 do begin v := cp1.xform[i].GetVariation(j); // AV if v < 0 then cp1.xform[i].SetVariation(j, -v); totvar := totvar + v; end; if totVar = 0 then cp1.xform[i].SetVariation(0, 1) else for j := 0 to NRVAR - 1 do begin v := cp1.xform[i].GetVariation(j); // AV //if totVar <> 0 then // <-- AV: we've already check it! if v <> 0 then // AV: because 0/totvar = 0 cp1.xform[i].SetVariation(j, v / totvar); end; end; end; procedure TOperationLibrary.NormalizeVars(AMachine: TatVirtualMachine); begin NormalizeVariations(ScriptEditor.cp); end; { ************************************* Form ********************************* } procedure TScriptEditor.FormCreate(Sender: TObject); var i: integer; begin self.Caption := TextByKey('script-title'); btnBreak.Hint := TextByKey('script-break'); btnNew.Hint := TextByKey('script-new'); btnOpen.Hint := TextByKey('script-open'); btnSave.Hint := TextByKey('script-save'); btnRun.Hint := TextByKey('script-run'); btnStop.Hint := TextByKey('script-stop'); btnFavorite.Hint := TextByKey('script-faves'); CodeButton.Hint := TextByKey('script-codeblocks'); btnPause.Hint := TextByKey('script-pause'); ShowCodeHints.Caption := TextByKey('script-codeblockhints'); Panel1.Hint := TextByKey('script-codeblockhint'); mnuUndo.Caption := TextByKey('common-undo'); mnuRedo.Caption := TextByKey('common-redo'); mnuCut.Caption := TextByKey('common-cut'); mnuCopy.Caption := TextByKey('common-copy'); mnuPaste.Caption := TextByKey('common-paste'); mnuDeleteBlock.Caption := TextByKey('common-delete'); EditCaption1.Caption := TextByKey('common-rename'); FindReplace.Caption := TextByKey('script-findreplace'); SurroundBlock.Caption := TextByKey('script-surround'); CommentOut.Caption := TextByKey('script-commentout'); CollapseBlocks.Caption := TextByKey('script-collapsecode'); ExpandBlocks.Caption := TextByKey('script-expandcode'); AddFromClipboard.Caption := TextByKey('script-clipboardview'); ScrMemoFindReplaceDialog1.NotFoundMessage := TextByKey('script-textnotfound'); StatusBar.Hint := TextByKey('script-status-default'); StatusBar.SimpleText := StatusBar.Hint; // AV: changed to variable ErrorOutOfRange := TextByKey('script-status-outofrange'); RTError := #13#10 + TextByKey('script-runtimeerror') + #13#10 + StringOfChar('=', length(TextByKey('script-runtimeerror'))) + #13#10; DTError := #13#10 + TextByKey('script-compileerror') + #13#10 + StringOfChar('=', length(TextByKey('script-compileerror'))) + #13#10; // AV: moved this into OnCreate handler since filters never change MainOpenDialog.Filter := Format('%s|*.aposcript;*.asc|%s|*.*', [TextByKey('common-filter-scriptfiles'), TextByKey('common-filter-allfiles')]); MainSaveDialog.Filter := MainOpenDialog.Filter; // AV // AV: added language translation here: SaveDialog.Filter := TextByKey('common-filter-flamefiles') + '|*.flame;*rand;*.template|' + TextByKey('common-filter-undofiles') + '|*.undo;*.apo|' + TextByKey('common-filter-allfiles') + '|*.*'; OpenDialog.Filter := TextByKey('common-filter-flamefiles') +'|*.flame;*rand;*.template|' + TextByKey('common-filter-scriptfiles') + '|*.asc;*aposcript|' + TextByKey('common-filter-undofiles') + '|*.undo;*.apo|' + TextByKey('common-filter-allfiles') + '|*.*'; Transform := TTransform.create; ScFileList := TStringList.Create; Flame := TFlame.Create; Options := TOptions.Create; Pivot := TPivot.Create; Renderer := TScriptRender.create; Another := TScriptRender.create; cp := TControlPoint.create; for i := 0 to 9 do cps[i] := TControlPoint.create; ScriptEditor.PrepareScripter; if (defScriptFile <> '') then // AV try if FileExists(defScriptFile) then begin LoadScriptFile(defScriptFile); Script := defScriptFile; end; except Editor.Lines.Clear; end; // AV: change scripter font ang background for dark themes AdjustScripterColors; end; procedure TScriptEditor.FormDestroy(Sender: TObject); var i: integer; begin ScFileList.Free; Renderer.Free; Another.Free; for i := 0 to 9 do cps[i].free; cp.free; Flame.Free; Transform.Free; Options.Free; Pivot.Free; end; procedure TScriptEditor.FormShow(Sender: TObject); var Registry: TRegistry; begin Registry := TRegistry.Create; try Registry.RootKey := HKEY_CURRENT_USER; if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Script', False) then begin { Size and position } if Registry.ValueExists('Left') then ScriptEditor.Left := Registry.ReadInteger('Left'); if Registry.ValueExists('Top') then ScriptEditor.Top := Registry.ReadInteger('Top'); if Registry.ValueExists('Width') then ScriptEditor.Width := Registry.ReadInteger('Width'); if Registry.ValueExists('Height') then ScriptEditor.Height := Registry.ReadInteger('Height'); if Registry.ValueExists('PreviewFrame') then // AV PreviewForm.KeepFrame.Checked := Registry.ReadBool('PreviewFrame'); end; Registry.CloseKey; finally Registry.Free; end; mnuUndo.Enabled := Editor.CanUndo; // AV mnuRedo.Enabled := Editor.CanRedo; // AV end; procedure TScriptEditor.FormClose(Sender: TObject; var Action: TCloseAction); var Registry: TRegistry; begin { Write position to registry } Registry := TRegistry.Create; try Registry.RootKey := HKEY_CURRENT_USER; { Defaults } if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Script', True) then begin { Size and position } if ScriptEditor.WindowState <> wsMaximized then begin Registry.WriteInteger('Top', ScriptEditor.Top); Registry.WriteInteger('Left', ScriptEditor.Left); Registry.WriteInteger('Width', ScriptEditor.Width); Registry.WriteInteger('Height', ScriptEditor.Height); Registry.WriteBool('PreviewFrame', PreviewForm.KeepFrame.Checked); // AV end; end; finally Registry.Free; end; end; { ************************ Flame interface *********************************** } { The TFlame class is used only as an interface. The control point parameters are read and set directly. Parameter ranges aren't limited but values not in the correct range are ignored. } procedure TScriptEditor.GetFlameGammaThresholdProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.gammaThreshRelative); end; procedure TScriptEditor.SetFlameGammaThresholdProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v > 0) then cp.gammaThreshRelative := v; end; end; procedure TScriptEditor.GetFlameGammaProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.Gamma); end; procedure TScriptEditor.SetFlameGammaProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v > 0) and (v <= 10) then cp.Gamma := v; // AV: added max check end; end; procedure TScriptEditor.GetFlameBrightnessProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.Brightness); end; procedure TScriptEditor.SetFlameBrightnessProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v > 0) and (v <= 100) then cp.Brightness := v; // AV: added max check end; end; procedure TScriptEditor.GetFlameVibrancyProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.Vibrancy); end; procedure TScriptEditor.SetFlameVibrancyProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v > 0) and (v <= 30) then cp.Vibrancy := v; // AV: added max check end; end; procedure TScriptEditor.GetFlameContrastProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.Contrast); // AV end; procedure TScriptEditor.SetFlameContrastProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0.1) and (v <= 10) then cp.Contrast := v; // AV end; end; procedure TScriptEditor.GetFlameTimeProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.Time); end; procedure TScriptEditor.SetFlameTimeProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0) then cp.Time := v; end; end; procedure TScriptEditor.GetPreviewHeightProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(PreviewForm.ClientHeight); end; procedure TScriptEditor.SetPreviewHeightProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 100) and (v <= Screen.Height - 34) then PreviewForm.ClientHeight:= v; end; end; procedure TScriptEditor.GetPreviewWidthProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(PreviewForm.ClientWidth); end; procedure TScriptEditor.SetPreviewWidthProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 100) and (v <= Screen.Width - 16) then PreviewForm.ClientWidth:= v; end; end; procedure TScriptEditor.GetFlameZoomProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.Zoom); end; procedure TScriptEditor.SetFlameZoomProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= -3) and (v <= 3) then cp.Zoom := v; // AV: added check end; end; procedure TScriptEditor.GetFlameXProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.center[0]); end; procedure TScriptEditor.SetFlameXProc(AMachine: TatVirtualMachine); begin with AMachine do cp.center[0] := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetFlameYProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.center[1]); end; procedure TScriptEditor.SetFlameYProc(AMachine: TatVirtualMachine); begin with AMachine do cp.center[1] := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetFlameDensityProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.sample_density); end; procedure TScriptEditor.SetFlameDensityProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if v >= 0 then cp.sample_density := v; end; end; procedure TScriptEditor.GetFlameOversampleProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.spatial_oversample); end; procedure TScriptEditor.SetFlameOversampleProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); { Range = 1 to 4 ... (document this) } if (v >= 1) and (v <= 4) then cp.spatial_oversample := v; end; end; procedure TScriptEditor.GetFlameFilterRadiusProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.spatial_filter_radius); end; procedure TScriptEditor.SetFlameFilterRadiusProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if v >= 0 then cp.spatial_filter_radius := v; end; end; procedure TScriptEditor.GetFlameFinalxformEnabledProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.finalXformEnabled); end; procedure TScriptEditor.SetFlameFinalxformEnabledProc(AMachine: TatVirtualMachine); begin with AMachine do cp.finalXformEnabled := (GetInputArgAsInteger(0) <> 0); end; procedure TScriptEditor.GetFlameSoloXformProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.soloXform); end; procedure TScriptEditor.SetFlameSoloXformProc(AMachine: TatVirtualMachine); begin with AMachine do cp.soloXform := GetInputArgAsInteger(0); if (cp.soloXform < 0) or (cp.soloXform >= NumTransforms) then cp.soloXform := -1; end; procedure TScriptEditor.GetFlameWidthProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.width); end; procedure TScriptEditor.SetFlameWidthProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if v >= 1 then cp.width := v; end; end; procedure TScriptEditor.GetFlameHeightProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.height); end; procedure TScriptEditor.SetFlameHeightProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if v >= 1 then cp.height := v; end; end; procedure TScriptEditor.GetFlamePixelsPerUnitProc(AMachine: TatVirtualMachine); begin with AMachine do // ReturnOutPutArg(cp.pixels_per_unit); ReturnOutPutArg(100 * cp.pixels_per_unit/cp.Width); end; procedure TScriptEditor.SetFlamePixelsPerUnitProc(AMachine: TatVirtualMachine); begin with AMachine do // cp.pixels_per_unit := GetInputArgAsInteger(0); <<--- hmm, ppu isn't integer :-\ cp.pixels_per_unit := GetInputArgAsFloat(0) * cp.Width / 100.0; end; procedure TScriptEditor.GetFlamePaletteProc(AMachine: TatVirtualMachine); begin with AMachine do // AV: was Integer(GetArrayIndex()) ReturnOutPutArg(cp.cmap[GetArrayIndexAsInteger(0), GetArrayIndexAsInteger(1)]); end; procedure TScriptEditor.SetFlamePaletteProc(AMachine: TatVirtualMachine); var i0, i1, v: integer; begin with AMachine do begin i0 := GetArrayIndexAsInteger(0); // AV: was GetArrayIndex(0) i1 := GetArrayIndexAsInteger(1); // AV: was GetArrayIndex(1) v := GetInputArgAsInteger(0); if (i0 >= 0) and (i0 <= 255) and (i1 >= 0) and (i1 <= 2) and (v >= 0) and (v < 256) then cp.cmap[i0, i1] := v else begin LastError := 'Flame.Gradient[' + IntToStr(i0) + ', ' + IntToStr(i1) + ']: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.GetFlameBackgroundProc(AMachine: TatVirtualMachine); begin with AMachine do // AV: was Integer(GetArrayIndex(0)) ReturnOutPutArg(cp.background[GetArrayIndexAsInteger(0)]); end; procedure TScriptEditor.SetFlameBackgroundProc(AMachine: TatVirtualMachine); var i, v: integer; begin with AMachine do begin i := GetArrayIndexAsInteger(0); // AV: was GetArrayIndex(0) v := GetInputArgAsInteger(0); if (i >= 0) and (i <= 2) and (v >= 0) and (v < 256) then cp.Background[i] := v else begin LastError := 'Flame.Background[' + IntToStr(i) + ']: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.SetFlameNameProc(AMachine: TatVirtualMachine); begin cp.name := AMachine.GetInputArgAsString(0); end; procedure TScriptEditor.GetFlameNameProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(cp.name); end; procedure TScriptEditor.SetFlameCommentProc(AMachine: TatVirtualMachine); begin cp.comment := AMachine.GetInputArgAsString(0); end; procedure TScriptEditor.GetFlameCommentProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(cp.comment); end; (* procedure TScriptEditor.SetFlameNickProc(AMachine: TatVirtualMachine); begin cp.nick := AMachine.GetInputArgAsString(0); end; procedure TScriptEditor.GetFlameURLProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(cp.url); end; procedure TScriptEditor.SetFlameURLProc(AMachine: TatVirtualMachine); begin cp.url := AMachine.GetInputArgAsString(0); end; procedure TScriptEditor.GetFlameNickProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(cp.nick); end; *) procedure TScriptEditor.SetFlameHueProc(AMachine: TatVirtualMachine); var n: double; //i: byte; //h, s, v: real; begin n := AMachine.GetInputArgAsFloat(0); if (n >= 0) and (n <= 1) then begin cp.hue_rotation := n; {if (n = 0) or (n = 1) then exit; 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 + (n * 360)) mod 360; HSVToRGB(h, s, v, cp.cmap[i][0], cp.cmap[i][1], cp.cmap[i][2]); end; } end; end; procedure TScriptEditor.GetFlameHueProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(cp.hue_rotation); end; procedure TScriptEditor.GetFlameBatchesProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.nbatches); end; procedure TScriptEditor.SetFlameBatchesProc(AMachine: TatVirtualMachine); begin with AMachine do cp.nbatches := GetInputArgAsInteger(0); end; procedure TScriptEditor.GetFlameAngleProc(AMachine: TatVirtualMachine); var v:double; begin // AV: fixed, someone forgot to translate from/to radians v := cp.FAngle * 180 / PI; with AMachine do ReturnOutPutArg(v); end; procedure TScriptEditor.SetFlameAngleProc(AMachine: TatVirtualMachine); var v:double; begin // AV: fixed, someone forgot to translate from/to radians with AMachine do v := GetInputArgAsFloat(0); cp.FAngle := v * PI / 180; end; procedure TScriptEditor.GetFlamePitchProc(AMachine: TatVirtualMachine); var v:double; begin // fix: someone forgot to translate from/to radians v := cp.cameraPitch * 180 / PI; with AMachine do ReturnOutPutArg(v); end; procedure TScriptEditor.SetFlamePitchProc(AMachine: TatVirtualMachine); var v:double; begin // fix: someone forgot to translate from/to radians with AMachine do v := GetInputArgAsFloat(0); cp.cameraPitch := v * PI / 180; end; procedure TScriptEditor.GetFlameRollProc(AMachine: TatVirtualMachine); var v:double; begin // fix: someone forgot to translate from/to radians v := cp.cameraRoll * 180 / PI; with AMachine do ReturnOutPutArg(v); end; procedure TScriptEditor.SetFlameRollProc(AMachine: TatVirtualMachine); var v:double; begin // fix: someone forgot to translate from/to radians with AMachine do v := GetInputArgAsFloat(0); cp.cameraRoll := v * PI / 180; end; procedure TScriptEditor.GetFlameYawProc(AMachine: TatVirtualMachine); var v:double; begin // fix: someone forgot to translate from/to radians v := cp.cameraYaw * 180 / PI; with AMachine do ReturnOutPutArg(v); end; procedure TScriptEditor.SetFlameYawProc(AMachine: TatVirtualMachine); var v:double; begin // fix: someone forgot to translate from/to radians with AMachine do v := GetInputArgAsFloat(0); cp.cameraYaw := v * PI / 180; end; procedure TScriptEditor.GetFlameCamZposProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.cameraZpos); end; procedure TScriptEditor.SetFlameCamZposProc(AMachine: TatVirtualMachine); begin with AMachine do cp.cameraZpos := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetFlamePerspectiveProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.cameraPersp); end; procedure TScriptEditor.SetFlamePerspectiveProc(AMachine: TatVirtualMachine); begin with AMachine do cp.cameraPersp := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetFlameDOFProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.cameraDOF); end; procedure TScriptEditor.SetFlameDOFProc(AMachine: TatVirtualMachine); begin with AMachine do cp.cameraDOF := GetInputArgAsFloat(0); end; { *************************** Transform interface **************************** } procedure TScriptEditor.GetTransformPostxformEnabledProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].postXswap); end; procedure TScriptEditor.SetTransformPostxformEnabledProc(AMachine: TatVirtualMachine); begin with AMachine do cp.xform[ActiveTransform].postXswap := (GetInputArgAsInteger(0) <> 0); end; /////////////////////////////// procedure TScriptEditor.GetTransformAProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].c[0, 0]); end; procedure TScriptEditor.SetTransformAProc(AMachine: TatVirtualMachine); begin with AMachine do cp.xform[ActiveTransform].c[0, 0] := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetTransformBProc(AMachine: TatVirtualMachine); var v: double; begin v := cp.xform[ActiveTransform].c[1, 0]; with AMachine do ReturnOutPutArg(-v); // AV: fixed the sign end; procedure TScriptEditor.SetTransformBProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do v := GetInputArgAsFloat(0); cp.xform[ActiveTransform].c[1, 0] := -v; // AV: fixed the sign end; procedure TScriptEditor.GetTransformCProc(AMachine: TatVirtualMachine); var v: double; begin v := cp.xform[ActiveTransform].c[0, 1]; with AMachine do ReturnOutPutArg(-v); // AV: fixed the sign end; procedure TScriptEditor.SetTransformCProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do v := GetInputArgAsFloat(0); cp.xform[ActiveTransform].c[0, 1] := -v; // AV: fixed the sign end; procedure TScriptEditor.GetTransformDProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].c[1, 1]); end; procedure TScriptEditor.SetTransformDProc(AMachine: TatVirtualMachine); begin with AMachine do cp.xform[ActiveTransform].c[1, 1] := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetTransformEProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].c[2, 0]); end; procedure TScriptEditor.SetTransformEProc(AMachine: TatVirtualMachine); begin with AMachine do cp.xform[ActiveTransform].c[2, 0] := GetInputArgAsFloat(0); end; procedure TScriptEditor.GetTransformFProc(AMachine: TatVirtualMachine); var v: double; begin v := cp.xform[ActiveTransform].c[2, 1]; with AMachine do ReturnOutPutArg(-v); // AV: fixed the sign end; procedure TScriptEditor.SetTransformFProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do v := GetInputArgAsFloat(0); cp.xform[ActiveTransform].c[2, 1] := -v; // AV: fixed the sign end; procedure TScriptEditor.GetTransformColorProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].Color); end; procedure TScriptEditor.SetTransformColorProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0) and (v <= 1) then cp.xform[ActiveTransform].Color := v else begin LastError := 'Transform.Color: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.GetTransformVarColorProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].pluginColor); end; procedure TScriptEditor.SetTransformVarColorProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0) and (v <= 1) then cp.xform[ActiveTransform].pluginColor := v else begin LastError := 'Transform.VarColor: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.GetTransformWeightProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].density); end; procedure TScriptEditor.SetTransformWeightProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 1E-6) and (v <= MAX_WEIGHT) then // AV: was min=0 that is not allowed cp.xform[ActiveTransform].density := v else begin LastError := 'Transform.Weight: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.GetTransformSymProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].symmetry); end; procedure TScriptEditor.SetTransformSymProc(AMachine: TatVirtualMachine); var v: double; s: string; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= -1) and (v <= 1) then cp.xform[ActiveTransform].symmetry := v else begin s := AMachine.CurrentPropertyName; LastError := 'Transform.' + s + ': ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.GetTransformVarProc(AMachine: TatVirtualMachine); begin with AMachine do // AV: was GetArrayIndex(0) ReturnOutPutArg(cp.xform[ActiveTransform].GetVariation(GetArrayIndexAsInteger(0))); end; procedure TScriptEditor.SetTransformVarProc(AMachine: TatVirtualMachine); var v: double; i: integer; begin with AMachine do begin v := GetInputArgAsFloat(0); i := GetArrayIndexAsInteger(0); // AV: was GetArrayIndex(0) if (i >= 0) and (i < NRVAR) then cp.xform[ActiveTransform].SetVariation(i, v); end; end; procedure TScriptEditor.GetTransformVariProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin // AV: was GetArrayIndex(0) cp.xform[ActiveTransform].GetVariable(GetVariableNameAt(GetArrayIndexAsInteger(0)), v); ReturnOutPutArg(v); end; end; procedure TScriptEditor.SetTransformVariProc(AMachine: TatVirtualMachine); var v: double; i: integer; begin with AMachine do begin v := GetInputArgAsFloat(0); i := GetArrayIndexAsInteger(0); // AV: was GetArrayIndex(0) if (i >= 0) and (i < GetNrVariableNames) then cp.xform[ActiveTransform].SetVariable(GetVariableNameAt(i), v); end; end; procedure TScriptEditor.GetTransformChaosProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(cp.xform[ActiveTransform].modWeights[Integer(GetArrayIndex(0))]); end; procedure TScriptEditor.SetTransformChaosProc(AMachine: TatVirtualMachine); var v: double; i: integer; begin with AMachine do begin v := GetInputArgAsFloat(0); i := GetArrayIndexAsInteger(0); // AV: was GetArrayIndex(0) if (i >= 0) and (i < NumTransforms) then cp.xform[ActiveTransform].modWeights[i] := v else begin LastError := 'Transform.Chaos[' + IntToStr(i) + ']: ' + TextByKey('script-status-varoutofrange'); i := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLine := i; // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; procedure TScriptEditor.GetTransformPlotModeProc(AMachine: TatVirtualMachine); begin with AMachine do if cp.xform[ActiveTransform].transOpacity=0 then ReturnOutPutArg(1) else ReturnOutPutArg(0); end; procedure TScriptEditor.SetTransformPlotModeProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v <> 0) then cp.xform[ActiveTransform].transOpacity := 1 else cp.xform[ActiveTransform].transOpacity := 0; end; end; procedure TScriptEditor.GetTransformOpacityProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutPutArg(cp.xform[ActiveTransform].transOpacity) end; procedure TScriptEditor.SetTransformOpacityProc(AMachine: TatVirtualMachine); var v: double; begin with AMachine do begin v := GetInputArgAsFloat(0); if (v >= 0) and (v <= 1) then // AV: add a check cp.xform[ActiveTransform].transOpacity := v else begin // AV: add error handler LastError := 'Transform.Opacity: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; end; end; end; // -- vars as props -- procedure TScriptEditor.GetTransformVariationProc(AMachine: TatVirtualMachine); var i: integer; v: double; begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.Variation[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with AMachine do begin i := 0; while (i < NRVAR) and (Lowercase(varnames(i)) <> Lowercase(CurrentPropertyName)) do Inc(i); if (i < NRVAR) then ReturnOutPutArg(cp.xform[ActiveTransform].GetVariation(i)) else begin // shouldn't happen LastError := 'Cannot find variation at index ' + CurrentPropertyName + ' - ignoring'; // ScriptEditor.Console.Lines.Add(LastError); // Scripter.Halt; end; end; end; procedure TScriptEditor.SetTransformVariationProc(AMachine: TatVirtualMachine); var i: integer; v: double; begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.Variation[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with AMachine do begin i := 0; while (i < NRVAR) and (lowercase(varnames(i)) <> lowercase(CurrentPropertyName)) do Inc(i); if (i < NRVAR) then cp.xform[ActiveTransform].SetVariation(i, GetInputArgAsFloat(0)) else begin // shouldn't happen LastError := 'Cannot find variation at index ' + CurrentPropertyName + ' - ignoring'; // ScriptEditor.Console.Lines.Add(LastError); // Scripter.Halt; end; end; end; procedure TScriptEditor.GetTransformVariableProc(AMachine: TatVirtualMachine); var v: double; begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.Variable[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with AMachine do begin cp.xform[ActiveTransform].GetVariable(CurrentPropertyName, v); ReturnOutPutArg(v); end; end; procedure TScriptEditor.SetTransformVariableProc(AMachine: TatVirtualMachine); var v: double; begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.Variable[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with AMachine do begin v := GetInputArgAsFloat(0); cp.xform[ActiveTransform].SetVariable(CurrentPropertyName, v); end end; //////////// Variaton Order Utils /////////// procedure TScriptEditor.TransformMoveVarProc(AMachine: TatVirtualMachine); var v: string; i, n: integer; begin with AMachine do begin v := GetInputArgAsString(0); // name n := GetInputArgAsInteger(1); // position end; i := GetVariationIndex(v); if (i >= 0) and (n >= 0) and (n < NrVar) then begin i := cp.xform[ActiveTransform].ifs.IndexOf(v); cp.xform[ActiveTransform].ifs.Move(i, n); end; end; procedure TScriptEditor.TransformExchangeVarsProc(AMachine: TatVirtualMachine); var v, s: string; i, n: integer; begin with AMachine do begin v := GetInputArgAsString(0); s := GetInputArgAsString(1); end; i := GetVariationIndex(v); n := GetVariationIndex(s); if (i >= 0) and (i < NrVar) and (n >= 0) and (n < NrVar) then cp.xform[ActiveTransform].ifs.Exchange(i, n); end; procedure TScriptEditor.TransformCopyVarOrderProc(AMachine: TatVirtualMachine); var i: integer; begin i := AMachine.GetInputArgAsInteger(0); if (i <> ActiveTransform) and (i >= 0) and (i <= Transforms) then cp.xform[ActiveTransform].ifs.Assign(cp.xform[i].ifs); end; procedure TScriptEditor.TransformGetVarOrderProc(AMachine: TatVirtualMachine); var v: string; i: integer; begin with AMachine do v := GetInputArgAsString(0); i := cp.xform[ActiveTransform].ifs.IndexOf(v); AMachine.ReturnOutPutArg(i); end; procedure TScriptEditor.TransformSortVarsProc(AMachine: TatVirtualMachine); begin cp.xform[ActiveTransform].ifs.Sort; cp.xform[ActiveTransform].ifs.Sorted := False; end; procedure TScriptEditor.TransformDefaultVarOrderProc(AMachine: TatVirtualMachine); var i: integer; begin for i := 0 to NrVar-1 do cp.xform[ActiveTransform].ifs.Strings[i] := Varnames(i); end; procedure TScriptEditor.TransformDisplayVarsProc(AMachine: TatVirtualMachine); var i: integer; begin Console.Lines.Add(''); if ActiveTransform = Transforms then Console.Lines.Add('Variation Order for Final Transform') else Console.Lines.Add('Variation Order for Transform ' + IntToStr(ActiveTransform + 1)); Console.Lines.Add('==========================='); for i := 0 to NrVar-1 do Console.Lines.Add(IntToStr(i) + #32#32 + cp.xform[ActiveTransform].ifs.Strings[i]); end; //////////////////////////////////////////// procedure TScriptEditor.GetTransformNameProc(AMachine: TatVirtualMachine); begin if (ActiveTransform < 0) or (ActiveTransform >= Transforms) then begin LastError := 'Transform.Name: ' + ErrorOutOfRange; Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; exit; end; with AMachine do ReturnOutputArg(cp.xform[ActiveTransform].TransformName); end; procedure TScriptEditor.SetTransformNameProc(AMachine: TatVirtualMachine); begin if (ActiveTransform < 0) or (ActiveTransform >= Transforms) then begin LastError := 'Transform.Name: ' + ErrorOutOfRange; Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; exit; end; with AMachine do cp.xform[ActiveTransform].TransformName := GetInputArgAsString(0);; end; // -- coefs & post-coefs -- procedure TScriptEditor.GetTransformCoefsProc(AMachine: TatVirtualMachine); var v: double; i, j: integer; begin { if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.coefs[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; } with AMachine do begin i := GetArrayIndex(0); j := GetArrayIndex(1); if (i < 0) or (i > 2) or (j < 0) or (j > 1) then begin LastError := 'Transform.coefs[]: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; exit; end; v := cp.xform[ActiveTransform].c[i, j]; if (i=0)and(j=0) or (i=1)and(j=1) or (i=2)and(j=0) then ReturnOutPutArg(v) else ReturnOutPutArg(-v); end; end; procedure TScriptEditor.SetTransformCoefsProc(AMachine: TatVirtualMachine); var v: double; i, j: integer; begin { if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.coefs[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; } with AMachine do begin i := GetArrayIndex(0); j := GetArrayIndex(1); if (i < 0) or (i > 2) or (j < 0) or (j > 1) then begin LastError := 'Transform.coefs[]: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; exit; end; v := GetInputArgAsFloat(0); if (i=0)and(j=0) or (i=1)and(j=1) or (i=2)and(j=0) then cp.xform[ActiveTransform].c[i, j] := v else if (i=0)and(j=1) or (i=1)and(j=0) or (i=2)and(j=1) then cp.xform[ActiveTransform].c[i, j] := -v; end; end; procedure TScriptEditor.GetTransformPostCoefsProc(AMachine: TatVirtualMachine); var v: double; i, j: integer; begin { if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.post[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; } with AMachine do begin i := GetArrayIndex(0); j := GetArrayIndex(1); if (i < 0) or (i > 2) or (j < 0) or (j > 1) then begin LastError := 'Transform.post[]: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; exit; end; v := cp.xform[ActiveTransform].p[i, j]; if (i=0)and(j=0) or (i=1)and(j=1) or (i=2)and(j=0) then ReturnOutPutArg(v) else ReturnOutPutArg(-v); end; end; procedure TScriptEditor.SetTransformPostCoefsProc(AMachine: TatVirtualMachine); var v: double; i, j: integer; begin { if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.post[]: ' + ErrorOutOfRange; Scripter.Halt; exit; end; } with AMachine do begin i := GetArrayIndex(0); j := GetArrayIndex(1); if (i < 0) or (i > 2) or (j < 0) or (j > 1) then begin LastError := 'Transform.post[]: ' + TextByKey('script-status-varoutofrange'); Editor.ActiveLine := LineNumberFromInstruction(AMachine.CurrentInstruction); // AV Editor.ActiveLineSettings.ShowActiveLine := true; // AV Scripter.Halt; exit; end; v := GetInputArgAsFloat(0); if (i=0)and(j=0) or (i=1)and(j=1) or (i=2)and(j=0) then cp.xform[ActiveTransform].p[i, j] := v else if (i=0)and(j=1) or (i=1)and(j=0) or (i=2)and(j=1) then cp.xform[ActiveTransform].p[i, j] := -v; end; end; procedure TScriptEditor.TransformSwapCoefsProc(AMachine: TatVirtualMachine); var i, j: integer; t: double; begin with cp.xform[ActiveTransform] do for i := 0 to 2 do for j := 0 to 1 do begin t := c[i, j]; c[i,j] := p[i, j]; p[i, j] := t; end; end; procedure TScriptEditor.TransformResetVariables(AMachine: TatVirtualMachine); var i: integer; begin for i:= 0 to GetNrVariableNames - 1 do begin cp.xform[ActiveTransform].ResetVariable(GetVariableNameAt(i)); end; end; procedure TScriptEditor.CodeButtonClick(Sender: TObject); begin Panel1.Visible := not Panel1.Visible; CodeButton.Down := Panel1.Visible; end; procedure TScriptEditor.CollapseBlocksClick(Sender: TObject); begin Editor.CollapseAllNodes; end; procedure TScriptEditor.SurroundByClick(Sender: TObject); // AV: for code auto-completition var i, j, k, m: integer; begin if Sender = N5 then Editor.Selection := ' { ' + Editor.Selection + ' } ' else if Sender = N6 then Editor.Selection := ' (* ' + Editor.Selection + ' *) ' else if Sender = N7 then with Editor do begin if (SelStartY = SelEndY) then InsertTextAtXY( ' // ', SelStartX, SelStartY) else begin mnuUndo.Enabled := True; BeginUpdate; if (SelStartY > SelEndY) then begin j := SelEndX; k := SelEndY; m := SelStartY; end else begin j := SelStartX; k := SelStartY; m := SelEndY; end; for i := k + 1 to m do InsertTextAtXY(' // ', 0, i); InsertTextAtXY(' // ', j, k); EndUpdate; end; end else with Editor do begin //if SelLength = 0 then exit; mnuUndo.Enabled := True; BeginUpdate; if (SelEndY = Lines.Count-1) then Lines.Add(''); if (SelStartY > SelEndY) then begin k := SelEndY; m := SelStartY; end else begin k := SelStartY; m := SelEndY; end; BlockIndent(k, m, 4); if Sender = BeginEnd1 then begin InsertTextAtXY('begin'#13#10, 0, k); InsertTextAtXY('end;'#13#10, 0, m + 2); end else begin // if Sender = TryExcept1 InsertTextAtXY('try'#13#10, 0, k); InsertTextAtXY('except'#13#10#13#10'end;'#13#10, 0, m + 2); end; EndUpdate; end; end; procedure TScriptEditor.TransformClearProc(AMachine: TatVirtualMachine); begin cp.xform[ActiveTransform].Clear; if ActiveTransform < Transforms then cp.xform[ActiveTransform].density := 0.5 else cp.xform[ActiveTransform].symmetry := 1; end; procedure TScriptEditor.TransformRotateOriginProc(AMachine: TatVirtualMachine); var tx, ty, rad, sinr, cosr: double; begin if cp.xform[ActiveTransform].postXswap then begin TransformRotatePXOriginProc(AMachine); Exit; end; if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.RotateOrigin: ' + ErrorOutOfRange; Scripter.Halt; exit; end; rad := AMachine.GetInputArgAsFloat(0) * pi / 180; SinCos(rad, sinr, cosr); with EditForm.WorldPivot do with cp.xform[ActiveTransform] do begin tx := x + (c[2,0] - x) * cosr - (-c[2,1] - y) * sinr; ty := y + (c[2,0] - x) * sinr + (-c[2,1] - y) * cosr; c[2,0] := tx; c[2,1] := -ty; end; end; procedure TScriptEditor.TransformRotatePXOriginProc(AMachine: TatVirtualMachine); var tx, ty, rad, sinr, cosr: double; begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin LastError := 'Transform.RotatePXOrigin: ' + ErrorOutOfRange; Scripter.Halt; exit; end; rad := AMachine.GetInputArgAsFloat(0) * pi / 180; SinCos(rad, sinr, cosr); with EditForm.WorldPivot do with cp.xform[ActiveTransform] do begin tx := x + (p[2,0] - x) * cosr - (-p[2,1] - y) * sinr; ty := y + (p[2,0] - x) * sinr + (-p[2,1] - y) * cosr; p[2,0] := tx; p[2,1] := -ty; end; end; // AV -- pivot-aware reflections -- procedure TScriptEditor.TransformFlipHorizProc(AMachine: TatVirtualMachine); begin if cp.xform[ActiveTransform].postXswap then begin TransformFlipPXHorizProc(AMachine); Exit; end; if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin LastError := 'Transform.FlipHoriz: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with cp.xform[ActiveTransform] do begin c[0,0] := -c[0,0]; c[1,0] := -c[1,0]; with EditForm do if (PivotMode = PivotWorld) then c[2,0] := 2 * WorldPivot.x - c[2,0]; end; end; procedure TScriptEditor.TransformFlipPXHorizProc(AMachine: TatVirtualMachine); begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin LastError := 'Transform.FlipPXHoriz: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with cp.xform[ActiveTransform] do begin p[0,0] := -p[0,0]; p[1,0] := -p[1,0]; with EditForm do if (PivotMode = PivotWorld) then p[2,0] := 2 * WorldPivot.x - p[2,0]; end; end; procedure TScriptEditor.TransformFlipVertProc(AMachine: TatVirtualMachine); begin if cp.xform[ActiveTransform].postXswap then begin TransformFlipPXVertProc(AMachine); Exit; end; if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin LastError := 'Transform.FlipVert: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with cp.xform[ActiveTransform] do begin c[0,1] := -c[0,1]; c[1,1] := -c[1,1]; with EditForm do if (PivotMode = PivotWorld) then c[2,1] := -2 * WorldPivot.y - c[2,1]; end; end; procedure TScriptEditor.TransformFlipPXVertProc(AMachine: TatVirtualMachine); begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin LastError := 'Transform.FlipPXVert: ' + ErrorOutOfRange; Scripter.Halt; exit; end; with cp.xform[ActiveTransform] do begin p[0,1] := -p[0,1]; p[1,1] := -p[1,1]; with EditForm do if (PivotMode = PivotWorld) then p[2,1] := -2 * WorldPivot.y - p[2,1]; end; end; // -- pivot-aware rotating & scaling -- procedure TScriptEditor.TransformRotateProc(AMachine: TatVirtualMachine); var Triangles: TTriangles; px, py: double; tx: TXForm; begin if cp.xform[ActiveTransform].postXswap then begin TransformRotatePXProc(AMachine); Exit; end; if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin LastError := 'Transform.Rotate: ' + ErrorOutOfRange; Scripter.Halt; exit; end; tx := TXForm.Create; tx.Assign(scripteditor.cp.xform[NumTransforms]); // just in case (?) EditForm.ScriptGetPivot(px, py); cp.TrianglesFromCp(Triangles); // it's ugly but it works... Triangles[ActiveTransform] := RotateTrianglePoint(Triangles[ActiveTransform], px, py, AMachine.GetInputArgAsFloat(0) * pi / 180); cp.GetFromTriangles(Triangles, NumTransforms); cp.xform[NumTransforms].Assign(tx); tx.Free; end; procedure TScriptEditor.TransformScaleProc(AMachine: TatVirtualMachine); var Triangles: TTriangles; px, py: double; tx: TXForm; begin if cp.xform[ActiveTransform].postXswap then begin TransformScalePXProc(AMachine); Exit; end; if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.Scale: ' + ErrorOutOfRange; Scripter.Halt; exit; end; tx := TXForm.Create; tx.Assign(scripteditor.cp.xform[NumTransforms]); // just in case (?) EditForm.ScriptGetPivot(px, py); cp.TrianglesFromCp(Triangles); // it's ugly but it works... Triangles[ActiveTransform] := ScaleTrianglePoint(Triangles[ActiveTransform], px, py, AMachine.GetInputArgAsFloat(0)); cp.GetFromTriangles(Triangles, NumTransforms); cp.xform[NumTransforms].Assign(tx); tx.Free; end; procedure TScriptEditor.TransformScalePXProc(AMachine: TatVirtualMachine); var s: double; begin if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then begin // ScriptEditor.Console.Lines.Add(ErrorOutOfRange); LastError := 'Transform.ScalePX: ' + ErrorOutOfRange; Scripter.Halt; exit; end; s := AMachine.GetInputArgAsFloat(0); with cp.xform[ActiveTransform] do begin Scale(p, s); with EditForm do if (PivotMode = PivotWorld) then begin p[2,0] := WorldPivot.x + (p[2,0]- WorldPivot.x) * s; p[2,1] := -WorldPivot.y + (p[2,1]+ WorldPivot.y) * s; end; end; end; procedure TScriptEditor.TransformRotatePXProc(AMachine: TatVirtualMachine); var v, tx, ty, sv, cv: double; begin try if (ActiveTransform < 0) or (ActiveTransform > NXFORMS) then raise EFormatInvalid.Create('Transform.RotatePX: ' + ErrorOutOfRange); with AMachine do v := GetInputArgAsFloat(0) * PI / 180; SinCos(v, sv, cv); with cp.xform[ActiveTransform] do begin Multiply(p, cv, -sv, sv, cv); // AV: my common method for both matrices with EditForm do if (PivotMode = PivotWorld) then begin tx := WorldPivot.x + (p[2,0] - WorldPivot.x) * cv - (-p[2,1] - WorldPivot.y) * sv; ty := WorldPivot.y + (p[2,0] - WorldPivot.x) * sv + (-p[2,1] - WorldPivot.y) * cv; p[2,0] := tx; p[2,1] := -ty; end; end; except on E: EFormatInvalid do begin Application.ProcessMessages; LastError := 'Transform.RotatePX: ' + E.Message; Scripter.Halt; end; end; end; { *************************** Render interface ****************************** } procedure TScriptEditor.GetRenderEmbedParams(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutputArg(TScriptRender(CurrentObject).EmbedParameters); end; procedure TScriptEditor.SetRenderEmbedParams(AMachine: TatVirtualMachine); begin with AMachine do TScriptRender(CurrentObject).EmbedParameters := GetInputArgAsBoolean(0); end; procedure TScriptEditor.GetRenderFilenameProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(TScriptRender(CurrentObject).Filename); end; procedure TScriptEditor.SetRenderFilenameProc(AMachine: TatVirtualMachine); var rdir: string; begin rdir := AMachine.GetInputArgAsString(0); if DirectoryExists(ExtractFilePath(rdir)) then begin // AV if ExtractFileExt(rdir) = '' then rdir := rdir + '.jpg'; TScriptRender(AMachine.CurrentObject).Filename := rdir; end else begin LastError := 'Renderer.FileName: ' + TextByKey('render-status-pathdoesnotexist'); AMachine.RuntimeError(LastError); // AV AMachine.Halt; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV end; end; procedure TScriptEditor.GetRenderWidthProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(TScriptRender(CurrentObject).Width); end; procedure TScriptEditor.SetRenderWidthProc(AMachine: TatVirtualMachine); begin with AMachine do TScriptRender(CurrentObject).Width := GetInputArgAsInteger(0); end; procedure TScriptEditor.GetRenderHeightProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(TScriptRender(CurrentObject).Height); end; procedure TScriptEditor.SetRenderHeightProc(AMachine: TatVirtualMachine); begin with AMachine do TScriptRender(CurrentObject).Height := GetInputArgAsInteger(0); end; procedure TScriptEditor.GetRenderMaxMemoryProc(AMachine: TatVirtualMachine); begin with AMachine do ReturnOutPutArg(TScriptRender(CurrentObject).MaxMemory); end; procedure TScriptEditor.SetRenderMaxMemoryProc(AMachine: TatVirtualMachine); var v: integer; begin with AMachine do begin v := GetInputArgAsInteger(0); if (v >= 0) then TScriptRender(CurrentObject).MaxMemory := v; end; end; { **************************************************************************** } procedure TScriptEditor.GetPivotModeProc(AMachine: TatVirtualMachine); begin AMachine.ReturnOutputArg(Integer(EditForm.PivotMode)); end; procedure TScriptEditor.SetPivotModeProc(AMachine: TatVirtualMachine); var n: integer; begin n := AMachine.GetInputArgAsInteger(0); if n = 0 then EditForm.PivotMode := pivotLocal else EditForm.PivotMode := pivotWorld; end; procedure TScriptEditor.GetPivotXProc(AMachine: TatVirtualMachine); begin // EditForm.ScriptGetPivot(px, py); // AMachine.ReturnOutputArg(px); if EditForm.PivotMode = pivotLocal then AMachine.ReturnOutputArg(EditForm.LocalPivot.x) else AMachine.ReturnOutputArg(EditForm.WorldPivot.x); end; procedure TScriptEditor.SetPivotXProc(AMachine: TatVirtualMachine); begin if EditForm.PivotMode = pivotLocal then EditForm.LocalPivot.x := AMachine.GetInputArgAsFloat(0) else EditForm.WorldPivot.x := AMachine.GetInputArgAsFloat(0); end; procedure TScriptEditor.GetPivotYProc(AMachine: TatVirtualMachine); begin // EditForm.ScriptGetPivot(px, py); // AMachine.ReturnOutputArg(py); if EditForm.PivotMode = pivotLocal then AMachine.ReturnOutputArg(EditForm.LocalPivot.y) else AMachine.ReturnOutputArg(EditForm.WorldPivot.y); end; procedure TScriptEditor.SetPivotYProc(AMachine: TatVirtualMachine); begin if EditForm.PivotMode = pivotLocal then EditForm.LocalPivot.y := AMachine.GetInputArgAsFloat(0) else EditForm.WorldPivot.y := AMachine.GetInputArgAsFloat(0); end; procedure TScriptEditor.SetPivotProc(AMachine: TatVirtualMachine); begin with AMachine do begin if EditForm.PivotMode = pivotLocal then begin EditForm.LocalPivot.x := GetInputArgAsFloat(0); EditForm.LocalPivot.y := GetInputArgAsFloat(1); end else begin EditForm.WorldPivot.x := GetInputArgAsFloat(0); EditForm.WorldPivot.y := GetInputArgAsFloat(1); end; end; end; procedure TScriptEditor.ResetPivotProc(AMachine: TatVirtualMachine); begin try // AV: scripter crashes here when pivot = (0,0) EditForm.btnResetPivotClick(nil); except end; // all the work is already done end; { ********************************* Scripter ********************************* } procedure TScriptEditor.PrepareScripter; var i: integer; lib : TStringList; s: string; begin Scripter.AddLibrary(TatSysUtilsLibrary); with Scripter.defineClass(TScriptRender) do begin DefineProp('Filename', tkString, GetRenderFilenameProc, SetRenderFilenameProc); DefineProp('Width', tkInteger, GetRenderWidthProc, SetRenderWidthProc); DefineProp('Height', tkInteger, GetRenderHeightProc, SetRenderHeightProc); DefineProp('MaxMemory', tkInteger, GetRenderMaxMemoryProc, SetRenderMaxMemoryProc); DefineProp('EmbedParameters', tkVariant, GetRenderEmbedParams, SetRenderEmbedParams); end; Scripter.AddObject('Renderer', Renderer); { Flame interface } with Scripter.defineClass(TFlame) do begin DefineProp('Gamma', tkFloat, GetFlameGammaProc, SetFlameGammaProc); DefineProp('GammaThreshold', tkFloat, GetFlameGammaThresholdProc, SetFlameGammaThresholdProc); DefineProp('Brightness', tkFloat, GetFlameBrightnessProc, SetFlameBrightnessProc); DefineProp('Vibrancy', tkFloat, GetFlameVibrancyProc, SetFlameVibrancyProc); DefineProp('Contrast', tkFloat, GetFlameContrastProc, SetFlameContrastProc); // AV DefineProp('Time', tkFloat, GetFlameTimeProc, SetFlameTimeProc); DefineProp('Zoom', tkFloat, GetFlameZoomProc, SetFlameZoomProc); DefineProp('X', tkFloat, GetFlameXProc, SetFlameXProc); DefineProp('Y', tkFloat, GetFlameYProc, SetFlameYProc); DefineProp('Width', tkFloat, GetFlameWidthProc, SetFlameWidthProc); DefineProp('Height', tkFloat, GetFlameHeightProc, SetFlameHeightProc); DefineProp('SampleDensity', tkFloat, GetFlameDensityProc, SetFlameDensityProc); DefineProp('Quality', tkFloat, GetFlameDensityProc, SetFlameDensityProc); DefineProp('Oversample', tkInteger, GetFlameOversampleProc, SetFlameOversampleProc); DefineProp('FilterRadius', tkFloat, GetFlameFilterRadiusProc, SetFlameFilterRadiusProc); DefineProp('Scale', tkFloat, GetFlamePixelsPerUnitProc, SetFlamePixelsPerUnitProc); DefineProp('Gradient', tkInteger, GetFlamePaletteProc, SetFlamePaletteProc, nil, false, 2); DefineProp('Background', tkInteger, GetFlameBackgroundProc, SetFlameBackgroundProc, nil, false, 1); DefineProp('Name', tkString, GetFlameNameProc, SetFlameNameProc); DefineProp('Comment', tkString, GetFlameCommentProc, SetFlameCommentProc); // DefineProp('Nick', tkString, GetFlameNickProc, SetFlameNickProc); // DefineProp('URL', tkString, GetFlameURLProc, SetFlameURLProc); DefineProp('Hue', tkFloat, GetFlameHueProc, SetFlameHueProc); DefineProp('Batches', tkInteger, GetFlameBatchesProc, SetFlameBatchesProc); DefineProp('FinalXformEnabled', tkInteger, GetFlameFinalxformEnabledProc, SetFlameFinalxformEnabledProc); DefineProp('Angle', tkFloat, GetFlameAngleProc, SetFlameAngleProc); DefineProp('Pitch', tkFloat, GetFlamePitchProc, SetFlamePitchProc); DefineProp('Yaw', tkFloat, GetFlameYawProc, SetFlameYawProc); DefineProp('Roll', tkFloat, GetFlameRollProc, SetFlameRollProc); DefineProp('Perspective', tkFloat, GetFlamePerspectiveProc, SetFlamePerspectiveProc); DefineProp('Z', tkFloat, GetFlameCamZposProc, SetFlameCamZposProc); DefineProp('DOF', tkFloat, GetFlameDOFProc, SetFlameDOFProc); DefineProp('SoloXform', tkInteger, GetFlameSoloXformProc, SetFlameSoloXformProc); DefineProp('PreviewWidth', tkInteger, GetPreviewWidthProc, SetPreviewWidthProc); DefineProp('PreviewHeight', tkInteger, GetPreviewHeightProc, SetPreviewHeightProc); end; Scripter.AddObject('Flame', Flame); { Transform interface } with Scripter.defineClass(TTransform) do begin DefineProp('coefs', tkFloat, GetTransformCoefsProc, SetTransformCoefsProc, nil, false, 2); DefineProp('post', tkFloat, GetTransformPostCoefsProc, SetTransformPostCoefsProc, nil, false, 2); DefineProp('Color', tkFloat, GetTransformColorProc, SetTransformColorProc); DefineProp('VarColor', tkFloat, GetTransformVarColorProc, SetTransformVarColorProc); DefineProp('Weight', tkFloat, GetTransformWeightProc, SetTransformWeightProc); DefineProp('Symmetry', tkFloat, GetTransformSymProc, SetTransformSymProc); DefineProp('ColorSpeed', tkFloat, GetTransformSymProc, SetTransformSymProc); for i:= 0 to NRVAR - 1 do begin DefineProp(Varnames(i), tkFloat, GetTransformVariationProc, SetTransformVariationProc); Editor.SyntaxStyles.AutoCompletion.Add('property ' + Varnames(i) + ': double'); end; for i:= 0 to GetNrVariableNames - 1 do begin DefineProp(GetVariableNameAt(i), tkFloat, GetTransformVariableProc, SetTransformVariableProc); Editor.SyntaxStyles.AutoCompletion.Add('property ' + GetVariableNameAt(i) + ': double'); end; Editor.SyntaxStyles.AutoCompletion.Sort; while Editor.SyntaxStyles.AutoCompletion.Strings[0] = '' do Editor.SyntaxStyles.AutoCompletion.Delete(0); DefineMethod('Clear', 0, tkNone, nil, TransformClearProc); DefineMethod('Rotate', 1, tkNone, nil, TransformRotateProc); DefineMethod('Scale', 1, tkNone, nil, TransformScaleProc); DefineMethod('RotateOrigin', 1, tkNone, nil, TransformRotateOriginProc); DefineMethod('RotatePXOrigin', 1, tkNone, nil, TransformRotatePXOriginProc); DefineMethod('RotatePX', 1, tkNone, nil, TransformRotatePXProc); DefineMethod('ScalePX', 1, tkNone, nil, TransformScalePXProc); DefineMethod('FlipPXHoriz', 0, tkNone, nil, TransformFlipPXHorizProc); DefineMethod('FlipHoriz', 0, tkNone, nil, TransformFlipHorizProc); DefineMethod('FlipPXVert', 0, tkNone, nil, TransformFlipPXVertProc); DefineMethod('FlipVert', 0, tkNone, nil, TransformFlipVertProc); DefineMethod('SwapCoefs', 0, tkNone, nil, TransformSwapCoefsProc); DefineMethod('ResetVariables', 0, tkNone, nil, TransformResetVariables); DefineMethod('SetVariationOrder', 2, tkNone, nil, TransformMoveVarProc); DefineMethod('SwapVariations', 2, tkNone, nil, TransformExchangeVarsProc); DefineMethod('SortVariationsByName', 0, tkNone, nil, TransformSortVarsProc); DefineMethod('SortVariationsByIndex', 0, tkNone, nil, TransformDefaultVarOrderProc); DefineMethod('GetVariationOrder', 1, tkInteger, nil, TransformGetVarOrderProc); DefineMethod('CopyVariationsOrder', 1, tkInteger, nil, TransformCopyVarOrderProc); DefineMethod('PrintVariationsOrder', 0, tkNone, nil, TransformDisplayVarsProc); DefineProp('a', tkFloat, GetTransformAProc, SetTransformAProc); DefineProp('b', tkFloat, GetTransformBProc, SetTransformBProc); DefineProp('c', tkFloat, GetTransformCProc, SetTransformCProc); DefineProp('d', tkFloat, GetTransformDProc, SetTransformDProc); DefineProp('e', tkFloat, GetTransformEProc, SetTransformEProc); DefineProp('f', tkFloat, GetTransformFProc, SetTransformFProc); DefineProp('Variation', tkFloat, GetTransformVarProc, SetTransformVarProc, nil, false, 1); DefineProp('Variable', tkFloat, GetTransformVariProc, SetTransformVariProc, nil, false, 1); DefineProp('Chaos', tkFloat, GetTransformChaosProc, SetTransformChaosProc, nil, false, 1); DefineProp('PlotMode', tkInteger, GetTransformPlotModeProc, SetTransformPlotModeProc); DefineProp('Opacity', tkFloat, GetTransformOpacityProc, SetTransformOpacityProc); DefineProp('PostXformEnabled', tkInteger, GetTransformPostxformEnabledProc, SetTransformPostxformEnabledProc); DefineProp('Name', tkString, GetTransformNameProc, SetTransformNameProc); end; Scripter.AddObject('Transform', Transform); { Options interface } with Scripter.defineClass(TOptions) do begin DefineProp('JPEGQuality', tkInteger, GetJPEGQuality, SetJPEGQuality); DefineProp('BatchSize', tkInteger, GetBatchSize, SetBatchSize); DefineProp('ParameterFile', tkString, GetParameterFile, SetParameterFile); DefineProp('SmoothPaletteFile', tkString, GetSmoothPaletteFile, SetSmoothPaletteFile); DefineProp('NumTries', tkInteger, GetNumTries, SetNumTries); DefineProp('TryLength', tkInteger, GetTryLength, SetTryLength); DefineProp('ConfirmDelete', tkVariant, GetConfirmDelete, SetConfirmDelete); DefineProp('Multithreading', tkInteger, GetMultithreading, SetMultithreading); //DefineProp('FixedReference', tkVariant, GetFixedReference, SetFixedReference); DefineProp('SampleDensity', tkFloat, GetSampleDensity, SetSampleDensity); DefineProp('Gamma', tkFloat, GetGamma, SetGamma); DefineProp('GammaThreshold', tkFloat, GetGammaThreshold, SetGammaThreshold); DefineProp('Brightness', tkFloat, GetBrightness, SetBrightness); DefineProp('Vibrancy', tkFloat, GetVibrancy, SetVibrancy); DefineProp('Contrast', tkFloat, GetContrast, SetContrast); // AV DefineProp('Oversample', tkInteger, GetOversample, SetOversample); DefineProp('FilterRadius', tkFloat, GetFilterRadius, SetFilterRadius); DefineProp('Transparency', tkInteger, GetTransparency, SetTransparency); DefineProp('PreviewLowQuality', tkFloat, GetLowQuality, SetLowQuality); DefineProp('PreviewMediumQuality', tkFloat, GetMediumQuality, SetMediumQuality); DefineProp('PreviewHighQuality', tkFloat, GetHighQuality, SetHighQuality); DefineProp('MinTransforms', tkInteger, GetMinTransforms, SetMinTransforms); DefineProp('MaxTransforms', tkInteger, GetMaxTransforms, SetMaxTransforms); DefineProp('MutateMinTransforms', tkInteger, GetMutateMinTransforms, SetMutateMinTransforms); DefineProp('MutateMaxTransforms', tkInteger, GetMutateMaxTransforms, SetMutateMaxTransforms); DefineProp('RandomPrefix', tkString, GetPrefix, SetPrefix); DefineProp('KeepBackground', tkInteger, GetKeepBackground, SetKeepBackground); DefineProp('SymmetryType', tkInteger, GetSymmetryType, SetSymmetryType); DefineProp('SymmetryOrder', tkInteger, GetSymmetryOrder, SetSymmetryOrder); DefineProp('Variations', tkVariant, GetVariations, SetVariations, nil, false, 1); DefineProp('GradientOnRandom', tkInteger, GetRandomGradient, SetRandomGradient); DefineProp('GradientFileOnRandom', tkString, GetRandomGradientFile, SetRandomGradientFile); DefineProp('ColorBlending', tkInteger, GetGradientBlending, SetGradientBlending); // AV DefineProp('MinNodes', tkInteger, GetMinNodes, SetMinNodes); DefineProp('MaxNodes', tkInteger, GetMaxNodes, SetMaxNodes); DefineProp('MinHue', tkInteger, GetMinHue, SetMinHue); DefineProp('MaxHue', tkInteger, GetMaxHue, SetMaxHue); DefineProp('MinSaturation', tkInteger, GetMinSat, SetMinSat); DefineProp('MaxSaturation', tkInteger, GetMaxSat, SetMaxSat); DefineProp('MinLuminance', tkInteger, GetMinLum, SetMinLum); DefineProp('MaxLuminance', tkInteger, GetMaxLum, SetMaxLum); DefineProp('UPRSampleDensity', tkInteger, GetUPRSampleDensity, SetUPRSampleDensity); DefineProp('UPRFilterRadius', tkFloat, GetUPRFilterRadius, SetUPRFilterRadius); DefineProp('UPROversample', tkInteger, GetUPROversample, SetUPROversample); DefineProp('UPRAdjustDensity', tkVariant, GetUPRAdjustDensity, SetUPRAdjustDensity); DefineProp('EvenGradientStripes', tkVariant, GetEqualGradient, SetEqualGradient); DefineProp('UPRColoringIdent', tkString, GetUPRColoringIdent, SetUPRColoringIdent); DefineProp('UPRColoringFile', tkString, GetUPRColoringFile, SetUPRColoringFile); DefineProp('UPRFormulaFile', tkString, GetUPRFormulaFile, SetUPRFormulaFile); DefineProp('UPRFormulaIdent', tkString, GetUPRFormulaIdent, SetUPRFormulaIdent); DefineProp('UPRWidth', tkInteger, GetUPRWidth, SetUPRWidth); DefineProp('UPRHeight', tkInteger, GetUPRHeight, SetUPRHeight); DefineProp('ExportRenderer', tkInteger, GetExportPath, SetExportPath); end; Scripter.AddObject('Options', Options); with Scripter.defineClass(TPivot) do begin DefineProp('Mode', tkInteger, GetPivotModeProc, SetPivotModeProc); DefineProp('X', tkFloat, GetPivotXProc, SetPivotXProc); DefineProp('Y', tkFloat, GetPivotYProc, SetPivotYProc); DefineMethod('Set', 2, tkNone, nil, SetPivotProc); DefineMethod('Reset', 0, tkNone, nil, ResetPivotProc); end; Scripter.AddObject('Pivot', Pivot); Scripter.AddComponent(OpenDialog); Scripter.AddLibrary(TOperationLibrary); { Variables and constants } Scripter.AddConstant('PI', pi); Scripter.AddConstant('NVARS', NRVAR); Scripter.AddConstant('NumVariables', GetNrVariableNames); Scripter.AddConstant('NXFORMS', NXFORMS); Scripter.AddConstant('INSTALLPATH', ExtractFilePath(Application.exename)); Scripter.AddConstant('SYM_NONE', 0); Scripter.AddConstant('SYM_BILATERAL', 1); Scripter.AddConstant('SYM_ROTATIONAL', 2); Scripter.AddConstant('SYM_DIHEDRAL', 3); // AV Scripter.AddConstant('NMAPS', NRCMAPS); // AV Scripter.AddConstant('mrOK', mrOK); // AV Scripter.AddConstant('mrCancel', mrCancel); // AV Scripter.AddConstant('mrNo', mrNo); // AV Scripter.AddConstant('mrYes', mrYes); // AV Scripter.AddConstant('mrRetry', mrRetry); // AV Scripter.AddConstant('mrClose', mrClose); // AV Scripter.AddConstant('mrAbort', mrAbort); // AV Scripter.AddConstant('BLEND_RGB', 0); // AV Scripter.AddConstant('BLEND_HSV', 1); // AV Scripter.AddConstant('BLEND_NONE', 2); // AV { Variables } // AV: they are already defined in TOperationLibrary // Scripter.AddVariable('SelectedTransform', EditForm.SelectedTriangle); // Scripter.AddVariable('ActiveTransform', ActiveTransform); Scripter.AddVariable('UpdateFlame', UpdateIt); Scripter.AddVariable('ResetLocation', ResetLocation); Scripter.AddVariable('BatchIndex', RandomIndex); Scripter.AddVariable('DateCode', RandomDate); Scripter.AddVariable('Stopped', Stopped); Scripter.AddVariable('ShowProgress', ShowProgress); Scripter.AddVariable('LimitVibrancy', LimitVibrancy); // Scripter.AddVariable('CurrentFile', OpenFile); // AV: added handlers // Scripter.AddVariable('Compatibility', Compatibility); // obsolete { Variations } Scripter.AddConstant('V_LINEAR', 0); Scripter.AddConstant('V_RANDOM', vRandom); // Scripter.AddLibrary(TatWindowsLibrary); // Scripter.AddLibrary(TatFormsLibrary); Scripter.AddLibrary(TatMathLibrary); Scripter.AddLibrary(TatDialogsLibrary); Scripter.AddLibrary(TatSysUtilsLibrary); Scripter.AddLibrary(TatFileCtrlLibrary); Scripter.AddLibrary(TatClassesLibrary); { Nonsense - it's the only way to get the last real library to work! } Scripter.AddObject('Not_Any_Thing_Useful', Another); Scripter.AddObject('IglooFunkyRubber', Another); Scripter.AddObject('Scrumptious', Another); // Scripter.AddObject('Darn it', Another); Scripter.AddObject('Apophysis', Application); // AV :-) // AV: user must not be able to use them! Scripter.SystemLibrary.MethodByName('Scripter').Free; Scripter.SystemLibrary.MethodByName('Machine').Free; // AV: moved into main library to let user choose which CopyFile must be called Scripter.SystemLibrary.DefineMethod('CopyFile', 3, tkVariant, nil, CopyFileProc, false, 1); if FileExists(defLibrary) then // AV: add user's defined methods begin lib := TStringList.Create; try lib.LoadFromFile(defLibrary); for s in lib do if (pos('procedure', LowerCase(s)) > 0) or (pos('function', LowerCase(s)) > 0) then Editor.SyntaxStyles.AutoCompletion.Add(Trim(s)); finally lib.Free; end; end; // AV: to load external Delphi forms RegisterClasses([TButton, TLabel, TEdit, TComboBox]); end; { ************************* Buttons ***************************************** } procedure TScriptEditor.btnNewClick(Sender: TObject); var c: boolean; begin if ConfirmClearScript then begin if Editor.LinesModified then // AV: if script changes not saved yet c := (Application.MessageBox(PChar(TextByKey('script-confirmclear')), ApophysisSVN, 52) = IDYES) else c := True; end else c := True; if c then begin Editor.Lines.Clear; Caption := TextByKey('script-title'); //'New Script'; Script := ''; if Scripter.Running then btnBreak.Click; // AV: stop the previous script StatusBar.SimpleText := StatusBar.Hint; // AV end; end; procedure TScriptEditor.LoadScriptFile(filename:string); var s: string; fn: string; begin Editor.Lines.LoadFromFile(filename); s := ExtractFileName(filename); s := Copy(s, 0, length(s) - Length(ExtractFileExt(s))); MainForm.mnuRun.Caption := Format(TextByKey('main-menu-script-run2'), [s]); Caption := s; end; procedure TScriptEditor.OpenScript; var s: string; fn: string; begin MainOpenDialog.InitialDir := ScriptPath; MainOpenDialog.Filename := ''; if MainOpenDialog.execute then begin fn := MainOpenDialog.FileName; // AV Script := fn; Editor.Lines.LoadFromFile(fn); s := ExtractFileName(fn); s := Copy(s, 0, length(s) - Length(ExtractFileExt(s))); MainForm.mnuRun.Caption := Format(TextByKey('main-menu-script-run2'), [s]); Caption := s; ScriptPath := ExtractFileDir(fn); end; end; procedure TScriptEditor.btnOpenClick(Sender: TObject); begin OpenScript; end; procedure TScriptEditor.btnPauseClick(Sender: TObject); begin if Scripter.Running then Scripter.Paused := not Scripter.Paused else Scripter.Paused := False; btnPause.Down := Scripter.Paused; if btnPause.Down then begin StatusBar.SimpleText := TextByKey('script-status-paused'); PreviewForm.PreviewPause.Caption := TextbyKey('preview-resume'); end else begin if Scripter.Running then StatusBar.SimpleText := TextByKey('script-status-executing') else StatusBar.SimpleText := StatusBar.Hint; PreviewForm.PreviewPause.Caption := TextbyKey('preview-pause'); end; end; procedure TScriptEditor.btnSaveClick(Sender: TObject); var fn : string; begin if Script = '' then MainSaveDialog.Filename := '' else MainSaveDialog.Filename := ChangeFileExt(ExtractFileName(Script), '.aposcript'); MainSaveDialog.InitialDir := ScriptPath; if MainSaveDialog.Execute then begin fn := MainSaveDialog.FileName; // AV Script := fn; Editor.Lines.SaveToFile(fn); Caption := ExtractFileName(fn); ScriptPath := ExtractFileDir(fn); if ScriptPath = AppPath + 'Scripts' then MainForm.GetScripts; // AV: refreshing the menu end; end; procedure TScriptEditor.FillFileList; var i, p: integer; ext, Title: string; FStrings: TStringList; begin FStrings := TStringList.Create; FStrings.LoadFromFile(ParamFile); try ScFileList.Clear; ext := LowerCase(ExtractFileExt(ParamFile)); if (ext = '.fla') or (ext = '.apo') then // AV begin // Get names from .undo or .apo file if (Pos('{', FStrings.Text) <> 0) then 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 } ScFileList.Add(Trim(Copy(FStrings[i], 1, p - 1))); end; end; end; end else begin // Get names from .flame file if (Pos(' 0) then begin for i := 0 to FStrings.Count - 1 do begin p := Pos(' 0) then begin pname := ''; MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(FStrings[i]))); MainForm.ListXMLScanner.Execute; if Trim(pname) = '' then Title := '*untitled ' + ptime else ScFileList.Add(pname); end; end; end; end; finally FStrings.Free; end; end; procedure TScriptEditor.CopyFileProc(AMachine: TatVirtualMachine); var src, dest: string; v: boolean; // AV begin // AV: original method doesn't work properly and conflicts with Windows.CopyFile with AMachine do begin src := GetInputArgAsString(0); dest := GetInputArgAsString(1); if FileExists(src) and DirectoryExists(ExtractFilePath(dest)) then try case InputArgCount of 2: begin v := Windows.CopyFile(PChar(src), PChar(dest), false); // rewrite ReturnOutputArg(v); end; 3: begin v := GetInputArgAsBoolean(2); v := Windows.CopyFile(PChar(src), PChar(dest), v); ReturnOutputArg(v); end; end; except LastError := 'CopyFile: ' + TextByKey('common-genericcopyfailure'); RuntimeError(LastError); // AV Halt; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV end else begin if not FileExists(src) then LastError := 'CopyFile: ' + TextByKey('common-noparamfile') else LastError := 'CopyFile: ' + TextByKey('render-status-pathdoesnotexist'); RuntimeError(LastError); // AV Halt; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV end; end; end; procedure TScriptEditor.FindReplaceClick(Sender: TObject); begin ScrMemoFindReplaceDialog1.Execute; end; procedure TScriptEditor.RunScript; var lib: TStringList; favs, defs: boolean; // current status of submenus begin btnRun.Enabled := False; btnBreak.Enabled := True; btnPause.Enabled := True; MainForm.btnRunScript.Enabled := False; MainForm.mnuRun.Enabled := False; favs := (MainForm.FavouriteScripts1.Count > 0); defs := (MainForm.Directory1.Count > 0); MainForm.FavouriteScripts1.Enabled := False; // MainForm.DisableFavorites; MainForm.Directory1.Enabled := False; ParamFile := OpenFile; FillFileList; { Set defaults } { Set render defaults } Renderer.Width := 320; Renderer.Height := 240; Renderer.EmbedParameters := False; // AV Stopped := False; UpdateIt := True; ResetLocation := False; Console.Clear; LastError := ''; ActiveTransform := EditForm.SelectedTriangle; NumTransforms := Transforms; cp.copy(MainCp); //cmap := MainCp.cmap; // <-- is used nowhere Application.ProcessMessages; Randomize; StatusBar.SimpleText := TextByKey('script-status-executing'); // what in the sweet loving sake of jesus is this fuck? // AV: this is really strange... if Pos('stopped', Lowercase(Editor.Lines.text)) <> 0 then begin btnStop.Enabled := True; MainForm.mnuStop.Enabled := True; MainForm.btnStopScript.Enabled := True; end; with Scripter do begin SourceCode.Assign(Editor.Lines); if FileExists(defLibrary) then begin lib := TStringList.Create; try Lib.LoadFromFile(defLibrary); with Scripts.Add do begin SourceCode := lib; SelfRegisterAsLibrary('Functions'); end; finally lib.free; end; end; //Compile; Execute; end; if (NumTransforms < 1) and UpdateIt then Console.Lines.Add(TextByKey('script-status-notransforms')) else if (LastError = '') and UpdateIt then begin MainForm.UpdateUndo; MainCp.Copy(cp); UpdateFlame; if ResetLocation then MainForm.ResetLocation; end else Console.Lines.Add(LastError); if ScriptRenderForm.Visible then ScriptRenderForm.Close; btnRun.Enabled := True; btnStop.Enabled := False; MainForm.btnRunScript.Enabled := True; MainForm.btnStopScript.Enabled := False; MainForm.mnuRun.Enabled := True; MainForm.mnuStop.Enabled := False; btnBreak.Enabled := False; btnPause.Enabled := False; // AV: restore the status of submenus to continue work with these scripts MainForm.FavouriteScripts1.Enabled := favs; MainForm.Directory1.Enabled := defs; StatusBar.SimpleText := StatusBar.Hint; end; procedure TScriptEditor.btnRunClick(Sender: TObject); begin RunScript; end; { ****************************** Update flame ******************************* } procedure TScriptEditor.UpdateFlame; begin MainForm.StopThread; MainForm.UpdateUndo; MainCp.Copy(cp); // MainCp.name := FlameName; Transforms := MainCp.TrianglesFromCP(MainTriangles); MainCp.AdjustScale(MainForm.Image.Width, MainForm.Image.Height); if ResetLocation then MainCp.CalcBoundBox else begin; MainCp.Zoom := cp.zoom; MainCp.center[0] := cp.center[0]; MainCp.center[1] := cp.center[1]; end; MainCp.cmap := cp.cmap; MainForm.RedrawTimer.enabled := true; if EditForm.Visible then EditForm.UpdateDisplay; if AdjustForm.Visible then AdjustForm.UpdateDisplay; if MutateForm.Visible then MutateForm.UpdateDisplay; end; (* procedure copyxform(var dest: Txform; const source: TXform); var i: integer; begin dest.c[0, 0] := source.c[0, 0]; dest.c[0, 1] := source.c[0, 1]; dest.c[1, 0] := source.c[1, 0]; dest.c[1, 1] := source.c[1, 1]; dest.c[2, 0] := source.c[2, 0]; dest.c[2, 1] := source.c[2, 1]; dest.color := source.color; // hmm, why no symmetry here? // dest.symmetry := source.symmetry; dest.density := source.density; for i := 0 to NRVAR - 1 do dest.SetVariation(i, source.GetVariation(i)); end; *) { ************************ Editor Popup menu ********************************* } procedure TScriptEditor.mnuCutClick(Sender: TObject); begin if Editor.CanCut then Editor.CutToClipboard; end; procedure TScriptEditor.mnuDeleteBlockClick(Sender: TObject); begin with ScrCodeList1 do if ItemIndex >= 0 then CodeBlocks.Delete(ItemIndex); end; procedure TScriptEditor.mnuCopyClick(Sender: TObject); begin if Editor.CanCopy then Editor.CopyToClipboard; end; procedure TScriptEditor.mnuPasteClick(Sender: TObject); begin if Editor.CanPaste then Editor.PasteFromClipboard; end; procedure TScriptEditor.mnuRedoClick(Sender: TObject); begin if Editor.CanRedo then Editor.Redo; end; procedure TScriptEditor.mnuUndoClick(Sender: TObject); begin if Editor.CanUndo then Editor.Undo; end; procedure TScriptEditor.EditCaption1Click(Sender: TObject); var scap: string; // empty string by default begin if ScrCodeList1.ItemIndex < 0 then exit; scap := ScrCodeList1.CodeBlocks[ScrCodeList1.ItemIndex].Caption; if not InputQuery(TextByKey('script-codeblock'), TextByKey('script-codeblockrename'), scap) then exit; ScrCodeList1.CodeBlocks[ScrCodeList1.ItemIndex].Caption := scap; end; procedure TScriptEditor.EditorChange(Sender: TObject); begin // Editor.activeLine := -1; // <<== AV: it's the source of bugs... Editor.ActiveLineSettings.ShowActiveLine := false; {if not Editor.CanUndo then mnuUndo.Enabled := false else mnuUndo.Enabled := true; } // AV: optimized mnuUndo.Enabled := Editor.CanUndo; mnuRedo.Enabled := Editor.CanRedo; end; {********** AV: let's make it more interactive! ************ } procedure TScriptEditor.EditorDragDrop(Sender, Source: TObject; X, Y: Integer); begin if (source is TScrCodeList) then Editor.DropText(X, Y, ScrCodeList1.CodeBlocks[ScrCodeList1.itemindex].Code.Text); end; procedure TScriptEditor.EditorDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := true; // AV: so you can drag and drop any text inside the Scripter! end; procedure TScriptEditor.EditorGetAutoCompletionList(Sender: TObject; AToken: string; AList: TStringList); // AV: so the scripter will resemble a real IDE var i: integer; begin if (LowerCase(AToken) = 'transform.') then begin ALIst.AddObject('property coefs[][]: array of double', TObject(ttProp)); ALIst.AddObject('property post[][]: array of double', TObject(ttProp)); ALIst.AddObject('property A: double', TObject(ttProp)); ALIst.AddObject('property B: double', TObject(ttProp)); ALIst.AddObject('property C: double', TObject(ttProp)); ALIst.AddObject('property D: double', TObject(ttProp)); ALIst.AddObject('property E: double', TObject(ttProp)); ALIst.AddObject('property F: double', TObject(ttProp)); ALIst.AddObject('property Color: double', TObject(ttProp)); ALIst.AddObject('property VarColor: double', TObject(ttProp)); ALIst.AddObject('property Opacity: double', TObject(ttProp)); ALIst.AddObject('property PlotMode: integer', TObject(ttProp)); ALIst.AddObject('property Weight: double', TObject(ttProp)); ALIst.AddObject('property Symmetry: double', TObject(ttProp)); ALIst.AddObject('property ColorSpeed: double', TObject(ttProp)); ALIst.AddObject('property Chaos[]: array of double', TObject(ttProp)); ALIst.AddObject('property Name: string', TObject(ttProp)); ALIst.AddObject('procedure Clear', TObject(ttMethod)); ALIst.AddObject('method Rotate(Degrees: double)', TObject(ttMethod)); ALIst.AddObject('method RotatePXOrigin(Degrees: double)', TObject(ttMethod)); ALIst.AddObject('method RotatePX(Degrees: double)', TObject(ttMethod)); ALIst.AddObject('method ScalePX(Factor: double)', TObject(ttMethod)); ALIst.AddObject('method FlipHoriz', TObject(ttMethod)); ALIst.AddObject('method FlipPXHoriz', TObject(ttMethod)); ALIst.AddObject('method FlipVert', TObject(ttMethod)); ALIst.AddObject('method FlipPXVert', TObject(ttMethod)); ALIst.AddObject('method Scale(Factor: double)', TObject(ttMethod)); ALIst.AddObject('method RotateOrigin(Degrees: double)', TObject(ttMethod)); ALIst.AddObject('property Variation[]: array of double', TObject(ttProp)); ALIst.AddObject('property Variable[]: array of double', TObject(ttProp)); ALIst.AddObject('property postXformEnabled: boolean', TObject(ttProp)); ALIst.AddObject('method SwapCoefs', TObject(ttMethod)); ALIst.AddObject('method ResetVariables', TObject(ttMethod)); ALIst.AddObject('method SwapVariations(var1_name, var2_name: string)', TObject(ttMethod)); ALIst.AddObject('method SortVariationsByName', TObject(ttMethod)); ALIst.AddObject('method SortVariationsByIndex', TObject(ttMethod)); ALIst.AddObject('method PrintVariationsOrder', TObject(ttMethod)); ALIst.AddObject('method SetVariationOrder(var_name, index: integer)', TObject(ttMethod)); ALIst.AddObject('method CopyVariationsOrder(transform_index: integer)', TObject(ttMethod)); ALIst.AddObject('function GetVariationOrder(var_name: string): integer', TObject(ttMethod)); for i:= 0 to NRVAR - 1 do ALIst.AddObject('property ' + varnames(i) + ': double', TObject(ttProp)); for i:= 0 to GetNrVariableNames - 1 do begin ALIst.AddObject('property ' + GetVariableNameAt(i) + ': double', TObject(ttProp)); end; end else if (LowerCase(AToken) = 'flame.') then begin ALIst.AddObject('property Gamma: double', TObject(ttProp)); ALIst.AddObject('property GammaThreshold: double', TObject(ttProp)); ALIst.AddObject('property Brightness: double', TObject(ttProp)); ALIst.AddObject('property Vibrancy: double', TObject(ttProp)); ALIst.AddObject('property Contrast: double', TObject(ttProp)); ALIst.AddObject('property Scale: double', TObject(ttProp)); ALIst.AddObject('property Width: integer', TObject(ttProp)); ALIst.AddObject('property Weight: integer', TObject(ttProp)); ALIst.AddObject('property PreviewWidth: integer', TObject(ttProp)); ALIst.AddObject('property PreviewHeight: integer', TObject(ttProp)); ALIst.AddObject('property Zoom: double', TObject(ttProp)); ALIst.AddObject('property Angle: double', TObject(ttProp)); ALIst.AddObject('property Pitch: double', TObject(ttProp)); ALIst.AddObject('property Yaw: double', TObject(ttProp)); ALIst.AddObject('property Roll: double', TObject(ttProp)); ALIst.AddObject('property Perspective: double', TObject(ttProp)); ALIst.AddObject('property Z: double', TObject(ttProp)); ALIst.AddObject('property X: double', TObject(ttProp)); ALIst.AddObject('property Y: double', TObject(ttProp)); ALIst.AddObject('property DOF: double', TObject(ttProp)); ALIst.AddObject('property Name: string', TObject(ttProp)); ALIst.AddObject('property Comment: string', TObject(ttProp)); ALIst.AddObject('property SampleDensity: double', TObject(ttProp)); ALIst.AddObject('property Quality: double', TObject(ttProp)); ALIst.AddObject('property Time: double', TObject(ttProp)); ALIst.AddObject('property Hue: double', TObject(ttProp)); ALIst.AddObject('property Oversample: integer', TObject(ttProp)); ALIst.AddObject('property FilterRadius: double', TObject(ttProp)); ALIst.AddObject('property FinalXformEnabled: boolean', TObject(ttProp)); ALIst.AddObject('property Background[]: array of integer', TObject(ttProp)); ALIst.AddObject('property Gradient[][]: array of integer', TObject(ttProp)); end else if (LowerCase(AToken) = 'pivot.') then begin ALIst.AddObject('property X: double', TObject(ttProp)); ALIst.AddObject('property Y: double', TObject(ttProp)); ALIst.AddObject('property Mode: integer', TObject(ttProp)); ALIst.AddObject('procedure Set( X: double, Y: double)', TObject(ttMethod)); ALIst.AddObject('procedure Reset', TObject(ttMethod)); end else if (LowerCase(AToken) = 'renderer.') then begin ALIst.AddObject('property Filename: string', TObject(ttProp)); ALIst.AddObject('property Width: integer', TObject(ttProp)); ALIst.AddObject('property Height: integer', TObject(ttProp)); ALIst.AddObject('property MaxMemory: integer', TObject(ttProp)); ALIst.AddObject('property EmbedParameters: boolean', TObject(ttProp)); end else if (LowerCase(AToken) = 'options.') then begin ALIst.AddObject('property JPEGQuality: integer', TObject(ttProp)); ALIst.AddObject('property BatchSize: integer', TObject(ttProp)); ALIst.AddObject('property ParameterFile: string', TObject(ttProp)); ALIst.AddObject('property SmoothPaletteFile: string', TObject(ttProp)); ALIst.AddObject('property NumTries: integer', TObject(ttProp)); ALIst.AddObject('property TryLength: integer', TObject(ttProp)); ALIst.AddObject('property ConfirmDelete: boolean', TObject(ttProp)); ALIst.AddObject('property Transparency: integer', TObject(ttProp)); ALIst.AddObject('property Multithreading: integer', TObject(ttProp)); ALIst.AddObject('property Gamma: double', TObject(ttProp)); ALIst.AddObject('property GammaThreshold: double', TObject(ttProp)); ALIst.AddObject('property Brightness: double', TObject(ttProp)); ALIst.AddObject('property Vibrancy: double', TObject(ttProp)); ALIst.AddObject('property Contrast: double', TObject(ttProp)); ALIst.AddObject('property PreviewLowQuality: double', TObject(ttProp)); ALIst.AddObject('property PreviewMediumQuality: double', TObject(ttProp)); ALIst.AddObject('property PreviewHighQuality: double', TObject(ttProp)); ALIst.AddObject('property Variations[]: array of boolean', TObject(ttProp)); ALIst.AddObject('property MinTransforms: integer', TObject(ttProp)); ALIst.AddObject('property MutateMinTransforms: integer', TObject(ttProp)); ALIst.AddObject('property MaxTransforms: integer', TObject(ttProp)); ALIst.AddObject('property MutateMaxTransforms: integer', TObject(ttProp)); ALIst.AddObject('property RandomPrefix: string', TObject(ttProp)); ALIst.AddObject('property KeepBackground: integer', TObject(ttProp)); ALIst.AddObject('property SymmetryType: integer', TObject(ttProp)); ALIst.AddObject('property SymmetryOrder: integer', TObject(ttProp)); ALIst.AddObject('property MinNodes: integer', TObject(ttProp)); ALIst.AddObject('property MaxNodes: integer', TObject(ttProp)); ALIst.AddObject('property MaxSaturation: integer', TObject(ttProp)); ALIst.AddObject('property MinSaturation: integer', TObject(ttProp)); ALIst.AddObject('property MaxLuminance: integer', TObject(ttProp)); ALIst.AddObject('property MinLuminance: integer', TObject(ttProp)); ALIst.AddObject('property GradientOnRandom: integer', TObject(ttProp)); ALIst.AddObject('property GradientFileOnRandom: string', TObject(ttProp)); ALIst.AddObject('property ColorBlending: integer', TObject(ttProp)); ALIst.AddObject('property EvenGradientStripes: boolean', TObject(ttProp)); ALIst.AddObject('property ExportRenderer: string', TObject(ttProp)); end else if pos('tstringlist', LowerCase(AToken))> 0 then ALIst.AddObject('constructor Create', TObject(ttMethod)) // AV: easter eggs ;-) else if (((pos('apo', LowerCase(AToken))> 0) and (LowerCase(AToken) <> 'apophysis.')) or (pos('ifs', LowerCase(AToken))> 0)) then begin //AList.Clear; ALIst.AddObject('procedure LoadFromFile(full_filename: string)', TObject(ttProc)); ALIst.AddObject('procedure SaveToFile(full_filename: string)', TObject(ttProc)); ALIst.AddObject('function Add(text: string): integer', TObject(ttFunc)); ALIst.AddObject('function AddPair(Name, Value: string): TStrings', TObject(ttFunc)); ALIst.AddObject('function IndexOfName(Name: string): integer', TObject(ttFunc)); ALIst.AddObject('property KeyNames[index: integer]: string', TObject(ttProp)); ALIst.AddObject('property Names[index: integer]: string', TObject(ttProp)); ALIst.AddObject('property Values[Name: string]: string', TObject(ttProp)); ALIst.AddObject('property ValueFromIndex[index: integer]: string', TObject(ttProp)); ALIst.AddObject('function IndexOf(text_str: string): integer', TObject(ttFunc)); ALIst.AddObject('property Count: integer', TObject(ttProp)); ALIst.AddObject('procedure Insert(index: integer, str: string)', TObject(ttProc)); ALIst.AddObject('procedure Delete(str_index: integer)', TObject(ttProc)); ALIst.AddObject('procedure Move(CurIndex, NewIndex: integer)', TObject(ttProc)); ALIst.AddObject('property Strings[]: array of string', TObject(ttProp)); ALIst.AddObject('property NameValueSeparator: char', TObject(ttProp)); ALIst.AddObject('property CommaText: string', TObject(ttProp)); ALIst.AddObject('property Text: string', TObject(ttProp)); ALIst.AddObject('destructor Free', TObject(ttMethod)); ALIst.AddObject('procedure Clear', TObject(ttProc)); ALIst.AddObject('procedure Sort', TObject(ttProc)); ALIst.AddObject('property Sorted: boolean', TObject(ttProp)); ALIst.AddObject('procedure Assign(sourse: TStrings)', TObject(ttProc)); ALIst.AddObject('procedure AddStrings(strings: TStrings)', TObject(ttProc)); end else if (LowerCase(AToken) = 'apophysis.') or (LowerCase(AToken) = 'application.') then begin ALIst.AddObject('function MessageBox(Promt, Caption: string, DlgStyle: integer = 0): integer;', TObject(ttFunc)); ALIst.AddObject('property Icon', TObject(ttProp)); ALIst.AddObject('property Title', TObject(ttProp)); ALIst.AddObject('property ExeName', TObject(ttProp)); ALIst.AddObject('procedure ProcessMessages', TObject(ttMethod)); end else if (LowerCase(AToken) = 'ttaskdialog.') then ALIst.AddObject('constructor Create(nil)', TObject(ttMethod)) else if (pos('tdlg', LowerCase(AToken))> 0) then begin //AList.Clear; ALIst.AddObject('destructor Destroy', TObject(ttMethod)); ALIst.AddObject('property Title: string', TObject(ttProp)); ALIst.AddObject('property Caption: string', TObject(ttProp)); ALIst.AddObject('property MainIcon', TObject(ttProp)); ALIst.AddObject('property CustomMainIcon', TObject(ttProp)); ALIst.AddObject('property ExpandedText: string', TObject(ttProp)); ALIst.AddObject('property ExpandButtonCaption: string', TObject(ttProp)); ALIst.AddObject('property Text: string', TObject(ttProp)); ALIst.AddObject('property VerificationText: string', TObject(ttProp)); ALIst.AddObject('property CommonButtons: [set]', TObject(ttProp)); ALIst.AddObject('property DefaultButton', TObject(ttProp)); ALIst.AddObject('method Execute', TObject(ttMethod)); ALIst.AddObject('property ModalResult: integer', TObject(ttProp)); ALIst.AddObject('property Buttons', TObject(ttProp)); ALIst.AddObject('property RadioButtons', TObject(ttProp)); ALIst.AddObject('property Button', TObject(ttProp)); ALIst.AddObject('property RadioButton', TObject(ttProp)); ALIst.AddObject('property Flags: [set]', TObject(ttProp)); ALIst.AddObject('property FooterText: string', TObject(ttProp)); ALIst.AddObject('property FooterIcon', TObject(ttProp)); ALIst.AddObject('property CustomFooterIcon', TObject(ttProp)); ALIst.AddObject('property ProgressBar', TObject(ttProp)); ALIst.AddObject('property OnVerificationClicked: procedure', TObject(ttProp)); end; if (pos('buttons.', LowerCase(AToken))> 0) then begin AList.Clear; ALIst.AddObject('method Add', TObject(ttMethod)); ALIst.AddObject('method Delete(i)', TObject(ttMethod)); if (pos('radiobuttons.', LowerCase(AToken))> 0) then ALIst.AddObject('property Items[i]', TObject(ttProp)); end; if (pos('radiobutton.', LowerCase(AToken))> 0) then begin AList.Clear; ALIst.AddObject('property ID: integer', TObject(ttProp)); ALIst.AddObject('property Index: integer', TObject(ttProp)); end; if (pos('btn', LowerCase(AToken))> 0) or (pos('.button.', LowerCase(AToken))> 0) then begin AList.Clear; ALIst.AddObject('property Caption: string', TObject(ttProp)); ALIst.AddObject('property CommandLinkHint: string', TObject(ttProp)); ALIst.AddObject('property ModalResult: integer', TObject(ttProp)); end; if (pos('progressbar.', LowerCase(AToken))> 0) then begin AList.Clear; ALIst.AddObject('property Min: integer', TObject(ttProp)); ALIst.AddObject('property Max: integer', TObject(ttProp)); ALIst.AddObject('property Position: integer', TObject(ttProp)); ALIst.AddObject('property MarqueeSpeed: integer', TObject(ttProp)); ALIst.AddObject('property State: integer', TObject(ttProp)); end; if (AList.Count > 1) then AList.Sorted := True; end; procedure TScriptEditor.ExpandBlocksClick(Sender: TObject); begin Editor.ExpandAllNodes; end; { ****************************** } procedure TScriptEditor.ScrCodeList1BlockDblClick(Sender: TObject; ACodeBlock: TCodeBlock); begin with Editor do DropText(CurX, CurY, ScrCodeList1.CodeBlocks[ScrCodeList1.itemindex].Code.Text); end; procedure TScriptEditor.ScrCodeList1BlockRightClick(Sender: TObject; ACodeBlock: TCodeBlock); begin ScrCodeList1.ItemIndex := ACodeBlock.Index; end; procedure TScriptEditor.ScrCodeList1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); begin if (ScrCodeList1.Items.Count > 1) then mnuDeleteBlock.Enabled := True else mnuDeleteBlock.Enabled := False; end; procedure TScriptEditor.ScrCodeList1DragDrop(Sender, Source: TObject; X, Y: Integer); begin ScrCodeList1.CodeBlocks.Add(Editor.Selection); end; procedure TScriptEditor.ScrCodeList1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := (source is TScrMemo); end; procedure TScriptEditor.ScripterCompileError(Sender: TObject; var msg: string; row, col: Integer; var ShowException: Boolean); var ps, n: integer; begin btnRun.Enabled := True; btnStop.Enabled := False; btnBreak.Enabled := False; btnPause.Enabled := False; MainForm.btnRunScript.Enabled := True; MainForm.btnStopScript.Enabled := False; MainForm.mnuRun.Enabled := True; MainForm.mnuStop.Enabled := False; { AV: in previous Apo versions, user cannot load a Script after simple syntax error - it's not normally... } if (MainForm.FavouriteScripts1.Count > 0) then MainForm.FavouriteScripts1.Enabled := True; // AV if (MainForm.Directory1.Count > 0) then MainForm.Directory1.Enabled := True; // AV StatusBar.SimpleText := TextByKey('script-status-compileerror'); // AV n := min(row, Editor.Lines.Count) - 1; // AV Editor.ActiveLine := n; Editor.ActiveLineSettings.ShowActiveLine := True; if LanguageFile <> '' then // AV: if we need to translate from/to English begin if pos('Unknown ident', msg) > 0 then msg := StringReplace(msg, 'Unknown identifier or variable is not declared', TextByKey('script-status-noidentifier'), []) else if pos('Syntax err', msg) > 0 then msg := StringReplace(msg, 'Syntax error', TextByKey('script-status-syntaxerror'), []) else if pos('Unknown member id', msg) > 0 then msg := StringReplace(msg, 'Unknown member identifier', TextByKey('script-status-noclassmember'), []) else if pos('Unknown method or rout', msg) > 0 then msg := StringReplace(msg, 'Unknown method or routine', TextByKey('script-status-unknownmethod'), []) else if pos('value to const', msg) > 0 then msg := StringReplace(msg, 'Cannot assign a value to constant', TextByKey('script-status-constassign'), []) else if pos('Too many param', msg) > 0 then begin msg := StringReplace(msg, 'Too many parameters for method', TextByKey('script-status-toomanyparams'), []); ps := pos('#', TextByKey('script-status-expectparams')); if (ps <> 0) then begin msg := StringReplace(msg, 'Expected ', Copy(TextByKey('script-status-expectparams'), 1, ps - 1), []); msg := StringReplace(msg, ' parameters', Copy(TextByKey('script-status-expectparams'), ps + 1, length(TextByKey('script-status-expectparams')) - ps), []); end; end else if pos('Not enough act', msg) > 0 then begin msg := StringReplace(msg, 'Not enough actual parameters for method', TextByKey('script-status-notenoughparams'), []); ps := pos('#', TextByKey('script-status-expectparams')); if (ps <> 0) then begin msg := StringReplace(msg, 'Expected ', Copy(TextByKey('script-status-expectparams'), 1, ps - 1), []); msg := StringReplace(msg, ' parameters', Copy(TextByKey('script-status-expectparams'), ps + 1, length(TextByKey('script-status-expectparams')) - ps), []); end; end else if (pos('Method ', msg) > 0) and (pos('expects vari', msg) > 0) then begin ps := pos('#', TextByKey('script-status-expectvar')); if (ps <> 0) then begin msg := StringReplace(msg, 'Method ', Copy(TextByKey('script-status-expectvar'), 1, ps - 1), []); msg := StringReplace(msg, ' expects variable reference', Copy(TextByKey('script-status-expectvar'), ps + 1, length(TextByKey('script-status-expectvar')) - ps), []); end; end else if pos('Assign to meth', msg) > 0 then begin ps := pos('#', TextByKey('script-status-notassign')); if (ps <> 0) then begin msg := StringReplace(msg, 'Assign to method ', Copy(TextByKey('script-status-notassign'), 1, ps - 1), []); msg := StringReplace(msg, ' is not allowed', Copy(TextByKey('script-status-notassign'), ps + 1, length(TextByKey('script-status-notassign')) - ps), []); end; end else if pos('called as a me', msg) > 0 then begin ps := pos('#', TextByKey('script-status-propnotfunc')); if (ps <> 0) then begin msg := StringReplace(msg, 'Property ', Copy(TextByKey('script-status-propnotfunc'), 1, ps - 1), []); msg := StringReplace(msg, ' cannot be called as a method', Copy(TextByKey('script-status-propnotfunc'), ps + 1, length(TextByKey('script-status-propnotfunc')) - ps), []); end; end; end; Console.Lines.Add(TextByKey('script-line') + #32 + IntToStr(n+1) + ' : '+ msg); LoadForm.Output.Text := LoadForm.Output.Text + DTError + TextByKey('script-line') + ': '#39 + Editor.Lines[n] + #39', '+ TextByKey('script-position') + ': '+ IntToStr(col) + #13#10 + msg + #13#10; // AV ScriptRenderForm.Close; ShowException := true; Application.ProcessMessages; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV end; procedure TScriptEditor.ScripterRuntimeError(Sender: TObject; var msg: string; row, col: Integer; var ShowException: Boolean); // AV begin btnRun.Enabled := True; btnStop.Enabled := False; btnBreak.Enabled := False; btnPause.Enabled := False; MainForm.btnRunScript.Enabled := True; MainForm.btnStopScript.Enabled := False; MainForm.mnuRun.Enabled := True; MainForm.mnuStop.Enabled := False; StatusBar.SimpleText := TextByKey('script-status-runtimeerror'); // AV { AV: in previous Apo versions, user cannot continue work in Script editor after runtime error - it's not normally... } if (MainForm.FavouriteScripts1.Count > 0) then MainForm.FavouriteScripts1.Enabled := True; // AV if (MainForm.Directory1.Count > 0) then MainForm.Directory1.Enabled := True; // AV Editor.ActiveLine := min(row, Editor.Lines.Count) - 1; // AV Editor.ActiveLineSettings.ShowActiveLine := True; if LanguageFile <> '' then { AV: We don't need to translate from-to English } begin if pos('not an array', msg) > 0 then msg := StringReplace(msg, 'Variable is not an array', TextByKey('script-status-varnotarray'), []) else if pos('find form f', msg) > 0 then msg := StringReplace(msg, 'Cannot find form file', TextByKey('script-status-noformfile'), []); end; LoadForm.Output.Text := LoadForm.Output.Text + RTError + TextByKey('script-line') + ': '#39 + Editor.Lines[Editor.ActiveLine] + #39', '+ TextByKey('script-position') + ': '+ IntToStr(col) + #13#10 + msg + #13#10; ScriptRenderForm.Close; ShowException := true; Application.ProcessMessages; if LoadForm.CheckBox1.Checked then LoadForm.Show; // AV end; procedure TScriptEditor.btnStopClick(Sender: TObject); begin Console.Lines.Add(TextByKey('script-status-stopped')); // AV if btnPause.Down then btnPause.Click; // AV Stopped := True; end; procedure TScriptEditor.AddFromClipboardClick(Sender: TObject); begin AddFromClipboard.Checked := not AddFromClipboard.Checked; ScrCodeList1.ClipboardView := AddFromClipboard.Checked; end; procedure TScriptEditor.AdjustScripterColors; // AV var i: integer; BackColor: TColor; begin BackColor := Editor.BkColor; with Styler do // default begin for i := 0 to AllStyles.Count-1 do AllStyles[i].BGColor := BackColor; CommentStyle.BkColor := BackColor; NumberStyle.BkColor := BackColor; NumberStyle.TextColor := clFuchsia; end; Editor.BlockColor := MidColor; Editor.Gutter.GutterColor := BrightColor; Editor.Gutter.GutterColorTo := MidColor; Editor.Gutter.Font.Color := TextColor; ScrCodeList1.Font.Color := Editor.Font.Color; if IsDarkTheme then // AV: adaptating the scripter to dark themes begin with Styler do begin AllStyles[0].Font.Color := clLime; AllStyles[4].Font.Color := clAqua; CommentStyle.TextColor := clAqua; end; with Editor.AutoCompletion do begin Font.Color := clWhite; ColorFunc := $00C6C600; // turquoise ColorProc := $00C6C600; ColorMethod := $00C6C600; ColorProp := $0020B9FB; // orange ColorIdentifier := $00E901BA; // violet ColorVar := clSkyBlue; end; end else begin with Styler do // default begin AllStyles[0].Font.Color := clGreen; AllStyles[4].Font.Color := clNavy; CommentStyle.TextColor := clNavy; if (CurrentStyle = 'Calypso SLE') or (CurrentStyle = 'Emerald') or (CurrentStyle = 'Coral') then NumberStyle.TextColor := $009F009F; end; with Editor.AutoCompletion do begin Font.Color := TextColor; ColorFunc := clNavy; ColorProc := clNavy; ColorMethod := clNavy; ColorProp := clGreen; ColorIdentifier := clTeal; ColorVar := clBlue; end; end; end; procedure TScriptEditor.btnBreakClick(Sender: TObject); begin LastError := TextByKey('script-status-break'); if btnPause.Down then btnPause.Click; // AV Scripter.Halt; btnPause.Enabled := False; StatusBar.SimpleText := StatusBar.Hint; end; procedure TScriptEditor.btnFavoriteClick(Sender: TObject); // AV: rewrite and bring back to life a very old method var i: integer; there: boolean; begin if Trim(Editor.Lines.Text)= '' then exit; there := False; for i := 0 to Favorites.Count - 1 do if Lowercase(Script) = LowerCase(Favorites[i]) then begin There := true; break; end; if there then begin Application.MessageBox(PChar(Format(TextByKey('common-favscriptexists'), [ExtractFileName(Script)])), PChar(ApophysisSVN), MB_ICONWARNING); exit; end; if (Script = '') or Editor.LinesModified then btnSave.Click; if Script <> '' then begin Favorites.Add(Script); Favorites.SaveToFile(AppPath + scriptFavsFilename); MainForm.GetScripts; Application.MessageBox(PChar(Format(TextByKey('common-favscriptadded'), [ExtractFileName(Script)])), ApophysisSVN, MB_ICONINFORMATION); end; end; { // AV: now it's deprecated procedure TScriptEditor.FormShortCut(var Msg: TWMKey; var Handled: Boolean); begin if GetKeyState(VK_CONTROL) >= 0 then Exit; if Msg.CharCode = Ord('C') then begin Editor.CopyToClipBoard; Handled := True; end; if Msg.CharCode = Ord('V') then begin Editor.PasteFromClipBoard; Handled := True; end; if Msg.CharCode = Ord('X') then begin Editor.CutToClipBoard; Handled := True; end; end; } procedure TScriptEditor.F2SXMLContent(Sender: TObject; Content: string); begin // todo: palette end; procedure TScriptEditor.F2SXMLEmptyTag(Sender: TObject; TagName: string; Attributes: TAttrList); var i, n: integer; v, w: string; //TStringType; d, floatcolor: double; Tokens: TStringList; begin Tokens := TStringList.Create; try if (TagName = 'xform') or (TagName = 'finalxform') then Editor.Lines.Add(''); if TagName = 'finalxform' then begin Editor.Lines.Add('{ Final Transform }'); Editor.Lines.Add('Flame.FinalXformEnabled := True;'); Editor.Lines.Add('SetActiveTransform(transforms);'); end else begin w := '{ Transform ' + IntToStr(AddedXForms + 1); v := string(Attributes.Value('name')); if (v <> '') then w := w + ' (' + v + ')'; w := w + ' }'; Editor.Lines.Add(w); Editor.Lines.Add('AddTransform;'); end; Editor.Lines.Add('with Transform do begin'); //Editor.Lines.Add(' for i := 0 to NXFORMS do Chaos[i] := 1;'); v := string(Attributes.Value('var_order')); if v <> '' then begin GetTokens(v, tokens); n := -1; for i := 0 to Tokens.Count-1 do if (GetVariationIndex(Tokens[i]) >= 0) then begin inc(n); Editor.Lines.Add(Format(' SetVariationOrder(''%s'', %d);', [Tokens[i], n])); end; end; v := string(Attributes.Value('linear')); // varnames(0) if v = '' then Editor.Lines.Add(' Variation[0] := 0; // linear'); for i := 0 to NRVAR - 1 do begin w := varnames(i); v := string(Attributes.Value(Utf8String(w))); if v <> '' then Editor.Lines.Add(Format(' %s := %.6g;', [w, StrToFloat(v)])); end; for i := 0 to GetNrVariableNames - 1 do begin w := GetVariableNameAt(i); v := string(Attributes.Value(Utf8String(w))); if v <> '' then begin Editor.Lines.Add(' ' + w + ' := ' + v + ';'); end; end; v := string(Attributes.Value('weight')); if (v <> '') and (TagName = 'xform') then Editor.Lines.Add(Format(' Weight := %.6g;', [StrToFloat(v)])); v := string(Attributes.Value('color')); if (v <> '') then Editor.Lines.Add(' Color := ' + v+ ';'); v := string(Attributes.Value('var_color')); if (v <> '') then Editor.Lines.Add(' VarColor := ' + v + ';'); // AV: fixed - final xforms can have ColorSpeed <> 1 v := string(Attributes.Value('symmetry')); if (v <> '') then Editor.Lines.Add(' Symmetry := ' + v + ';'); v := string(Attributes.Value('opacity')); if v <> '' then begin Editor.Lines.Add(' Opacity := ' + v + ';'); end; v := string(Attributes.Value('coefs')); if (v <> '') then begin GetTokens(v, tokens); Editor.Lines.Add(Format(' coefs[0,0] := %.6g; // a', [StrToFloat(Tokens[0])])); Editor.Lines.Add(Format(' coefs[1,0] := %.6g; // b', [StrToFloat(Tokens[2]) * (-1)])); Editor.Lines.Add(Format(' coefs[0,1] := %.6g; // c', [StrToFloat(Tokens[1]) * (-1)])); Editor.Lines.Add(Format(' coefs[1,1] := %.6g; // d', [StrToFloat(Tokens[3])])); Editor.Lines.Add(Format(' coefs[2,0] := %.6g; // e', [StrToFloat(Tokens[4])])); Editor.Lines.Add(Format(' coefs[2,1] := %.6g; // f', [StrToFloat(Tokens[5]) * (-1)])); end; v := string(Attributes.Value('post')); if v <> '' then begin GetTokens(v, tokens); Editor.Lines.Add(Format(' post[0,0] := %.6g;', [StrToFloat(Tokens[0])])); Editor.Lines.Add(Format(' post[0,1] := %.6g;', [StrToFloat(Tokens[1]) * (-1)])); Editor.Lines.Add(Format(' post[1,0] := %.6g;', [StrToFloat(Tokens[2]) * (-1)])); Editor.Lines.Add(Format(' post[1,1] := %.6g;', [StrToFloat(Tokens[3])])); Editor.Lines.Add(Format(' post[2,0] := %.6g;', [StrToFloat(Tokens[4])])); Editor.Lines.Add(Format(' post[2,1] := %.6g;', [StrToFloat(Tokens[5]) * (-1)])); end; v := string(Attributes.Value('chaos')); if v <> '' then begin chaosLines.Add(''); chaosLines.Add('{ Weight modifiers for transform ' + IntToStr(AddedXForms + 1) + ' }'); chaosLines.Add('SetActiveTransform(' + IntToStr(AddedXForms) + ');'); chaosLines.Add('with Transform do begin'); GetTokens(v, tokens); for i := 0 to Tokens.Count-1 do chaosLines.Add(' chaos[' + IntToStr(i) + '] := ' + Tokens[i] + ';') ; chaosLines.Add('end;'); end; Editor.Lines.Add('end;'); AddedXForms := AddedXForms + 1; finally Tokens.free; end; end; procedure TScriptEditor.F2SXMLStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); var Tokens: TStringList; v: string; //TStringType; f, b: double; begin Tokens := TStringList.Create; try if TagName='flame' then begin AddedXForms := 0; Editor.Lines.Add('{ Flame }'); Editor.Lines.Add('Clear;'); // Editor.Lines.Add('if (pos(''7x'', LowerCase(ProgramVersionString)) > 0) then'); // Editor.Lines.Add(' AngleTransform := 180 / PI else AngleTransform := 1;'); Editor.Lines.Add('with Flame do begin'); v := string(Attributes.Value('size')); if (v <> '') then begin GetTokens(v, tokens); Editor.Lines.Add(' Width := ' + Tokens[0] + ';'); Editor.Lines.Add(' Height := ' + Tokens[1] + ';'); f := 100 / StrToFloat(Tokens[0]); end else f := 0; b := 0; v := string(Attributes.Value('brightness')); if (v <> '') then begin Editor.Lines.Add(' Brightness := ' + v + ';'); b := StrToFloat(v); end; v := string(Attributes.Value('gamma')); if (v <> '') then Editor.Lines.Add(' Gamma := ' + v + ';'); v := string(Attributes.Value('vibrancy')); if (v <> '') then Editor.Lines.Add(' Vibrancy := ' + v + ';'); v := string(Attributes.Value('contrast')); if (v <> '') then Editor.Lines.Add(' Contrast := ' + v + ';'); v := string(Attributes.Value('gamma_threshold')); if (v <> '') then begin if b <> 0 then b := StrToFloat(v) / b; Editor.Lines.Add(' GammaThreshold := ' + FloatToStr(b) + ';'); end; v := string(Attributes.Value('zoom')); if (v <> '') then Editor.Lines.Add(' Zoom := ' + v + ';'); v := string(Attributes.Value('scale')); if (v <> '') then Editor.Lines.Add(Format(' Scale := %.6g;', [StrToFloat(v) * f])); v := string(Attributes.Value('angle')); if (v <> '') then // Editor.Lines.Add(' Angle := ' + FloatToStr(StrToFloat(String(v))* 180 / PI) + '; '); Editor.Lines.Add(Format(' Angle := %.6g; // Flame rotation', [StrToFloat(v) * 180 / PI])); // 3d v := string(Attributes.Value('cam_pitch')); if (v <> '') then Editor.Lines.Add(Format(' Pitch := %.6g;', [StrToFloat(v) * 180 / PI])); v := string(Attributes.Value('cam_roll')); // AV if (v <> '') then Editor.Lines.Add(Format(' Roll := %.6g;', [StrToFloat(v) * 180 / PI])); v := string(Attributes.Value('cam_yaw')); if (v <> '') then Editor.Lines.Add(Format(' Yaw := %.6g;', [StrToFloat(v) * 180 / PI])); v :=string( Attributes.Value('cam_perspective')); if (v <> '') then Editor.Lines.Add(' Perspective := ' + v + ';'); v := string(Attributes.Value('cam_zpos')); if (v <> '') then Editor.Lines.Add(' Z := ' + v + ';'); v := string(Attributes.Value('cam_dof')); if (v <> '') then Editor.Lines.Add(' DOF := ' + v + ';'); try v := string(Attributes.Value('center')); if (v <> '') then begin GetTokens(v, tokens); Editor.Lines.Add(' X := ' + Tokens[0] + ';'); Editor.Lines.Add(' Y := ' + Tokens[1] + ';'); end; except Editor.Lines.Add(' X := 0;'); Editor.Lines.Add(' Y := 0;'); end; try v := string(Attributes.Value('background')); if (v <> '') then begin GetTokens(v, tokens); Editor.Lines.Add(Format(' Background[0] := %g; // red component', [Int(StrToFloat(Tokens[0]) * 255)])); Editor.Lines.Add(Format(' Background[1] := %g; // green component', [Int(StrToFloat(Tokens[1]) * 255)])); Editor.Lines.Add(Format(' Background[2] := %g; // blue component', [Int(StrToFloat(Tokens[2]) * 255)])); end; except Editor.Lines.Add(' Background[0] := 0; // red component'); Editor.Lines.Add(' Background[1] := 0; // green component'); Editor.Lines.Add(' Background[2] := 0; // blue component'); end; v := string(Attributes.Value('soloxform')); if (v <> '') then Editor.Lines.Add('SoloXform := ' + v + ';'); Editor.Lines.Add('end;'); end; finally Tokens.free; end; end; procedure TScriptEditor.LoadRunAndClear(scriptFile: string); begin LoadScriptFile(scriptFile); RunScript; btnNewClick(btnNew); end; end.