Initial commit
This commit is contained in:
Alice Vital
226
Core/BaseVariation.pas
Normal file
226
Core/BaseVariation.pas
Normal file
@ -0,0 +1,226 @@
|
||||
{
|
||||
Apophysis Copyright (C) 2001-2004 Mark Townsend
|
||||
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
|
||||
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
|
||||
|
||||
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
|
||||
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
|
||||
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
|
||||
unit BaseVariation;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TCalcFunction = procedure of object;
|
||||
|
||||
type
|
||||
TBaseVariation = class
|
||||
|
||||
protected
|
||||
procedure CalcFunction; virtual; abstract;
|
||||
|
||||
public
|
||||
vvar: double;
|
||||
FTx, FTy: ^double;
|
||||
FPx, FPy: ^double;
|
||||
FTz, FPz: ^double;
|
||||
|
||||
// more params :)
|
||||
color : ^double;
|
||||
a, b, c, d, e, f : double;
|
||||
|
||||
class function GetName: string; virtual; abstract;
|
||||
class function GetInstance: TBaseVariation; virtual; abstract;
|
||||
|
||||
function GetNrVariables: integer; virtual;
|
||||
function GetVariableNameAt(const Index: integer): string; virtual;
|
||||
|
||||
function GetVariable(const Name: string; var Value: double): boolean; virtual;
|
||||
function SetVariable(const Name: string; var Value: double): boolean; virtual;
|
||||
function ResetVariable(const Name: string): boolean; virtual;
|
||||
|
||||
function GetVariableStr(const Name: string): string; virtual;
|
||||
function SetVariableStr(const Name: string; var strValue: string): boolean; virtual;
|
||||
|
||||
procedure Prepare; virtual;
|
||||
|
||||
procedure GetCalcFunction(var Delphi_Suxx: TCalcFunction); virtual;
|
||||
end;
|
||||
|
||||
TBaseVariationClass = class of TBaseVariation;
|
||||
|
||||
type
|
||||
TVariationLoader = class
|
||||
public
|
||||
Supports3D, SupportsDC : boolean;
|
||||
|
||||
function GetName: string; virtual; abstract;
|
||||
function GetInstance: TBaseVariation; virtual; abstract;
|
||||
function GetNrVariables: integer; virtual; abstract;
|
||||
function GetVariableNameAt(const Index: integer): string; virtual; abstract;
|
||||
end;
|
||||
|
||||
type
|
||||
TVariationClassLoader = class (TVariationLoader)
|
||||
public
|
||||
constructor Create(varClass : TBaseVariationClass);
|
||||
function GetName: string; override;
|
||||
function GetInstance: TBaseVariation; override;
|
||||
function GetNrVariables: integer; override;
|
||||
function GetVariableNameAt(const Index: integer): string; override;
|
||||
|
||||
private
|
||||
VariationClass : TBaseVariationClass;
|
||||
end;
|
||||
|
||||
const
|
||||
PI2 = 6.283185307179586476925286766559; // AV
|
||||
PI_2 = 1.5707963267948966192313216916398; // AV
|
||||
|
||||
function fmod(x, y: double) : double;
|
||||
procedure SinhCosh(const v: double; var sh, ch: double); // AV
|
||||
|
||||
implementation
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
function fmod(x, y: double) : double;
|
||||
begin
|
||||
Result := frac(x / y) * y;
|
||||
end;
|
||||
|
||||
procedure SinhCosh(const v: double; var sh, ch: double);
|
||||
// AV: calcs both hyperbolic sine and cosine
|
||||
var ep, en: double;
|
||||
begin
|
||||
ep := 0.5 * exp(v);
|
||||
en := 0.25 / ep; // 0.5 * exp(-v);
|
||||
sh := ep - en;
|
||||
ch := ep + en;
|
||||
end;
|
||||
|
||||
{ TBaseVariation }
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function TBaseVariation.GetNrVariables: integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function TBaseVariation.GetVariable(const Name: string; var value: double): boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TBaseVariation.SetVariable(const Name: string; var value: double): boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TBaseVariation.ResetVariable(const Name: string): boolean;
|
||||
var
|
||||
zero: double;
|
||||
begin
|
||||
zero := 0;
|
||||
Result := SetVariable(Name, zero);
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function TBaseVariation.GetVariableStr(const Name: string): string;
|
||||
var
|
||||
value: double;
|
||||
begin
|
||||
if GetVariable(Name, value) then
|
||||
Result := Format('%.6g', [value])
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TBaseVariation.SetVariableStr(const Name: string; var strValue: string): boolean;
|
||||
var
|
||||
v, oldv: double;
|
||||
begin
|
||||
if GetVariable(Name, oldv) then begin
|
||||
try
|
||||
v := StrToFloat(strValue);
|
||||
SetVariable(Name, v);
|
||||
except
|
||||
v := oldv;
|
||||
end;
|
||||
strValue := Format('%.6g', [v]);
|
||||
Result := true;
|
||||
end
|
||||
else Result := false;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function TBaseVariation.GetVariableNameAt(const Index: integer): string;
|
||||
begin
|
||||
Result := ''
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
procedure TBaseVariation.Prepare;
|
||||
begin
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
procedure TBaseVariation.GetCalcFunction(var Delphi_Suxx: TCalcFunction);
|
||||
begin
|
||||
Delphi_Suxx := CalcFunction; // -X- lol
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
{ TVariationClassLoader }
|
||||
|
||||
constructor TVariationClassLoader.Create(varClass : TBaseVariationClass);
|
||||
begin
|
||||
VariationClass := varClass;
|
||||
end;
|
||||
|
||||
function TVariationClassLoader.GetName: string;
|
||||
begin
|
||||
Result := VariationClass.GetName();
|
||||
end;
|
||||
|
||||
function TVariationClassLoader.GetInstance: TBaseVariation;
|
||||
begin
|
||||
Result := VariationClass.GetInstance();
|
||||
end;
|
||||
|
||||
function TVariationClassLoader.GetNrVariables: integer;
|
||||
var
|
||||
hack : TBaseVariation;
|
||||
begin
|
||||
hack := GetInstance();
|
||||
Result := hack.GetNrVariables();
|
||||
hack.Free();
|
||||
end;
|
||||
|
||||
function TVariationClassLoader.GetVariableNameAt(const Index: integer): string;
|
||||
var
|
||||
hack : TBaseVariation;
|
||||
begin
|
||||
hack := GetInstance();
|
||||
Result := hack.GetVariableNameAt(Index);
|
||||
hack.Free();
|
||||
end;
|
||||
|
||||
end.
|
||||
94
Core/Bezier.pas
Normal file
94
Core/Bezier.pas
Normal file
@ -0,0 +1,94 @@
|
||||
unit Bezier;
|
||||
|
||||
interface
|
||||
|
||||
uses Math;
|
||||
|
||||
|
||||
type
|
||||
BezierPoint = record
|
||||
x, y: double;
|
||||
end;
|
||||
BezierRect = record
|
||||
x0, y0, x1, y1: double;
|
||||
end;
|
||||
|
||||
BezierPoints = array [0..3] of BezierPoint;
|
||||
BezierWeights = array [0..3] of double;
|
||||
|
||||
procedure BezierCopy(src: BezierPoints; var tgt: BezierPoints);
|
||||
procedure BezierSetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
|
||||
procedure BezierUnsetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
|
||||
|
||||
procedure BezierSolve(t: double; src: BezierPoints; w: BezierWeights; var solution: BezierPoint);
|
||||
function BezierFunc(t: double; src: BezierPoints; w: BezierWeights): double;
|
||||
|
||||
implementation
|
||||
procedure BezierCopy(src: BezierPoints; var tgt: BezierPoints);
|
||||
var
|
||||
i, n: integer;
|
||||
begin
|
||||
n := Length(src);
|
||||
for i := 0 to n - 1 do
|
||||
tgt[i] := src[i];
|
||||
end;
|
||||
procedure BezierSetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
|
||||
var
|
||||
i, n: integer;
|
||||
f: double;
|
||||
begin
|
||||
n := Length(points);
|
||||
for i := 0 to n - 1 do
|
||||
begin
|
||||
if (flip) then f := 1 - points[i].y
|
||||
else f := points[i].y;
|
||||
|
||||
points[i].x := points[i].x * (rect.x1 - rect.x0) + rect.x0;
|
||||
points[i].y := f * (rect.y1 - rect.y0) + rect.y0;
|
||||
end;
|
||||
end;
|
||||
procedure BezierUnsetRect(var points: BezierPoints; flip: boolean; rect: BezierRect);
|
||||
var
|
||||
i, n: integer;
|
||||
f: double;
|
||||
begin
|
||||
if ((rect.x1 - rect.x0) = 0) or ((rect.y1 - rect.y0) = 0) then Exit;
|
||||
|
||||
n := Length(points);
|
||||
for i := 0 to n - 1 do
|
||||
begin
|
||||
points[i].x := (points[i].x - rect.x0) / (rect.x1 - rect.x0);
|
||||
points[i].y := (points[i].y - rect.y0) / (rect.y1 - rect.y0);
|
||||
|
||||
if (flip) then points[i].y := 1 - points[i].y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure BezierSolve(t: double; src: BezierPoints; w: BezierWeights; var solution: BezierPoint);
|
||||
var
|
||||
s, s2, s3, t2, t3, nom_x, nom_y, denom: double;
|
||||
begin
|
||||
s := 1 - t;
|
||||
s2 := s * s; s3 := s * s * s;
|
||||
t2 := t * t; t3 := t * t * t;
|
||||
|
||||
nom_x := w[0] * s3 * src[0].x + w[1] * s2 * 3 * t * src[1].x +
|
||||
w[2] * s * 3 * t2 * src[2].x + w[3] * t3 * src[3].x;
|
||||
nom_y := w[0] * s3 * src[0].y + w[1] * s2 * 3 * t * src[1].y +
|
||||
w[2] * s * 3 * t2 * src[2].y + w[3] * t3 * src[3].y;
|
||||
denom := w[0] * s3 + w[1] * s2 * 3 * t + w[2] * s * 3 * t2 + w[3] * t3;
|
||||
|
||||
if (IsNaN(nom_x)) or (IsNaN(nom_y)) or (IsNaN(denom)) then Exit;
|
||||
if denom = 0 then Exit;
|
||||
|
||||
solution.x := nom_x / denom;
|
||||
solution.y := nom_y / denom;
|
||||
end;
|
||||
function BezierFunc(t: double; src: BezierPoints; w: BezierWeights): double;
|
||||
var
|
||||
p: BezierPoint;
|
||||
begin
|
||||
BezierSolve(t, src, w, p);
|
||||
Result := p.y;
|
||||
end;
|
||||
end.
|
||||
300
Core/Chaotica.pas
Normal file
300
Core/Chaotica.pas
Normal file
@ -0,0 +1,300 @@
|
||||
unit Chaotica;
|
||||
|
||||
interface
|
||||
|
||||
uses Global, RegularExpressionsCore, RegexHelper, Classes, SysUtils, XFormMan, Windows,
|
||||
ShellAPI, Forms, ControlPoint, Translation;
|
||||
|
||||
function C_GetPathOf(filename: string; usex64: boolean): string;
|
||||
function C_SupportsDllPlugins(usex64: boolean): boolean;
|
||||
function C_IsDllPluginBlacklisted(filename: string; usex64: boolean): boolean;
|
||||
function C_IsVariationNative(name: string; usex64: boolean): boolean;
|
||||
function C_IsDllPluginInstalled(filename: string): boolean;
|
||||
|
||||
procedure C_SyncDllPlugins;
|
||||
procedure C_InstallVariation(name: string);
|
||||
procedure C_ExecuteChaotica(flamexml: string; plugins: TStringList; usex64: boolean);
|
||||
|
||||
implementation
|
||||
|
||||
uses Main;
|
||||
|
||||
(* // AV: rewrote and moved to Global unit
|
||||
function CheckX64: Boolean;
|
||||
var
|
||||
SEInfo: TShellExecuteInfo;
|
||||
ExitCode: DWORD;
|
||||
ExecuteFile, ParamString, StartInString: string;
|
||||
begin
|
||||
{$ifdef Apo7X64}
|
||||
Result := true;
|
||||
exit;
|
||||
{$endif}
|
||||
|
||||
ExecuteFile := ExtractFilePath(Application.ExeName) + 'chk64.exe';
|
||||
FillChar(SEInfo, SizeOf(SEInfo), 0);
|
||||
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
|
||||
|
||||
with SEInfo do begin
|
||||
fMask := SEE_MASK_NOCLOSEPROCESS;
|
||||
Wnd := Application.Handle;
|
||||
lpFile := PChar(ExecuteFile) ;
|
||||
nShow := SW_SHOWNORMAL;
|
||||
end;
|
||||
|
||||
if ShellExecuteEx(@SEInfo) then
|
||||
begin
|
||||
repeat
|
||||
Application.ProcessMessages;
|
||||
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
|
||||
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
|
||||
Result := (ExitCode = 0);
|
||||
end else begin
|
||||
Result := false;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
function C_GetPathOf(filename: string; usex64: boolean): string;
|
||||
begin
|
||||
Result := ChaoticaPath + '\' + filename;
|
||||
end;
|
||||
|
||||
function C_SupportsDllPlugins(usex64: boolean): boolean;
|
||||
const
|
||||
re_root : string = '<variation_compatibility\s+(.*?)>.*?</variation_compatibility>';
|
||||
re_attrib : string = 'supports_dll_plugins="(.*?)"';
|
||||
var
|
||||
xml_file : TStringList;
|
||||
xml_text, attrib, value : string;
|
||||
begin
|
||||
if usex64 then begin
|
||||
Result := false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
xml_file := TStringList.Create;
|
||||
// AV: for compatibility with new Chaotica versions
|
||||
if not FileExists(ChaoticaPath + '\variation_compatibility.xml') then
|
||||
begin
|
||||
xml_file.Add('<variation_compatibility >' + #13#10 + '</variation_compatibility>');
|
||||
xml_file.SaveToFile(ChaoticaPath + '\variation_compatibility.xml');
|
||||
xml_file.Clear;
|
||||
end;
|
||||
xml_file.LoadFromFile(C_GetPathOf('variation_compatibility.xml', false));
|
||||
xml_text := xml_file.Text;
|
||||
xml_file.Free;
|
||||
|
||||
attrib := GetStringPart(xml_text, re_root, 1, 'supports_dll_plugins="false"');
|
||||
value := GetStringPart(attrib, re_attrib, 1, 'false');
|
||||
|
||||
Result := (value = 'true');
|
||||
end;
|
||||
|
||||
function C_IsDllPluginBlacklisted(filename: string; usex64: boolean): boolean;
|
||||
var
|
||||
i: integer;
|
||||
blacklist: TStringList;
|
||||
begin
|
||||
blacklist := TStringList.Create;
|
||||
if not FileExists(ChaoticaPath + '\plugin_dll_blacklist.txt') then
|
||||
begin
|
||||
blacklist.Add('avMobius.dll');
|
||||
blacklist.Add('Cross.dll');
|
||||
blacklist.Add('Epispiral.dll');
|
||||
blacklist.Add('EpispiralVariationPlugin.dll');
|
||||
blacklist.Add('FlowerVariationPlugin.dll');
|
||||
blacklist.Add('Lissajous.dll');
|
||||
blacklist.Add('Mandelbrot.dll');
|
||||
blacklist.Add('ShapeVariationPlugin.dll');
|
||||
blacklist.Add('slinky.dll');
|
||||
blacklist.Add('Spirograph.dll');
|
||||
blacklist.Add('Square.dll');
|
||||
blacklist.Add('Stretchy Pants.dll');
|
||||
blacklist.Add('Waffle.dll');
|
||||
blacklist.SaveToFile(ChaoticaPath + '\plugin_dll_blacklist.txt');
|
||||
end;
|
||||
|
||||
blacklist.LoadFromFile(C_GetPathOf('plugin_dll_blacklist.txt', usex64));
|
||||
|
||||
for i := 0 to blacklist.Count - 1 do begin
|
||||
if LowerCase(filename) = LowerCase(blacklist.Strings[i]) then begin
|
||||
Result := true;
|
||||
blacklist.Free;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
blacklist.Free;
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
function C_IsVariationNative(name: string; usex64: boolean): boolean;
|
||||
const
|
||||
re_root : string = '<variation_compatibility.*?>(.*?)</variation_compatibility>';
|
||||
re_var : string = '<variation name="(.*?)".*?/>';
|
||||
var
|
||||
xml, var_name : string;
|
||||
xml_file : TStringList;
|
||||
find_var : TPerlRegEx;
|
||||
found_var : boolean;
|
||||
begin
|
||||
|
||||
xml_file := TStringList.Create;
|
||||
// AV: for compatibility with new Chaotica versions
|
||||
if not FileExists(ChaoticaPath + '\variation_compatibility.xml') then
|
||||
begin
|
||||
xml_file.Add('<variation_compatibility >' + #13#10 + '</variation_compatibility>');
|
||||
xml_file.SaveToFile(ChaoticaPath + '\variation_compatibility.xml');
|
||||
xml_file.Clear;
|
||||
end;
|
||||
xml_file.LoadFromFile(C_GetPathOf('variation_compatibility.xml', false));
|
||||
xml := xml_file.Text;
|
||||
xml_file.Free;
|
||||
|
||||
find_var := TPerlRegEx.Create;
|
||||
find_var.RegEx := re_var;
|
||||
find_var.Options := [preSingleLine, preCaseless];
|
||||
find_var.Subject := GetStringPart(xml, re_root, 1, '');
|
||||
found_var := find_var.Match;
|
||||
|
||||
while found_var do begin
|
||||
var_name := String(find_var.Groups[1]);
|
||||
found_var := find_var.MatchAgain;
|
||||
|
||||
if LowerCase(name) = var_name then begin
|
||||
find_var.Destroy;
|
||||
Result := true;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
find_var.Destroy;
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
function C_IsDllPluginInstalled(filename: string): boolean;
|
||||
var
|
||||
path : string;
|
||||
begin
|
||||
path := C_GetPathOf('plugins\' + filename, false);
|
||||
Result := FileExists(path);
|
||||
end;
|
||||
|
||||
////////////////////////////////////////////////////////////////////
|
||||
|
||||
procedure C_InstallVariation(name: string);
|
||||
var
|
||||
filename: string;
|
||||
begin
|
||||
filename := GetFileNameOfVariation(name);
|
||||
|
||||
if (filename = '') then Exit;
|
||||
if C_IsDllPluginInstalled(filename) then Exit;
|
||||
|
||||
CopyFile(PCHAR(filename), PCHAR(C_GetPathOf('plugins\' +
|
||||
ExtractFileName(filename), false)), false);
|
||||
end;
|
||||
|
||||
procedure C_SyncDllPlugins;
|
||||
var
|
||||
src_dir: string;
|
||||
tgt_dir: string;
|
||||
|
||||
searchResult: TSearchRec;
|
||||
begin
|
||||
src_dir := PluginPath;
|
||||
tgt_dir := C_GetPathOf('Plugins', false);
|
||||
|
||||
if (not DirectoryExists(src_dir)) then Exit;
|
||||
if (not DirectoryExists(tgt_dir)) then Exit;
|
||||
//CreateDir(ChaoticaPath + '\Plugins');
|
||||
|
||||
// First clear all plugins on Chaotica side
|
||||
if FindFirst(tgt_dir + '\*.dll', faAnyFile, searchResult) = 0 then
|
||||
begin
|
||||
repeat
|
||||
DeleteFile(PCHAR(tgt_dir + '\' + searchResult.Name)) ;
|
||||
until (FindNext(searchResult) <> 0);
|
||||
SysUtils.FindClose(searchResult);
|
||||
end;
|
||||
|
||||
// Then copy all plugins from Apophysis to Chaotica
|
||||
if FindFirst(src_dir + '*.dll', faAnyFile, searchResult) = 0 then
|
||||
begin
|
||||
repeat
|
||||
if not C_IsDllPluginBlacklisted(searchResult.Name, false)
|
||||
then CopyFile(
|
||||
PCHAR(src_dir + '\' + searchResult.Name),
|
||||
PCHAR(tgt_dir + '\' + searchResult.Name),
|
||||
false);
|
||||
until (FindNext(searchResult) <> 0);
|
||||
SysUtils.FindClose(searchResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure C_ExecuteChaotica(flamexml: string; plugins: TStringList; usex64: boolean);
|
||||
var
|
||||
i: integer;
|
||||
name, fname: string;
|
||||
fails: TStringList;
|
||||
txt: TStringList;
|
||||
fin_usex64: boolean;
|
||||
begin
|
||||
fails := TStringList.Create;
|
||||
|
||||
{$ifdef Apo7X64}
|
||||
fin_usex64 := true;
|
||||
{$else}
|
||||
fin_usex64 := usex64 and CheckX64; // currently useless...
|
||||
for i := 0 to plugins.Count - 1 do begin
|
||||
name := GetFileNameOfVariation(plugins.Strings[i]);
|
||||
if (name = '') then name := plugins.Strings[i];
|
||||
fin_usex64 := fin_usex64 and C_IsVariationNative(name, usex64);
|
||||
end;
|
||||
|
||||
for i := 0 to plugins.Count - 1 do begin
|
||||
name := GetFileNameOfVariation(plugins.Strings[i]);
|
||||
if (name = '') then name := plugins.Strings[i]; // assume built-in
|
||||
|
||||
if not C_IsVariationNative(name, fin_usex64) then begin // not native -> try install
|
||||
if C_SupportsDllPlugins(fin_usex64) then // dll unsupported -> fail
|
||||
fails.Add(plugins.Strings[i])
|
||||
else if C_IsDllPluginBlacklisted(name, fin_usex64) then // dll supported and blacklisted -> fail
|
||||
fails.Add(plugins.Strings[i]);
|
||||
//else C_InstallVariation(plugins.Strings[i]); // dll supported and not blacklisted -> install
|
||||
// ^^^ this is done on Apophysis startup now!
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
name := C_GetPathOf('chaotica.exe', fin_usex64);
|
||||
if (not FileExists(name)) then begin
|
||||
messagebox(0, PCHAR(TextByKey('main-status-nochaotica')),
|
||||
PCHAR('Apophysis AV'), MB_ICONHAND);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (fails.Count > 0) then begin
|
||||
messagebox(0, PCHAR(TextByKey('main-status-oldchaotica')),
|
||||
PCHAR('Apophysis AV'), MB_ICONHAND or MB_OK);
|
||||
end;
|
||||
|
||||
// TODO: add directory cleaning
|
||||
fname := GetEnvironmentVariable('TEMP') + '\chaotica_export.flame';
|
||||
txt := TStringList.Create;
|
||||
|
||||
txt.Text := flamexml;
|
||||
txt.SaveToFile(fname);
|
||||
|
||||
txt.Free;
|
||||
fails.Free;
|
||||
|
||||
//if fin_usex64 then MessageBox(0, PCHAR('DBG:x64'), PCHAR(''), MB_OK)
|
||||
//else MessageBox(0, PCHAR('DBG:x86'), PCHAR(''), MB_OK) ;
|
||||
|
||||
ShellExecute(application.handle, PChar('open'), pchar(name),
|
||||
PChar('"' + fname + '"'), PChar(ExtractFilePath(name)), SW_SHOWNORMAL);
|
||||
end;
|
||||
|
||||
end.
|
||||
764
Core/Global.pas
Normal file
764
Core/Global.pas
Normal file
@ -0,0 +1,764 @@
|
||||
{
|
||||
Apophysis Copyright (C) 2001-2004 Mark Townsend
|
||||
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
|
||||
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
|
||||
|
||||
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
|
||||
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
|
||||
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
|
||||
unit Global;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, SysUtils, Classes, SyncObjs, Controls, Graphics, Math,
|
||||
cmap, ControlPoint, Xform, CommDlg;
|
||||
|
||||
type
|
||||
EFormatInvalid = class(Exception);
|
||||
// AV: chanded the name to avoid conflicts with XForm
|
||||
TMatrix2 = array[0..1, 0..1] of double;
|
||||
|
||||
{ Weight manipulation }
|
||||
{ Triangle transformations }
|
||||
function triangle_area(t: TTriangle): double;
|
||||
function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean;
|
||||
function line_dist(x, y, x1, y1, x2, y2: double): double;
|
||||
function dist(x1, y1, x2, y2: double): double;
|
||||
procedure MultMatrix(var s: TMatrix2; const m: TMatrix2);
|
||||
{ Parsing functions }
|
||||
function GetVal(token: string): string;
|
||||
function ReplaceTabs(str: string): string;
|
||||
{ Palette and gradient functions }
|
||||
//function GetGradient(FileName, Entry: string): string;
|
||||
{ Misc }
|
||||
function det(a, b, c, d: double): double;
|
||||
function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double;
|
||||
var a, b, e: double): double;
|
||||
function OpenSaveFileDialog(Parent: TWinControl;
|
||||
const DefExt,
|
||||
Filter,
|
||||
InitialDir,
|
||||
Title: string;
|
||||
var FileName: string;
|
||||
MustExist,
|
||||
OverwritePrompt,
|
||||
NoChangeDir,
|
||||
DoOpen: Boolean): Boolean;
|
||||
procedure LoadThumbnailPlaceholder(ThumbnailSize : integer);
|
||||
function GetEnvVarValue(const VarName: string): string;
|
||||
function Round6(x: double): double;
|
||||
function MiddleColor(const clOne, clTwo: TColor): TColor; // AV
|
||||
function CheckX64: Boolean; // AV
|
||||
|
||||
const
|
||||
APP_NAME: string = 'Apophysis AV';
|
||||
APP_VERSION: string = 'Phoenix Edition';
|
||||
{$ifdef Apo7X64}
|
||||
APP_BUILD: string = ' - 64 bit';
|
||||
{$else}
|
||||
APP_BUILD: string = ' - 32 bit';
|
||||
{$endif}
|
||||
MAX_TRANSFORMS: integer = 100;
|
||||
prefilter_white: integer = 1024;
|
||||
eps: double = 1E-10;
|
||||
White_level = 200;
|
||||
FT_BMP = 1; FT_PNG = 2; FT_JPG = 3;
|
||||
|
||||
//clyellow1 = TColor($17FCFF);
|
||||
//clplum2 = TColor($ECA9E6);
|
||||
//clSlateGray = TColor($837365);
|
||||
const
|
||||
crEditArrow = 20;
|
||||
crEditMove = 21;
|
||||
crEditRotate = 22;
|
||||
crEditScale = 23;
|
||||
|
||||
const
|
||||
SingleBuffer : boolean =
|
||||
{$ifdef Apo7X64}
|
||||
false
|
||||
{$else}
|
||||
true
|
||||
{$endif};
|
||||
|
||||
var
|
||||
MainSeed: integer;
|
||||
MainTriangles: TTriangles; // ControlPoint.TTriangles;
|
||||
Transforms: integer; // Count of Tranforms
|
||||
EnableFinalXform: boolean;
|
||||
AppPath: string; // Path of application file
|
||||
OpenFile: string; // Name of currently open file
|
||||
CanDrawOnResize: boolean;
|
||||
PreserveWeights: boolean;
|
||||
AlwaysCreateBlankFlame : boolean;
|
||||
// StartupCheckForUpdates : boolean;
|
||||
TBWidth1 : integer;
|
||||
TBWidth2 : integer;
|
||||
TBWidth3 : integer;
|
||||
TBWidth4 : integer;
|
||||
TBWidth5 : integer;
|
||||
ThumbnailPlaceholder : TBitmap;
|
||||
WarnOnMissingPlugin : boolean;
|
||||
EmbedThumbnails : boolean;
|
||||
RandomizeTemplates: boolean;
|
||||
LanguageFile : string;
|
||||
AvailableLanguages : TStringList;
|
||||
PluginPath : string;
|
||||
|
||||
// AV: GUI Theme Stuff
|
||||
CurrentStyle: string;
|
||||
// theme-aware system colors
|
||||
WinColor, BrightColor, MidColor, TextColor: TColor;
|
||||
IsDarkTheme, IsLightMenu: boolean;
|
||||
|
||||
{ UPR Options }
|
||||
|
||||
UPRSampleDensity: integer;
|
||||
UPRFilterRadius: double;
|
||||
UPROversample: integer;
|
||||
UPRAdjustDensity: boolean;
|
||||
UPRColoringIdent: string;
|
||||
UPRColoringFile: string;
|
||||
UPRFormulaIdent: string;
|
||||
UPRFormulaFile: string;
|
||||
UPRWidth: Integer;
|
||||
UPRHeight: Integer;
|
||||
ImageFolder: string;
|
||||
UPRPath: string; // Name and folder of last UPR file
|
||||
cmap_index: integer; // Index to current gradient
|
||||
Variation: TVariation; // Current variation // ControlPoint.TVariation;
|
||||
NumTries, TryLength: integer; // Settings for smooth palette
|
||||
SmoothPaletteFile: string;
|
||||
|
||||
{ Editor }
|
||||
|
||||
UseFlameBackground, UseTransformColors: boolean;
|
||||
HelpersEnabled: boolean;
|
||||
EditorBkgColor, ReferenceTriangleColor: integer;
|
||||
GridColor1, GridColor2, HelpersColor, FlipColor: integer;
|
||||
ExtEditEnabled, TransformAxisLock, RebuildXaosLinks: boolean;
|
||||
ShowAllXforms: boolean;
|
||||
EditorPreviewTransparency: integer;
|
||||
EnableEditorPreview: boolean;
|
||||
AllowResetCoefs, AllowResetLinear: boolean; // AV
|
||||
|
||||
{ Display }
|
||||
|
||||
defSampleDensity, defPreviewDensity: Double;
|
||||
defGamma, defBrightness, defVibrancy, defContrast, // AV
|
||||
defFilterRadius, defGammaThreshold: Double;
|
||||
defOversample: integer;
|
||||
FUSE: byte; // AV: moved from ControlPoint and changed to variable
|
||||
RhombTR, SquareTR, HexTR: single; // AV: tile radii
|
||||
|
||||
{ Render }
|
||||
|
||||
renderDensity, renderFilterRadius: double;
|
||||
renderOversample, renderWidth, renderHeight: integer;
|
||||
// renderBitsPerSample: integer;
|
||||
renderPath: string;
|
||||
JPEGQuality: integer;
|
||||
renderFileFormat: integer;
|
||||
InternalBitsPerSample: integer;
|
||||
EmbedFlame, SaveInFlame: boolean; // AV
|
||||
|
||||
NrTreads: Integer;
|
||||
UseNrThreads: byte; // AV: currently holds Nr CPU cores
|
||||
|
||||
PNGTransparency: integer;
|
||||
ShowTransparency: boolean;
|
||||
|
||||
MainPreviewScale: double;
|
||||
ExtendMainPreview: boolean;
|
||||
|
||||
(*
|
||||
StoreEXIF : boolean;
|
||||
StoreParamsEXIF : boolean;
|
||||
ExifAuthor : string;
|
||||
*)
|
||||
|
||||
{ Defaults }
|
||||
|
||||
LastOpenFile: string;
|
||||
LastOpenFileEntry: integer;
|
||||
RememberLastOpenFile: boolean;
|
||||
UseSmallThumbnails: boolean;
|
||||
ClassicListMode: boolean;
|
||||
ConfirmDelete: boolean; // Flag confirmation of entry deletion
|
||||
OldPaletteFormat: boolean;
|
||||
ConfirmExit: boolean;
|
||||
ConfirmStopRender: boolean;
|
||||
ConfirmClearScript: boolean;
|
||||
SavePath, SmoothPalettePath: string;
|
||||
RandomPrefix, RandomDate: string;
|
||||
RandomIndex: integer;
|
||||
FlameFile, GradientFile, GradientEntry, FlameEntry: string;
|
||||
ParamFolder: string;
|
||||
prevLowQuality, prevMediumQuality, prevHighQuality: double;
|
||||
defSmoothPaletteFile: string;
|
||||
BrowserPath: string; // Stored path of browser open dialog
|
||||
EditPrevQual, MutatePrevQual, AdjustPrevQual: byte; // Integer;
|
||||
ThumbPrevQual: byte; // AV
|
||||
randMinTransforms, randMaxTransforms: integer;
|
||||
mutantMinTransforms, mutantMaxTransforms: integer;
|
||||
KeepBackground: boolean;
|
||||
RandBackColor: integer; // AV
|
||||
randGradient: Integer;
|
||||
randGradientFile: string;
|
||||
randColorBlend: byte; // AV
|
||||
EqualStripes: boolean;
|
||||
defFlameFile: string;
|
||||
defScriptFile: string; // AV
|
||||
SetEngLayout: boolean; // AV
|
||||
ScreenShotPath: string; // AV
|
||||
AutoSaveXML, ApplyFlatten: boolean; // AV
|
||||
|
||||
PlaySoundOnRenderComplete: boolean;
|
||||
RenderCompleteSoundFile: string;
|
||||
|
||||
SaveIncompleteRenders: boolean;
|
||||
ShowRenderStats, ShowRenderImage: boolean;
|
||||
LowerRenderPriority: boolean;
|
||||
|
||||
SymmetryType: integer;
|
||||
SymmetryOrder: integer;
|
||||
SymmetryNVars: integer;
|
||||
Variations: array of boolean;
|
||||
FavouriteVariations: array of boolean;
|
||||
|
||||
MainForm_RotationMode: byte; // integer;
|
||||
PreserveQuality: boolean;
|
||||
FlameEnumMode: byte; // AV
|
||||
|
||||
{ For random gradients }
|
||||
|
||||
MinNodes, MaxNodes, MinHue, MaxHue, MinSat, MaxSat, MinLum, MaxLum: integer;
|
||||
//ReferenceMode: integer;
|
||||
BatchSize: Integer;
|
||||
// Compatibility: integer; //0 = original, 1 = Drave's
|
||||
Favorites: TStringList;
|
||||
Script: string;
|
||||
ScriptPath: string;
|
||||
// SheepServer, SheepNick, SheepURL, SheepPW,
|
||||
flam3Path, helpPath: string;
|
||||
ExportBatches, ExportOversample, ExportWidth, ExportHeight, ExportFileFormat: Integer;
|
||||
ExportFilter, ExportDensity: Double;
|
||||
ExportEstimator, ExportEstimatorMin, ExportEstimatorCurve: double;
|
||||
ExportJitters: integer;
|
||||
ExportGammaTreshold: double;
|
||||
OpenFileType: TFileType;
|
||||
// ResizeOnLoad: Boolean;
|
||||
ShowProgress: Boolean;
|
||||
defLibrary: string;
|
||||
LimitVibrancy: Boolean;
|
||||
DefaultPalette: TColorMap;
|
||||
|
||||
ChaoticaPath: string;
|
||||
UseX64IfPossible: boolean;
|
||||
|
||||
AutoOpenLog: Boolean;
|
||||
AutoSaveEnabled: Boolean;
|
||||
AutoSaveFreq: integer;
|
||||
AutoSavePath: string;
|
||||
|
||||
LineCenterColor : integer;
|
||||
LineThirdsColor : integer;
|
||||
LineGRColor : integer;
|
||||
EnableGuides : boolean;
|
||||
|
||||
implementation
|
||||
|
||||
function GetEnvVarValue(const VarName: string): string;
|
||||
var
|
||||
BufSize: Integer; // buffer size required for value
|
||||
begin
|
||||
// Get required buffer size (inc. terminal #0)
|
||||
BufSize := GetEnvironmentVariable(
|
||||
PChar(VarName), nil, 0);
|
||||
if BufSize > 0 then
|
||||
begin
|
||||
// Read env var value into result string
|
||||
SetLength(Result, BufSize - 1);
|
||||
GetEnvironmentVariable(PChar(VarName),
|
||||
PChar(Result), BufSize);
|
||||
end
|
||||
else
|
||||
// No such environment variable
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure LoadThumbnailPlaceholder(ThumbnailSize : integer);
|
||||
var
|
||||
placeholderIcon: TBitmap;
|
||||
const
|
||||
pi_width = 48;
|
||||
pi_height = 48;
|
||||
begin
|
||||
placeholderIcon := TBitmap.Create;
|
||||
placeholderIcon.Handle := LoadBitmap(hInstance, 'THUMB_PLACEHOLDER');
|
||||
// AV: replaced a local variable by the global one
|
||||
ThumbnailPlaceholder.PixelFormat := pf32bit;
|
||||
ThumbnailPlaceholder.HandleType := bmDIB;
|
||||
ThumbnailPlaceholder.Width := ThumbnailSize;
|
||||
ThumbnailPlaceholder.Height := ThumbnailSize;
|
||||
|
||||
with ThumbnailPlaceholder.Canvas do begin
|
||||
Brush.Color := $000000;
|
||||
FillRect(Rect(0, 0, ThumbnailPlaceholder.Width, ThumbnailPlaceholder.Height));
|
||||
Draw(round(ThumbnailSize / 2 - pi_width / 2), round(ThumbnailSize / 2 - pi_height / 2), placeholderIcon);
|
||||
end;
|
||||
|
||||
placeholderIcon.Free;
|
||||
end;
|
||||
|
||||
function MiddleColor(const clOne, clTwo: TColor): TColor; // AV
|
||||
begin
|
||||
Result := (((clOne and $ff) + (clTwo and $ff)) shr 1 ) +
|
||||
((((clOne shr 8) and $ff) + ((clTwo shr 8) and $ff)) shr 1 ) shl 8 +
|
||||
((((clOne shr 16) and $ff) + ((clTwo shr 16) and $ff)) shr 1 ) shl 16;
|
||||
end;
|
||||
|
||||
{ IFS }
|
||||
|
||||
function det(a, b, c, d: double): double;
|
||||
begin
|
||||
Result := (a * d - b * c);
|
||||
end;
|
||||
|
||||
function Round6(x: double): double;
|
||||
// Really ugly, but it works
|
||||
begin
|
||||
// --Z-- this is ridiculous:
|
||||
// Result := StrToFloat(Format('%.6f', [x]));
|
||||
// and yes, this is REALLY ugly :-\
|
||||
Result := RoundTo(x, -6);
|
||||
end;
|
||||
|
||||
procedure MultMatrix(var s: TMatrix2; const m: TMatrix2); // AV: moved from Main
|
||||
var
|
||||
a, b, c, d, e, f, g, h: double;
|
||||
begin
|
||||
a := s[0, 0];
|
||||
b := s[0, 1];
|
||||
c := s[1, 0];
|
||||
d := s[1, 1];
|
||||
e := m[0, 0];
|
||||
f := m[0, 1];
|
||||
g := m[1, 0];
|
||||
h := m[1, 1];
|
||||
{
|
||||
[a, b][e ,f] [a*e+b*g, a*f+b*h]
|
||||
[ ][ ] = [ ]
|
||||
[c, d][g, h] [c*e+d*g, c*f+d*h]
|
||||
}
|
||||
s[0, 0] := a * e + b * g;
|
||||
s[0, 1] := a * f + b * h;
|
||||
s[1, 0] := c * e + d * g;
|
||||
s[1, 1] := c * f + d * h;
|
||||
end;
|
||||
|
||||
function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double;
|
||||
var a, b, e: double): double;
|
||||
var
|
||||
det1: double;
|
||||
begin
|
||||
det1 := x1 * det(y2, 1.0, z2, 1.0) - x2 * det(y1, 1.0, z1, 1.0)
|
||||
+ 1 * det(y1, y2, z1, z2);
|
||||
if (det1 = 0.0) then
|
||||
begin
|
||||
Result := det1;
|
||||
EXIT;
|
||||
end
|
||||
else
|
||||
begin
|
||||
a := (x1h * det(y2, 1.0, z2, 1.0) - x2 * det(y1h, 1.0, z1h, 1.0)
|
||||
+ 1 * det(y1h, y2, z1h, z2)) / det1;
|
||||
b := (x1 * det(y1h, 1.0, z1h, 1.0) - x1h * det(y1, 1.0, z1, 1.0)
|
||||
+ 1 * det(y1, y1h, z1, z1h)) / det1;
|
||||
e := (x1 * det(y2, y1h, z2, z1h) - x2 * det(y1, y1h, z1, z1h)
|
||||
+ x1h * det(y1, y2, z1, z2)) / det1;
|
||||
a := Round6(a);
|
||||
b := Round6(b);
|
||||
e := Round6(e);
|
||||
Result := det1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function dist(x1, y1, x2, y2: double): double;
|
||||
//var
|
||||
// d2: double;
|
||||
begin
|
||||
(*
|
||||
{ From FDesign source
|
||||
{ float pt_pt_distance(float x1, float y1, float x2, float y2) }
|
||||
d2 := (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2);
|
||||
if (d2 = 0.0) then
|
||||
begin
|
||||
Result := 0.0;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
Result := sqrt(d2);
|
||||
*)
|
||||
|
||||
// --Z-- This is just amazing... :-\
|
||||
// Someone needed an 'FDesign source' - to compute distance between two points??!?
|
||||
|
||||
Result := Hypot(x2-x1, y2-y1);
|
||||
end;
|
||||
|
||||
function line_dist(x, y, x1, y1, x2, y2: double): double;
|
||||
var
|
||||
a, b, e, c: double;
|
||||
begin
|
||||
if ((x = x1) and (y = y1)) then
|
||||
a := 0.0
|
||||
else
|
||||
a := sqrt((x - x1) * (x - x1) + (y - y1) * (y - y1));
|
||||
if ((x = x2) and (y = y2)) then
|
||||
b := 0.0
|
||||
else
|
||||
b := sqrt((x - x2) * (x - x2) + (y - y2) * (y - y2));
|
||||
if ((x1 = x2) and (y1 = y2)) then
|
||||
e := 0.0
|
||||
else
|
||||
e := sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2));
|
||||
if ((a * a + e * e) < (b * b)) then
|
||||
Result := a
|
||||
else if ((b * b + e * e) < (a * a)) then
|
||||
Result := b
|
||||
else if (e <> 0.0) then
|
||||
begin
|
||||
c := (b * b - a * a - e * e) / (-2 * e);
|
||||
if ((a * a - c * c) < 0.0) then
|
||||
Result := 0.0
|
||||
else
|
||||
Result := sqrt(a * a - c * c);
|
||||
end
|
||||
else
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean;
|
||||
var
|
||||
ra, rb, rc, a, b, c: double;
|
||||
begin
|
||||
Result := True;
|
||||
ra := dist(Triangles[-1].y[0], Triangles[-1].x[0],
|
||||
Triangles[-1].y[1], Triangles[-1].x[1]);
|
||||
rb := dist(Triangles[-1].y[1], Triangles[-1].x[1],
|
||||
Triangles[-1].y[2], Triangles[-1].x[2]);
|
||||
rc := dist(Triangles[-1].y[2], Triangles[-1].x[2],
|
||||
Triangles[-1].y[0], Triangles[-1].x[0]);
|
||||
a := dist(t.y[0], t.x[0], t.y[1], t.x[1]);
|
||||
b := dist(t.y[1], t.x[1], t.y[2], t.x[2]);
|
||||
c := dist(t.y[2], t.x[2], t.y[0], t.x[0]);
|
||||
if (a > ra) then
|
||||
Result := False
|
||||
else if (b > rb) then
|
||||
Result := False
|
||||
else if (c > rc) then
|
||||
Result := False
|
||||
else if ((a = ra) and (b = rb) and (c = rc)) then
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function triangle_area(t: TTriangle): double;
|
||||
var
|
||||
base, height: double;
|
||||
begin
|
||||
try
|
||||
base := dist(t.x[0], t.y[0], t.x[1], t.y[1]);
|
||||
height := line_dist(t.x[2], t.y[2], t.x[1], t.y[1],
|
||||
t.x[0], t.y[0]);
|
||||
if (base < 1.0) then
|
||||
Result := height
|
||||
else if (height < 1.0) then
|
||||
Result := base
|
||||
else
|
||||
Result := 0.5 * base * height;
|
||||
except on E: EMathError do
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Parse }
|
||||
|
||||
function GetVal(token: string): string;
|
||||
var
|
||||
p: integer;
|
||||
begin
|
||||
p := Pos('=', token);
|
||||
Delete(Token, 1, p);
|
||||
Result := Token;
|
||||
end;
|
||||
|
||||
function ReplaceTabs(str: string): string;
|
||||
{Changes tab characters in a string to spaces}
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 1 to Length(str) do
|
||||
begin
|
||||
if str[i] = #9 then
|
||||
begin
|
||||
Delete(str, i, 1);
|
||||
Insert(#32, str, i);
|
||||
end;
|
||||
end;
|
||||
Result := str;
|
||||
end;
|
||||
|
||||
(*
|
||||
{ Palette and gradient functions }
|
||||
|
||||
function RGBToColor(Pal: TMapPalette; index: integer): Tcolor;
|
||||
begin
|
||||
{ Converts the RGB values from a palette index to the TColor type ...
|
||||
could maybe change it to SHLs }
|
||||
Result := (Pal.Blue[index] * 65536) + (Pal.Green[index] * 256)
|
||||
+ Pal.Red[index];
|
||||
end;
|
||||
|
||||
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
|
||||
var
|
||||
maxval, minval: double;
|
||||
del: double;
|
||||
begin
|
||||
Maxval := Max(rgb[0], Max(rgb[1], rgb[2]));
|
||||
Minval := Min(rgb[0], Min(rgb[1], rgb[2]));
|
||||
|
||||
hsv[2] := maxval; // v
|
||||
|
||||
if (Maxval > 0) and (maxval <> minval) then begin
|
||||
del := maxval - minval;
|
||||
hsv[1] := del / Maxval; //s
|
||||
|
||||
hsv[0] := 0;
|
||||
if (rgb[0] > rgb[1]) and (rgb[0] > rgb[2]) then begin
|
||||
hsv[0] := (rgb[1] - rgb[2]) / del;
|
||||
end else if (rgb[1] > rgb[2]) then begin
|
||||
hsv[0] := 2 + (rgb[2] - rgb[0]) / del;
|
||||
end else begin
|
||||
hsv[0] := 4 + (rgb[0] - rgb[1]) / del;
|
||||
end;
|
||||
|
||||
if hsv[0] < 0 then
|
||||
hsv[0] := hsv[0] + 6;
|
||||
|
||||
end else begin
|
||||
hsv[0] := 0;
|
||||
hsv[1] := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure hsv2rgb(const hsv: array of double; out rgb: array of double);
|
||||
var
|
||||
j: integer;
|
||||
f, p, q, t, v: double;
|
||||
begin
|
||||
j := floor(hsv[0]);
|
||||
f := hsv[0] - j;
|
||||
v := hsv[2];
|
||||
p := hsv[2] * (1 - hsv[1]);
|
||||
q := hsv[2] * (1 - hsv[1] * f);
|
||||
t := hsv[2] * (1 - hsv[1] * (1 - f));
|
||||
|
||||
case j of
|
||||
0: begin rgb[0] := v; rgb[1] := t; rgb[2] := p; end;
|
||||
1: begin rgb[0] := q; rgb[1] := v; rgb[2] := p; end;
|
||||
2: begin rgb[0] := p; rgb[1] := v; rgb[2] := t; end;
|
||||
3: begin rgb[0] := p; rgb[1] := q; rgb[2] := v; end;
|
||||
4: begin rgb[0] := t; rgb[1] := p; rgb[2] := v; end;
|
||||
5: begin rgb[0] := v; rgb[1] := p; rgb[2] := t; end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetGradient(FileName, Entry: string): string;
|
||||
var
|
||||
FileStrings: TStringList;
|
||||
GradStrings: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
FileStrings := TStringList.Create;
|
||||
GradStrings := TStringList.Create;
|
||||
try
|
||||
try
|
||||
FileStrings.LoadFromFile(FileName);
|
||||
for i := 0 to FileStrings.count - 1 do
|
||||
if Pos(Entry + ' ', Trim(FileStrings[i])) = 1 then break;
|
||||
GradStrings.Add(FileStrings[i]);
|
||||
repeat
|
||||
inc(i);
|
||||
GradStrings.Add(FileStrings[i]);
|
||||
until Pos('}', FileStrings[i]) <> 0;
|
||||
GetGradient := GradStrings.Text;
|
||||
except on exception do
|
||||
Result := '';
|
||||
end;
|
||||
finally
|
||||
GradStrings.Free;
|
||||
FileStrings.Free;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
function CheckX64: Boolean; // AV
|
||||
var
|
||||
IsWow64Process:
|
||||
function(hProcess: THandle; out Wow64Process: boolean): boolean; stdcall;
|
||||
Wow64Process: boolean;
|
||||
begin
|
||||
IsWow64Process := GetProcAddress(GetModuleHandle('kernel32.dll'), 'IsWow64Process');
|
||||
|
||||
Wow64Process := False;
|
||||
if Assigned(IsWow64Process) then
|
||||
Wow64Process := IsWow64Process(GetCurrentProcess, Wow64Process) and Wow64Process;
|
||||
|
||||
Result := Wow64Process;
|
||||
end;
|
||||
|
||||
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
|
||||
begin
|
||||
while Pos(SearchStr, Str) <> 0 do
|
||||
begin
|
||||
Insert(ReplaceStr, Str, Pos(SearchStr, Str));
|
||||
system.Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
|
||||
end;
|
||||
Result := Str;
|
||||
end;
|
||||
|
||||
function SplitFilter(const fText: String; const fSep: Char; fTrim: Boolean=false; fQuotes: Boolean=false): TStringList;
|
||||
var vI: Integer;
|
||||
vBuffer: String;
|
||||
vOn: Boolean;
|
||||
begin
|
||||
Result:= TStringList.Create;
|
||||
vBuffer:='';
|
||||
vOn:=true;
|
||||
for vI:=1 to Length(fText) do
|
||||
begin
|
||||
if (fQuotes and(fText[vI]=fSep)and vOn)or(Not(fQuotes) and (fText[vI]=fSep)) then
|
||||
begin
|
||||
if fTrim then vBuffer:=Trim(vBuffer);
|
||||
if vBuffer='' then vBuffer:=fSep; // !!! e.g. split(',**',',')...
|
||||
if vBuffer[1]=fSep then
|
||||
vBuffer:=Copy(vBuffer,2,Length(vBuffer));
|
||||
Result.Add(vBuffer);
|
||||
vBuffer:='';
|
||||
end;
|
||||
if fQuotes then
|
||||
begin
|
||||
if fText[vI]='"' then
|
||||
begin
|
||||
vOn:=Not(vOn);
|
||||
Continue;
|
||||
end;
|
||||
if (fText[vI]<>fSep)or((fText[vI]=fSep)and(vOn=false)) then
|
||||
vBuffer:=vBuffer+fText[vI];
|
||||
end else
|
||||
if fText[vI]<>fSep then
|
||||
vBuffer:=vBuffer+fText[vI];
|
||||
end;
|
||||
if vBuffer<>'' then
|
||||
begin
|
||||
if fTrim then vBuffer:=Trim(vBuffer);
|
||||
Result.Add(vBuffer);
|
||||
end;
|
||||
end;
|
||||
|
||||
function OpenSaveFileDialog(Parent: TWinControl;
|
||||
const DefExt,
|
||||
Filter,
|
||||
InitialDir,
|
||||
Title: string;
|
||||
var FileName: string;
|
||||
MustExist,
|
||||
OverwritePrompt,
|
||||
NoChangeDir,
|
||||
DoOpen: Boolean): Boolean;
|
||||
// uses commdlg
|
||||
var
|
||||
ofn: TOpenFileName;
|
||||
szFile: array[0..260] of Char;
|
||||
fa, fa2: TStringList;
|
||||
h,i,j,k,c : integer;
|
||||
cs, s : string;
|
||||
begin
|
||||
Result := False;
|
||||
FillChar(ofn, SizeOf(TOpenFileName), 0);
|
||||
with ofn do
|
||||
begin
|
||||
lStructSize := SizeOf(TOpenFileName);
|
||||
hwndOwner := Parent.Handle;
|
||||
lpstrFile := szFile;
|
||||
nMaxFile := SizeOf(szFile);
|
||||
if (Title <> '') then
|
||||
lpstrTitle := PChar(Title);
|
||||
if (InitialDir <> '') then
|
||||
lpstrInitialDir := PChar(InitialDir);
|
||||
StrPCopy(lpstrFile, FileName);
|
||||
lpstrFilter := PChar(ReplaceStr(Filter, '|', #0)+#0#0);
|
||||
fa := splitFilter(Filter, '|');
|
||||
|
||||
k := 0;
|
||||
c := (fa.Count div 2);
|
||||
for i := 0 to c - 1 do begin
|
||||
j := 2 * i + 1;
|
||||
cs := LowerCase(fa.Strings[j]);
|
||||
fa2 := splitFilter(cs, ';');
|
||||
for h := 0 to fa2.Count - 1 do begin
|
||||
cs := fa2.Strings[h];
|
||||
s := '*.' + LowerCase(DefExt);
|
||||
if (cs = s) then k := i;
|
||||
end;
|
||||
fa2.Free; //AV: fixed multiple memory leaks!
|
||||
end;
|
||||
fa.Free; // AV: fixed memory leak!
|
||||
|
||||
nFilterIndex := k + 1;
|
||||
if DefExt <> '' then
|
||||
lpstrDefExt := PChar(DefExt);
|
||||
end;
|
||||
|
||||
if MustExist then ofn.Flags := ofn.Flags or OFN_FILEMUSTEXIST;
|
||||
if OverwritePrompt then ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT;
|
||||
if NoChangeDir then ofn.Flags := ofn.Flags or OFN_NOCHANGEDIR;
|
||||
|
||||
if DoOpen then
|
||||
begin
|
||||
if GetOpenFileName(ofn) then
|
||||
begin
|
||||
Result := True;
|
||||
FileName := StrPas(szFile);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if GetSaveFileName(ofn) then
|
||||
begin
|
||||
Result := True;
|
||||
FileName := StrPas(szFile);
|
||||
end;
|
||||
end
|
||||
end; // function OpenSaveFileDialog
|
||||
|
||||
end.
|
||||
|
||||
1127
Core/Translation.pas
Normal file
1127
Core/Translation.pas
Normal file
File diff suppressed because it is too large
Load Diff
356
Core/XFormMan.pas
Normal file
356
Core/XFormMan.pas
Normal file
@ -0,0 +1,356 @@
|
||||
{
|
||||
Apophysis Copyright (C) 2001-2004 Mark Townsend
|
||||
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
|
||||
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
|
||||
|
||||
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
|
||||
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
|
||||
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
|
||||
unit XFormMan;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
BaseVariation, SysUtils, Forms, Windows;
|
||||
|
||||
const
|
||||
NRLOCVAR = 36;
|
||||
var
|
||||
NumBuiltinVars: integer;
|
||||
|
||||
type
|
||||
TFNToVN = record
|
||||
FileName: string;
|
||||
VarName: string;
|
||||
end;
|
||||
|
||||
function NrVar: integer;
|
||||
function Varnames(const index: integer): String;
|
||||
procedure RegisterVariation(Variation: TVariationLoader; supports3D, supportsDC : boolean);
|
||||
function GetNrRegisteredVariations: integer;
|
||||
function GetRegisteredVariation(const Index: integer): TVariationLoader;
|
||||
function GetNrVariableNames: integer;
|
||||
function GetVariableNameAt(const Index: integer): string;
|
||||
function GetVariationIndex(const str: string): integer;
|
||||
function GetVariationIndexFromVariableNameIndex(const Index: integer): integer;
|
||||
procedure VarSupports(index : integer; var supports3D : boolean; var supportsDC : boolean);
|
||||
procedure InitializeXFormMan;
|
||||
procedure DestroyXFormMan;
|
||||
procedure RegisterVariationFile(filename, name: string);
|
||||
function GetFileNameOfVariation(name: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
var
|
||||
VariationList: TList;
|
||||
VariableNames: TStringlist;
|
||||
loaderNum : integer;
|
||||
Variable2VariationIndex : array of integer;
|
||||
FNToVNList : array of TFNToVN;
|
||||
FNToVNCount: integer;
|
||||
|
||||
procedure InitializeXFormMan;
|
||||
begin
|
||||
VariationList := TList.Create;
|
||||
VariableNames := TStringlist.create;
|
||||
SetLength(Variable2VariationIndex,0);
|
||||
SetLength(FNToVNList, 0);
|
||||
FNToVNCount := 0;
|
||||
end;
|
||||
|
||||
procedure VarSupports(index : integer; var supports3D : boolean; var supportsDC : boolean);
|
||||
const
|
||||
supports3D_arr: array[0..NRLOCVAR-1] of boolean = (
|
||||
true, //'linear',
|
||||
true, //'flatten',
|
||||
true, //'pre_blur3D',
|
||||
true, //'spherical',
|
||||
true, //'swirl',
|
||||
true, //'horseshoe',
|
||||
true, //'polar',
|
||||
true, //'disc',
|
||||
true, //'spiral',
|
||||
true, //'hyperbolic',
|
||||
true, //'diamond',
|
||||
true, //'eyefish',
|
||||
true, //'bubble',
|
||||
true, //'cylinder',
|
||||
true, //'noise',
|
||||
true, //'blur',
|
||||
false, //'gaussian_blur',
|
||||
true, //'zblur',
|
||||
true, //'blur3D',
|
||||
false, //'pre_blur',
|
||||
true, //'pre_zscale',
|
||||
true, //'pre_ztranslate',
|
||||
true, //'pre_rotate_x',
|
||||
true, //'pre_rotate_y',
|
||||
true, //'zscale',
|
||||
true, //'ztranslate',
|
||||
true, //'zcone',
|
||||
true, //'post_rotate_x',
|
||||
true, //'post_rotate_y',
|
||||
false, //'post_mirror_x',
|
||||
false, //'post_mirror_y',
|
||||
true, //'post_mirror_z',
|
||||
true, //'hemisphere',
|
||||
true, //'cross',
|
||||
true, //'pyramid'
|
||||
true // polar2
|
||||
);
|
||||
supportsDC_arr: array[0..NRLOCVAR-1] of boolean = (
|
||||
false, //'linear',
|
||||
false, //'flatten',
|
||||
false, //'pre_blur3D',
|
||||
false, //'spherical',
|
||||
false, //'swirl',
|
||||
false, //'horseshoe',
|
||||
false, //'polar',
|
||||
|
||||
false, //'disc',
|
||||
false, //'spiral',
|
||||
false, //'hyperbolic',
|
||||
false, //'diamond',
|
||||
|
||||
false, //'eyefish',
|
||||
false, //'bubble',
|
||||
false, //'cylinder',
|
||||
false, //'noise',
|
||||
false, //'blur',
|
||||
false, //'gaussian_blur',
|
||||
false, //'zblur',
|
||||
false, //'blur3D',
|
||||
|
||||
false, //'pre_blur',
|
||||
false, //'pre_zscale',
|
||||
false, //'pre_ztranslate',
|
||||
false, //'pre_rotate_x',
|
||||
false, //'pre_rotate_y',
|
||||
|
||||
false, //'zscale',
|
||||
false, //'ztranslate',
|
||||
false, //'zcone',
|
||||
|
||||
false, //'post_rotate_x',
|
||||
false, //'post_rotate_y'
|
||||
|
||||
false, //'post_mirror_x',
|
||||
false, //'post_mirror_y',
|
||||
false, //'post_mirror_z',
|
||||
|
||||
false, //'hemisphere',
|
||||
false, //'cross',
|
||||
false, //'pyramid'
|
||||
false // polar2
|
||||
);
|
||||
var
|
||||
varl : TVariationLoader;
|
||||
begin
|
||||
|
||||
if (index >= NRLOCVAR) then begin
|
||||
supports3D := TVariationLoader(VariationList.Items[index - NRLOCVAR]).supports3D;
|
||||
supportsDC := TVariationLoader(VariationList.Items[index - NRLOCVAR]).supportsDC;
|
||||
end else begin
|
||||
supports3D := supports3D_arr[index];
|
||||
supportsDC := supportsDC_arr[index];
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure DestroyXFormMan;
|
||||
var i: integer;
|
||||
begin
|
||||
VariableNames.Free;
|
||||
|
||||
// The registered variation loaders are owned here, so we must free them.
|
||||
for i := 0 to VariationList.Count-1 do
|
||||
TVariationLoader(VariationList[i]).Free;
|
||||
VariationList.Free;
|
||||
|
||||
Finalize(Variable2VariationIndex);
|
||||
Finalize(FNToVNList);
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function NrVar: integer;
|
||||
begin
|
||||
Result := NRLOCVAR + VariationList.Count;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
function GetVariationIndexFromVariableNameIndex(const Index: integer): integer;
|
||||
begin
|
||||
if (Index < 0) or (Index > High(Variable2VariationIndex)) then
|
||||
Result := -1
|
||||
else
|
||||
Result := Variable2VariationIndex[Index];
|
||||
end;
|
||||
|
||||
function Varnames(const index: integer): String;
|
||||
const
|
||||
cvarnames: array[0..NRLOCVAR-1] of string = (
|
||||
'linear',
|
||||
'flatten',
|
||||
'pre_blur3D',
|
||||
'spherical',
|
||||
'swirl',
|
||||
'horseshoe',
|
||||
'polar',
|
||||
// 'handkerchief',
|
||||
// 'heart',
|
||||
'disc',
|
||||
'spiral',
|
||||
'hyperbolic',
|
||||
'diamond',
|
||||
// 'ex',
|
||||
// 'julia',
|
||||
// 'bent',
|
||||
// 'waves',
|
||||
// 'fisheye',
|
||||
// 'popcorn',
|
||||
// 'exponential',
|
||||
// 'power',
|
||||
// 'cosine',
|
||||
// 'rings',
|
||||
// 'fan',
|
||||
'eyefish',
|
||||
'bubble',
|
||||
'cylinder',
|
||||
'noise',
|
||||
'blur',
|
||||
'gaussian_blur',
|
||||
'zblur',
|
||||
'blur3D',
|
||||
|
||||
'pre_blur',
|
||||
'pre_zscale',
|
||||
'pre_ztranslate',
|
||||
'pre_rotate_x',
|
||||
'pre_rotate_y',
|
||||
|
||||
'zscale',
|
||||
'ztranslate',
|
||||
'zcone',
|
||||
|
||||
'post_rotate_x',
|
||||
'post_rotate_y',
|
||||
|
||||
'post_mirror_x',
|
||||
'post_mirror_y',
|
||||
'post_mirror_z',
|
||||
|
||||
'hemisphere',
|
||||
'cross',
|
||||
'pyramid',
|
||||
'polar2'
|
||||
);
|
||||
begin
|
||||
if Index < NRLOCVAR then
|
||||
Result := cvarnames[Index]
|
||||
else
|
||||
Result := TVariationLoader(VariationList[Index - NRLOCVAR]).GetName;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function GetVariationIndex(const str: string): integer;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
i := NRVAR-1;
|
||||
while (i >= 0) and (Varnames(i) <> str) do Dec(i);
|
||||
Result := i;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
procedure RegisterVariationFile(filename, name: string);
|
||||
begin
|
||||
FNToVNCount := FNToVNCount + 1;
|
||||
SetLength(FNToVNList, FNToVNCount);
|
||||
FNToVNList[FNToVNCount - 1].FileName := filename;
|
||||
FNToVNList[FNToVNCount - 1].VarName := name;
|
||||
end;
|
||||
|
||||
function GetFileNameOfVariation(name: string): string;
|
||||
var i: integer;
|
||||
begin
|
||||
for i := 0 to FNToVNCount - 1 do begin
|
||||
if FNToVNList[i].VarName = name then begin
|
||||
Result := FNToVNList[i].FileName;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure RegisterVariation(Variation: TVariationLoader; supports3D, supportsDC : boolean);
|
||||
var
|
||||
i: integer;
|
||||
prevNumVariables:integer;
|
||||
begin
|
||||
OutputDebugString(PChar(Variation.GetName));
|
||||
|
||||
VariationList.Add(Variation);
|
||||
Variation.Supports3D := supports3D;
|
||||
Variation.SupportsDC := supportsDC;
|
||||
|
||||
prevNumVariables := GetNrVariableNames;
|
||||
setLength(Variable2VariationIndex, prevNumVariables + Variation.GetNrVariables);
|
||||
for i := 0 to Variation.GetNrVariables - 1 do begin
|
||||
VariableNames.Add(Variation.GetVariableNameAt(i));
|
||||
Variable2VariationIndex[prevNumVariables + i] := NrVar-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function GetNrRegisteredVariations: integer;
|
||||
begin
|
||||
Result := VariationList.count;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function GetRegisteredVariation(const Index: integer): TVariationLoader;
|
||||
begin
|
||||
Result := TVariationLoader(VariationList[Index]);
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function GetNrVariableNames: integer;
|
||||
begin
|
||||
Result := VariableNames.Count;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
function GetVariableNameAt(const Index: integer): string;
|
||||
begin
|
||||
Result := VariableNames[Index];
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
initialization
|
||||
InitializeXFormMan;
|
||||
|
||||
finalization
|
||||
DestroyXFormMan;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user