{ 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 Template; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ImgList, System.ImageList, ControlPoint, cmap, RenderingInterface, Main, Global, Adjust, Translation; type TTemplateForm = class(TForm) TemplateList: TListView; btnCancel: TButton; btnOK: TButton; UsedThumbnails: TImageList; lblFile: TLabel; procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TemplateListChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure btnOKClick(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } Files: TStringList; // AV: replaced "useless" hidded TListBox procedure ListTemplateByFileName(filename: string); procedure LoadUserTemplates; procedure DropBlank; procedure DropListItem(FileName: string; FlameName: string); procedure ListTemplate; public { Public declarations } end; var TemplateForm: TTemplateForm; implementation {$R *.dfm} procedure TTemplateForm.LoadUserTemplates; procedure LoadUserTemplates2(mask: string); var FindResult: integer; SearchRec : TSearchRec; Path : string; begin Path := AppPath + 'Templates\'; // AV FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec); while FindResult = 0 do begin ListTemplateByFileName(Path + SearchRec.Name); FindResult := FindNext(SearchRec); end; { free memory } FindClose(SearchRec); end; begin LoadUserTemplates2('*.flame'); LoadUserTemplates2('*.template'); end; (* function BlankXML: string; const blankFlameXML1 = ''; blankFlameXML2 = ''; blankFlameXML3 = ''; var i: smallint; s: string; const break = ' '; begin s := blankFlameXML1 + break + blankFlameXML2 + break + blankFlameXML3 + break; for i := 1 to 256 do begin s := s + '000000'; if (i mod 32 = 0) then s := s + break; end; s := s + ''; Result := s; end; *) procedure TTemplateForm.DropBlank; var cp: TControlPoint; bm: TBitmap; Render: TRenderer; ListItem: TListItem; begin cp := TControlPoint.Create; Render := TRenderer.Create; bm := TBitmap.Create; // AV: we don't need any parsing and cleaning here cp.xform[0].density := 0.5; // AV: that's all we need to create a new flame cp.cmap := MainCp.cmap; // AV: make black dots visible cp.pixels_per_unit := 5; // AV: decrease the scale cp.AdjustScale(UsedThumbnails.Width, UsedThumbnails.Height); // start preview //cp.spatial_oversample := 1; // <-- AV: true by default cp.spatial_filter_radius := 0.1; cp.sample_density := 3; try Render.SetCP(cp); Render.Render; BM.Assign(Render.GetImage); UsedThumbnails.Add(bm, nil); finally cp.Free; Render.free; bm.Free; // AV: fixed multiple memory leaks! end; { Thumbnails} ListItem := TemplateList.Items.Add; ListItem.Caption := 'Blank Flame'; ListItem.ImageIndex := 0; Files.Add('n/a'); //end preview Application.ProcessMessages; end; procedure TTemplateForm.DropListItem(FileName: string; FlameName: string); var flameXML: string; cp: TControlPoint; bm: TBitmap; Render: TRenderer; ListItem: TListItem; begin cp := TControlPoint.Create; Render := TRenderer.Create; bm := TBitmap.Create; //cp.Clear; flameXML := LoadXMLFlameText(filename, FlameName); MainForm.ParseXML(cp, flameXML, true); // AV: fixed - was PChar instead String cp.AdjustScale(UsedThumbnails.Width, UsedThumbnails.Height); // start preview //cp.spatial_oversample := 1; // <-- AV: true by default cp.spatial_filter_radius := 0.1; cp.sample_density := 3; try Render.SetCP(cp); Render.Render; BM.Assign(Render.GetImage); UsedThumbnails.Add(bm, nil); finally cp.Free; Render.free; bm.Free; // AV: fixed multiple memory leaks! end; { Thumbnails } ListItem := TemplateList.Items.Add; ListItem.Caption := FlameName; ListItem.ImageIndex := TemplateList.Items.Count - 1; Files.Add(FileName); //end preview Application.ProcessMessages; end; procedure TTemplateForm.ListTemplateByFileName(filename:string); { List .flame file } var i, p: integer; Title: string; FStrings: TStringList; begin if not FileExists(FileName) then exit; FStrings := TStringList.Create; FStrings.LoadFromFile(FileName); try if (Pos(' 0) then begin for i := 0 to FStrings.Count - 1 do begin p := Pos(' 0) then begin MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(FStrings[i]))); // AV MainForm.ListXMLScanner.Execute; if Length(pname) = 0 then Title := '*untitled ' + ptime else Title := Trim(pname); if Title <> '' then // Otherwise bad format DropListItem(FileName, Title); end; end; end; finally FStrings.Free; end; end; procedure TTemplateForm.ListTemplate; begin TemplateList.Items.BeginUpdate; TemplateList.Items.Clear; UsedThumbnails.Clear; // AV: fixed - someone forgot to refresh the file list Files.Clear; DropBlank; ListTemplateByFileName(AppPath + templateFileName); LoadUserTemplates; TemplateList.Items.EndUpdate; TemplateList.Selected := TemplateList.Items[0]; end; procedure TTemplateForm.FormCreate(Sender: TObject); begin self.Caption := TextByKey('template-title'); btnOK.Caption := TextByKey('common-ok'); btnCancel.Caption := TextByKey('common-cancel'); Files := TStringList.Create; // AV end; procedure TTemplateForm.FormDestroy(Sender: TObject); begin Files.Free; // AV end; procedure TTemplateForm.TemplateListChange(Sender: TObject; Item: TListItem; Change: TItemChange); var fn : string; i: integer; // AV begin if (TemplateList.Selected = nil) then btnOK.Enabled := false else begin i := TemplateList.Selected.Index; if (i >= 0) then begin btnOK.Enabled := true; if (i > 0) then begin fn := ChangeFileExt(ExtractFileName(Files[i]), ''); if (LowerCase(fn) <> 'apophysisav') then lblFile.Caption := TextByKey('template-filename') + #32 + fn else lblFile.Caption := ''; end else lblFile.Caption := ''; end else btnOK.Enabled := false; end; end; procedure TTemplateForm.btnOKClick(Sender: TObject); var flameXML: string; i: integer; begin MainForm.UpdateUndo; // MainForm.StopThread; // AV: this is already done in the Main unit i := TemplateList.Selected.Index; // AV if (i = 0) then // AV: we don't need to waste time to parse an empty flame begin with MainCp do begin // AV: make a blank flame easier! Clear; name := 'Blank Flame'; // AV: fixed a bug with black flames on the black background brightness := defBrightness; gamma := defGamma; gammaThreshRelative := defGammaThreshold; contrast := defContrast; vibrancy := defVibrancy; sample_density := defSampleDensity; { AV: 2D-camera resetting } center[0] := 0; center[1] := 0; zoom := 0; FAngle := 0; { AV: 3D-camera resetting } cameraPitch := 0; cameraYaw := 0; cameraRoll := 0; cameraPersp := 0; cameraZPos := 0; cameraDOF := 0; xform[0].density := 0.5; // AV: make the single xform visible xform[1].symmetry := 1; // AV: hide final xform CalcBoundBox; end; Transforms := 1; EnableFinalXform := false; end else begin flameXML := LoadXMLFlameText(Files[i], TemplateList.Selected.Caption); MainForm.ParseXML(MainCP, flameXML, false); Transforms := MainCp.TrianglesFromCP(MainTriangles); end; MainForm.Statusbar.Panels[3].Text := MainCp.name; {if ResizeOnLoad then} MainForm.ResizeImage; MainForm.RedrawTimer.Enabled := True; if RandomizeTemplates then // AV if (randGradient = 3) then // AV: only if user prefer new palettes AdjustForm.mnuRandomize.Click else begin // AV: use preset palette i := Random(NRCMAPS); GetCMap(i, 1, MainCp.cmap); MainCp.cmapIndex := i; end; Application.ProcessMessages; MainForm.UpdateWindows; ModalResult := mrOK; // AV end; procedure TTemplateForm.FormShow(Sender: TObject); begin ListTemplate; end; end.