Added transform syncronization, an animation module and made the app work faster

IO/Binary.pas

@@ -0,0 +1,177 @@
+unit Binary;
+
+interface
+
+const
+
+  HIB_BLOCKSIZE         = $10; // 16 bytes
+  HIB_MAXOFFSET         = $0F; // HIB_BLOCKSIZE - 1
+
+type
+
+  // low-level binary types
+  TBlock = array[0..HIB_MAXOFFSET] of byte;
+  TWord  = array[0..1] of byte;
+  TDWord = array[0..3] of byte;
+  TQWord = array[0..7] of byte;
+  THibRawString = array of byte;
+
+// procedures to write blocks at low level
+procedure WriteData2(var target: TBlock; data: TWord; pos: integer);
+procedure WriteData4(var target: TBlock; data: TDWord; pos: integer);
+procedure WriteData8(var target: TBlock; data: TQWord; pos: integer);
+
+// procedures to read blocks at low level
+procedure ReadData2(source: TBlock; var data: TWord; pos: integer);
+procedure ReadData4(source: TBlock; var data: TDWord; pos: integer);
+procedure ReadData8(source: TBlock; var data: TQWord; pos: integer);
+
+// procedures to write typed data to blocks
+procedure Int16ToBlock(var target: TBlock; pos: integer; data: SmallInt);
+procedure Int32ToBlock(var target: TBlock; pos: integer; data: Integer);
+procedure LongWordToBlock(var target: TBlock; pos: integer; data: LongWord);
+procedure Int64ToBlock(var target: TBlock; pos: integer; data: Int64);
+procedure SingleToBlock(var target: TBlock; pos: integer; data: Single);
+procedure DoubleToBlock(var target: TBlock; pos: integer; data: Double);
+
+// procedures to read typed data from blocks
+function BlockToInt16(source: TBlock; pos: integer): SmallInt;
+function BlockToInt32(source: TBlock; pos: integer): Integer;
+function BlockToLongWord(source: TBlock; pos: integer): LongWord;
+function BlockToInt64(source: TBlock; pos: integer): Int64;
+function BlockToSingle(source: TBlock; pos: integer): Single;
+function BlockToDouble(source: TBlock; pos: integer): Double;
+
+implementation
+
+procedure ReadData2(source: TBlock; var data: TWord; pos: integer);
+const size = 2;
+var i: integer;
+begin
+  for i := 0 to size - 1 do
+  if i + pos < HIB_BLOCKSIZE then
+  data[i] := source[i + pos];
+end;
+procedure ReadData4(source: TBlock; var data: TDWord; pos: integer);
+const size = 4;
+var i: integer;
+begin
+  for i := 0 to size - 1 do
+  if i + pos < HIB_BLOCKSIZE then
+  data[i] := source[i + pos];
+end;
+procedure ReadData8(source: TBlock; var data: TQWord; pos: integer);
+const size = 8;
+var i: integer;
+begin
+  for i := 0 to size - 1 do
+  if i + pos < HIB_BLOCKSIZE then
+  data[i] := source[i + pos];
+end;
+
+procedure WriteData2(var target: TBlock; data: TWord; pos: integer);
+const size = 2;
+var i: integer;
+begin
+  for i := 0 to size - 1 do
+  if i + pos < HIB_BLOCKSIZE then
+  target[i + pos] := data[i];
+end;
+procedure WriteData4(var target: TBlock; data: TDWord; pos: integer);
+const size = 4;
+var i: integer;
+begin
+  for i := 0 to size - 1 do
+  if i + pos < HIB_BLOCKSIZE then
+  target[i + pos] := data[i];
+end;
+procedure WriteData8(var target: TBlock; data: TQWord; pos: integer);
+const size = 8;
+var i: integer;
+begin
+  for i := 0 to size - 1 do
+  if i + pos < HIB_BLOCKSIZE then
+  target[i + pos] := data[i];
+end;
+
+function BlockToInt16(source: TBlock; pos: integer): SmallInt;
+var temp: TWord; data: SmallInt;
+begin
+  ReadData2(source, temp, pos);
+  Move(temp, data, SizeOf(TWord));
+  Result := data;
+end;
+function BlockToInt32(source: TBlock; pos: integer): Integer;
+var temp: TDWord; data: Integer;
+begin
+  ReadData4(source, temp, pos);
+  Move(temp, data, SizeOf(TDWord));
+  Result := data;
+end;
+function BlockToLongWord(source: TBlock; pos: integer): LongWord;
+var temp: TDWord; data: LongWord;
+begin
+  ReadData4(source, temp, pos);
+  Move(temp, data, SizeOf(TDWord));
+  Result := data;
+end;
+function BlockToInt64(source: TBlock; pos: integer): Int64;
+var temp: TQWord; data: Int64;
+begin
+  ReadData8(source, temp, pos);
+  Move(temp, data, SizeOf(TQWord));
+  Result := data;
+end;
+function BlockToSingle(source: TBlock; pos: integer): Single;
+var temp: TDWord; data: Single;
+begin
+  ReadData4(source, temp, pos);
+  Move(temp, data, SizeOf(TDWord));
+  Result := data;
+end;
+function BlockToDouble(source: TBlock; pos: integer): Double;
+var temp: TQWord; data: Double;
+begin
+  ReadData8(source, temp, pos);
+  Move(temp, data, SizeOf(TQWord));
+  Result := data;
+end;
+
+procedure Int16ToBlock(var target: TBlock; pos: integer; data: SmallInt);
+var temp: TWord;
+begin
+  Move(data, temp, SizeOf(TWord));
+  WriteData2(target, temp, pos);
+end;
+procedure Int32ToBlock(var target: TBlock; pos: integer; data: Integer);
+var temp: TDWord;
+begin
+  Move(data, temp, SizeOf(TDWord));
+  WriteData4(target, temp, pos);
+end;
+procedure LongWordToBlock(var target: TBlock; pos: integer; data: LongWord);
+var temp: TDWord;
+begin
+  Move(data, temp, SizeOf(TDWord));
+  WriteData4(target, temp, pos);
+end;
+procedure Int64ToBlock(var target: TBlock; pos: integer; data: Int64);
+var temp: TQWord;
+begin
+  Move(data, temp, SizeOf(TQWord));
+  WriteData8(target, temp, pos);
+end;
+procedure SingleToBlock(var target: TBlock; pos: integer; data: single);
+var temp: TDWord;
+begin
+  Move(data, temp, SizeOf(TDWord));
+  WriteData4(target, temp, pos);
+end;
+procedure DoubleToBlock(var target: TBlock; pos: integer; data: double);
+var temp: TQWord;
+begin
+  Move(data, temp, SizeOf(TQWord));
+  WriteData8(target, temp, pos);
+end;
+
+end.

