Apophysis-AV/Forms/Template.pas

357 lines
9.6 KiB
ObjectPascal
Raw Normal View History

2022-03-08 12:25:51 -05:00
{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021-2022 Alice V. Koryagina
2022-03-08 12:25:51 -05:00
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;
2022-03-08 12:25:51 -05:00
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;
2022-03-08 12:25:51 -05:00
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);
2022-03-08 12:25:51 -05:00
FindResult := FindNext(SearchRec);
end;
{ free memory }
FindClose(SearchRec);
end;
2022-03-08 12:25:51 -05:00
begin
LoadUserTemplates2('*.flame');
LoadUserTemplates2('*.template');
end;
(*
2022-03-08 12:25:51 -05:00
function BlankXML: string;
const
blankFlameXML1 = '<flame name="Blank Flame" version="Apophysis AV" size="1500 1000" center="0 0" background="0 0 0">';
blankFlameXML2 = '<xform weight="0.5" color="0" linear3D="1" coefs="1 0 0 1 0 0" />';
blankFlameXML3 = '<palette count="256" format="RGB">';
2022-03-08 12:25:51 -05:00
var
i: smallint;
2022-03-08 12:25:51 -05:00
s: string;
const
break = ' ';
begin
s := blankFlameXML1 + break + blankFlameXML2 + break + blankFlameXML3 + break;
for i := 1 to 256 do begin
s := s + '000000';
if (i mod 32 = 0) then s := s + break;
end;
s := s + '</palette></flame>';
Result := s;
end;
*)
2022-03-08 12:25:51 -05:00
procedure TTemplateForm.DropBlank;
2022-03-08 12:25:51 -05:00
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);
2022-03-08 12:25:51 -05:00
// 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;
2022-03-08 12:25:51 -05:00
bm.Free; // AV: fixed multiple memory leaks!
end;
{ Thumbnails}
ListItem := TemplateList.Items.Add;
ListItem.Caption := 'Blank Flame';
ListItem.ImageIndex := 0;
Files.Add('n/a');
2022-03-08 12:25:51 -05:00
//end preview
2022-03-08 12:25:51 -05:00
Application.ProcessMessages;
end;
procedure TTemplateForm.DropListItem(FileName: string; FlameName: string);
2022-03-08 12:25:51 -05:00
var
flameXML: string;
cp: TControlPoint;
bm: TBitmap;
Render: TRenderer;
ListItem: TListItem;
begin
cp := TControlPoint.Create;
Render := TRenderer.Create;
bm := TBitmap.Create;
//cp.Clear;
2022-03-08 12:25:51 -05:00
flameXML := LoadXMLFlameText(filename, FlameName);
MainForm.ParseXML(cp, flameXML, true); // AV: fixed - was PChar instead String
cp.AdjustScale(UsedThumbnails.Width, UsedThumbnails.Height);
2022-03-08 12:25:51 -05:00
// 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;
2022-03-08 12:25:51 -05:00
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);
2022-03-08 12:25:51 -05:00
//end preview
2022-03-08 12:25:51 -05:00
Application.ProcessMessages;
end;
procedure TTemplateForm.ListTemplateByFileName(filename:string);
2022-03-08 12:25:51 -05:00
{ 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('<flame ', Lowercase(FStrings.Text)) <> 0) then
begin
for i := 0 to FStrings.Count - 1 do
begin
p := Pos('<flame ', LowerCase(FStrings[i]));
if (p <> 0) then
begin
MainForm.ListXMLScanner.LoadFromBuffer(PAnsiChar(Utf8String(FStrings[i]))); // AV
2022-03-08 12:25:51 -05:00
MainForm.ListXMLScanner.Execute;
if Length(pname) = 0 then
Title := '*untitled ' + ptime
else
Title := Trim(pname);
if Title <> '' then // Otherwise bad format
2022-03-08 12:25:51 -05:00
DropListItem(FileName, Title);
end;
end;
end;
finally
FStrings.Free;
end;
end;
procedure TTemplateForm.ListTemplate;
2022-03-08 12:25:51 -05:00
begin
TemplateList.Items.BeginUpdate;
TemplateList.Items.Clear;
UsedThumbnails.Clear;
2022-03-08 12:25:51 -05:00
// AV: fixed - someone forgot to refresh the file list
Files.Clear;
2022-03-08 12:25:51 -05:00
DropBlank;
ListTemplateByFileName(AppPath + templateFileName);
LoadUserTemplates;
TemplateList.Items.EndUpdate;
TemplateList.Selected := TemplateList.Items[0];
2022-03-08 12:25:51 -05:00
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
2022-03-08 12:25:51 -05:00
begin
if (TemplateList.Selected = nil) then
btnOK.Enabled := false
else begin
i := TemplateList.Selected.Index;
if (i >= 0) then begin
2022-03-08 12:25:51 -05:00
btnOK.Enabled := true;
if (i > 0) then begin
fn := ChangeFileExt(ExtractFileName(Files[i]), '');
2022-03-08 12:25:51 -05:00
if (LowerCase(fn) <> 'apophysisav') then
lblFile.Caption := TextByKey('template-filename') + #32 + fn
2022-03-08 12:25:51 -05:00
else lblFile.Caption := '';
end else
2022-03-08 12:25:51 -05:00
lblFile.Caption := '';
end else
btnOK.Enabled := false;
end;
end;
procedure TTemplateForm.btnOKClick(Sender: TObject);
var
flameXML: string;
i: integer;
2022-03-08 12:25:51 -05:00
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;
2022-03-08 12:25:51 -05:00
MainForm.Statusbar.Panels[3].Text := MainCp.name;
{if ResizeOnLoad then}
MainForm.ResizeImage;
MainForm.RedrawTimer.Enabled := True;
if RandomizeTemplates then // AV
2022-03-08 12:25:51 -05:00
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;
2022-03-08 12:25:51 -05:00
end;
Application.ProcessMessages;
MainForm.UpdateWindows;
2022-03-08 12:25:51 -05:00
ModalResult := mrOK; // AV
end;
procedure TTemplateForm.FormShow(Sender: TObject);
begin
ListTemplate;
end;
end.