Apophysis-AV/Forms/ScriptRender.pas

{
     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 ScriptRender;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, RenderThread, ControlPoint;

type
  TScriptRenderForm = class(TForm)
    btnCancel: TButton;
    ProgressBar: TProgressBar;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    StartTime: TDateTime;
    Remainder: TDateTime;
    Filename: string;

    procedure HandleThreadCompletion(var Message: TMessage);
      message WM_THREAD_COMPLETE;
    procedure HandleThreadTermination(var Message: TMessage);
      message WM_THREAD_TERMINATE;
  public
    Renderer: TRenderThread;
    cp: TControlPoint;

    procedure OnProgress(prog: double);
    procedure Render;
    procedure SetRenderBounds;
  end;

var
  ScriptRenderForm: TScriptRenderForm;
  Cancelled: boolean;

implementation

uses Global, Math, FormRender, ScriptForm, Main, Translation;

{$R *.DFM}

procedure TScriptRenderForm.SetRenderBounds;
// AV: do not use it - just waste of time
begin
  cp.copy(ScriptEditor.cp);
  cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height);
end;

procedure TScriptRenderForm.Render;
var
  ScrRender: TScriptRender; // AV
begin
  assert(not Assigned(Renderer));
  Renderer := TRenderThread.Create;

  Cancelled := False;
  ScriptEditor.Scripter.Paused := True;
  StartTime := Now;
  Remainder := 1;
  //cp.copy(ScriptEditor.cp); // <-- AV: already done by RenderProc
  ScrRender := ScriptEditor.Renderer;  // AV: for speed
  Filename := ScrRender.Filename;

  cp.AdjustScale(ScrRender.Width, ScrRender.Height);

  if (UpperCase(ExtractFileExt(FileName)) = '.PNG') then
  begin   // AV: added new property
	  cp.Transparency := (PNGTransparency <> 0);
    if ScrRender.EmbedParameters then
	    Renderer.EmbedText(Trim(FlameToXML(cp))); // AV
  end
  else
    cp.Transparency := False; // AV

  Renderer.OnProgress := OnProgress;
  Renderer.SetCP(cp);
  if (ScrRender.MaxMemory > 0) then
    Renderer.MaxMem := ScrRender.MaxMemory;
  Renderer.TargetHandle := Handle;
  renderPath := ExtractFilePath(Filename);
  Renderer.Priority := tpLower;
 
  Renderer.NrThreads := NrTreads; // AV: now works fine
  Renderer.Resume;

//  Renderer.SaveImage(FileName);
//  ScriptEditor.Scripter.Paused := False;
end;

procedure TScriptRenderForm.OnProgress(prog: double);
var
  Elapsed: TDateTime;
begin
  prog := (Renderer.Slice + Prog) / Renderer.NrSlices;
  ProgressBar.Position := round(100 * prog);
  Elapsed := Now - StartTime;
  // if prog > 0 then Remainder := Elapsed * (1/prog - 1);
  //Application.ProcessMessages;
end;

procedure TScriptRenderForm.FormDestroy(Sender: TObject);
begin
  cp.free;
  assert(not Assigned(Renderer)); //if Assigned(Renderer) then Renderer.free;
end;

procedure TScriptRenderForm.FormCreate(Sender: TObject);
begin
  self.Hint := TextByKey('script-rendering');
  btnCancel.Caption := TextByKey('common-cancel');
  cp := TControlPoint.Create;
end;

procedure TScriptRenderForm.btnCancelClick(Sender: TObject);
begin
  ScriptEditor.Scripter.Halt;
  Cancelled := True;

  if Assigned(Renderer) then begin
    Renderer.Terminate;
    Renderer.WaitFor;
    Renderer.Free;
    Renderer := nil;
  end;
  LastError := TextByKey('script-status-cancelrender');
end;

procedure TScriptRenderForm.HandleThreadCompletion(var Message: TMessage);
begin
  Renderer.SaveImage(FileName);

  Renderer.Free;
  Renderer := nil;

  ScriptEditor.Scripter.Paused := False;
end;

procedure TScriptRenderForm.HandleThreadTermination(var Message: TMessage);
begin
  if Assigned(Renderer) then
  begin
    Renderer.Free;
    Renderer := nil;
  end;
end;

end.