IO/CommandLine.pas

@@ -0,0 +1,48 @@
+unit CommandLine;
+
+interface
+
+uses RegularExpressionsCore;
+
+type TCommandLine = class
+  public
+    CreateFromTemplate: boolean;
+    TemplateFile: string;
+    TemplateName: string;
+    //Lite: boolean;
+
+    procedure Load;
+  end;
+
+implementation
+
+procedure TCommandLine.Load;
+var
+  Regex: TPerlRegEx;
+begin
+  Regex := TPerlRegEx.Create;
+  Regex.RegEx := '-template\s+"(.+)"\s+"(.+)"';
+  Regex.Options := [preSingleLine, preCaseless];
+  Regex.Subject := CmdLine;  // Utf8String(CmdLine);
+  CreateFromTemplate := false;
+  if Regex.Match then 
+	  if Regex.GroupCount = 2 then begin
+      CreateFromTemplate := true;
+      TemplateFile := Regex.Groups[1];
+      TemplateName := Regex.Groups[2];
+  	end;
+  Regex.Destroy;
+
+  { // AV: this is not so useful since NXFORMS still equals to 100
+  Regex := TPerlRegEx.Create;
+  Regex.RegEx := '-lite';
+  Regex.Options := [preSingleLine, preCaseless];
+  Regex.Subject := CmdLine; // Utf8String(CmdLine);
+  CreateFromTemplate := false;
+  if Regex.Match then 
+    Lite := true;
+  Regex.Destroy;
+  }
+end;
+  
+end.

IO/MissingPlugin.pas

@@ -0,0 +1,99 @@
+{
+     Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
+     Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
+}
+
+unit MissingPlugin;
+
+interface
+
+  uses Windows, Global, Classes, LoadTracker, ComCtrls, SysUtils,
+       ControlPoint, Translation;
+	   
+  const RegisteredAttributes : array[0..29] of string = (
+    'weight', 'color', 'symmetry', 'color_speed', 'coefs', 'chaos',
+    'plotmode', 'opacity', 'post', 'var', 'var1', 'var_color',
+    'name', 'linear3D', 'GlynnSim3_thickness2', 'var_order',
+    'perspective', 'perspective_dist', 'perspective_angle',
+	  'fan', 'rings', 'waves', 'popcorn', 'bent', 'secant', 'arch',
+	  'droste', 'droste_r1', 'droste_r2', 'Spherical3D'
+  );
+  
+  var  MissingPluginList : TStringList;
+       Parsing : boolean;
+       ErrorMessageString : string;
+
+  procedure BeginParsing;
+  procedure CheckAttribute(attr: string);
+  function EndParsing(cp : TControlPoint; var statusPanelText : string): boolean;
+  procedure AnnoyUser;
+  
+implementation
+
+  procedure BeginParsing;
+  begin
+    // AV: moved into main unit to be sure that it's created only 1 time
+    //MissingPluginList := TStringList.Create;
+    MissingPluginList.Clear;  // AV
+    if (AutoOpenLog = true) then
+    if (LoadForm.Showing = false) then
+      LoadForm.Show;
+  end;
+
+  procedure CheckAttribute(attr: string);
+  var i : integer;
+  begin
+    for i := 0 to Length(RegisteredAttributes)-1 do
+      if attr = RegisteredAttributes[i] then exit;
+
+    if MissingPluginList.IndexOf(attr) < 0 then
+      MissingPluginList.Add(attr);
+  end;
+
+  function EndParsing(cp : TControlPoint; var statusPanelText : string): boolean;
+  var 
+		str, str2 : string; 
+		i : integer; 
+		newl : TStringList;
+  begin
+    str2 := TextByKey('main-status-variationsorvariables');
+    if (cp.used_plugins.Count > 0) then begin
+      newl := TStringList.Create;
+      for i := 0 to MissingPluginList.Count - 1 do begin
+        if cp.used_plugins.IndexOf(MissingPluginList[i]) >= 0 then
+          newl.Add(MissingPluginList[i]);
+      end;
+      str2 := TextByKey('main-status-plugins');
+     // MissingPluginList.Free;
+     // MissingPluginList := newl; // AV: here was a memory leak
+      MissingPluginList.Clear;   // AV
+      MissingPluginList.Assign(newl);  // AV
+      newl.Free;  // AV
+    end;
+
+    if MissingPluginList.Count > 0 then 
+	  begin
+      statusPanelText := Format(TextByKey('main-status-loadingerrorcount'), [MissingPluginList.Count]);
+
+      for i := 0 to MissingPluginList.Count - 1 do
+        str := str + #13#10 + '  - ' + MissingPluginList[i];
+      ErrorMessageString := Format(TextByKey('main-status-morepluginsneeded'), [cp.name, str2]) + str;
+      LoadForm.Output.Text := LoadForm.Output.Text +
+        ErrorMessageString + #13#10#13#10;
+      Result := false;
+    end else begin
+      statusPanelText := TextByKey('main-status-noloadingerrors');
+      ErrorMessageString := '';
+      Result := true;
+    end;
+    // AV: moved into main unit to be sure that it's destroyed only 1 time
+    //MissingPluginList.Free;
+    MissingPluginList.Clear;  // AV
+  end;
+
+  procedure AnnoyUser;
+  begin
+    if (ErrorMessageString = '') or (not WarnOnMissingPlugin) then exit;
+    MessageBox($00000000, PChar(ErrorMessageString), PChar('Apophysis AV'), MB_ICONHAND or MB_OK);
+  end;
+end.