apophysis/2.10/Source/RenderThread.pas

{
     Flame screensaver Copyright (C) 2002 Ronald Hordijk
     Apophysis Copyright (C) 2001-2004 Mark Townsend
     Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov

     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 RenderThread;

interface

uses
  Classes, Windows, Messages, Graphics,
  ControlPoint, Render,
  Global, RenderTypes,
  Render64, Render64MT,
  Render48, Render48MT,
  Render32, Render32MT, 
  Render32f, Render32fMT;

const
  WM_THREAD_COMPLETE = WM_APP + 5437;
  WM_THREAD_TERMINATE = WM_APP + 5438;

type
  TRenderThread = class(TThread)
  private
    FRenderer: TBaseRenderer;

    FOnProgress: TOnProgress;
    FCP: TControlPoint;
//    Fcompatibility: Integer;
    FMaxMem: int64;
    FNrThreads: Integer;
    FBitsPerSample: integer;
    FMinDensity: double;
    FOutput: TStrings;

    procedure CreateRenderer;
    function GetNrSlices: integer;
    function GetSlice: integer;
//    procedure Setcompatibility(const Value: Integer);
//    procedure SetMaxMem(const Value: int64);
//    procedure SetNrThreads(const Value: Integer);
    procedure SetBitsPerSample(const bits: Integer);

  public
    TargetHandle: HWND;
    WaitForMore, More: boolean;

    constructor Create;
    destructor Destroy; override;

    procedure SetCP(CP: TControlPoint);
    function  GetImage: TBitmap;
    procedure SaveImage(const FileName: String);

    procedure Execute; override;
    function  GetRenderer: TBaseRenderer;

    procedure Terminate;
    procedure Suspend;
    procedure Resume;
    procedure Break;

    procedure GetBucketStats(var Stats: TBucketStats);

    property OnProgress: TOnProgress
        read FOnProgress
       write FOnProgress;

    property Slice: integer
        read GetSlice;
    property NrSlices: integer
        read GetNrSlices;
    property MaxMem: int64
        read FMaxMem
       write FMaxMem;
//    property compatibility: Integer read Fcompatibility write Fcompatibility;
    property NrThreads: Integer
        read FNrThreads
       write FNrThreads;
    property BitsPerSample: Integer
        read FBitsPerSample
       write SetBitsPerSample;
    property Output: TStrings
       write FOutput;
    property MinDensity: double
       write FMinDensity;
  end;

implementation

uses
  Math, Sysutils;

{ TRenderThread }

///////////////////////////////////////////////////////////////////////////////
destructor TRenderThread.Destroy;
begin
  if assigned(FRenderer) then
    FRenderer.Free;
  FRenderer := nil;

  inherited;
end;

///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetImage: TBitmap;
begin
  Result := nil;
  if assigned(FRenderer) then
    Result := FRenderer.GetImage;
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetCP(CP: TControlPoint);
begin
  FCP := CP;
end;

///////////////////////////////////////////////////////////////////////////////
constructor TRenderThread.Create;
begin
  MaxMem := 0;
  BitsPerSample := InternalBitsPerSample;
  FreeOnTerminate := false;
  WaitForMore := false;

  inherited Create(True);               // Create Suspended;
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.CreateRenderer;
begin
  if assigned(FRenderer) then
    FRenderer.Free;

  if NrThreads <= 1 then begin
    if MaxMem = 0 then begin
      case FBitsPerSample of
        0: FRenderer := TRenderer32.Create;
        1: FRenderer := TRenderer32f.Create;
        2: FRenderer := TRenderer48.Create;
        3: FRenderer := TRenderer64.Create;
      end;
    end else begin
      case FBitsPerSample of
        0: FRenderer := TRenderer32MM.Create;
        1: FRenderer := TRenderer32fMM.Create;
        2: FRenderer := TRenderer48MM.Create;
        3: FRenderer := TRenderer64MM.Create;
      end;
      FRenderer.MaxMem := MaxMem;
    end;
  end
  else begin
    if MaxMem = 0 then begin
      case FBitsPerSample of
        0: FRenderer := TRenderer32MT.Create;
        1: FRenderer := TRenderer32fMT.Create;
        2: FRenderer := TRenderer48MT.Create;
        3: FRenderer := TRenderer64MT.Create;
      end;
    end else begin
      case FBitsPerSample of
        0: FRenderer := TRenderer32MT_MM.Create;
        1: FRenderer := TRenderer32fMT_MM.Create;
        2: FRenderer := TRenderer48MT_MM.Create;
        3: FRenderer := TRenderer64MT_MM.Create;
      end;
      FRenderer.MaxMem := MaxMem;
    end;
    FRenderer.NumThreads := NrThreads;
  end;

  FRenderer.SetCP(FCP);
//  FRenderer.compatibility := compatibility;
  FRenderer.MinDensity := FMinDensity;
  FRenderer.OnProgress := FOnProgress;
  FRenderer.Output := FOutput;

//  FRenderer.Render;
  //?... if FRenderer.Failed then Terminate; // hmm
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Execute;
label RenderMore;
begin
  CreateRenderer;

RenderMore:
  FRenderer.Render;

  if Terminated then begin
    PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, 0);
    exit;
  end
  else PostMessage(TargetHandle, WM_THREAD_COMPLETE, 0, 0);

  if WaitForMore and (FRenderer <> nil) then begin
    FRenderer.RenderMore := true;

    inherited Suspend;

    if WaitForMore then goto RenderMore;
  end;
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Terminate;
begin
  if assigned(FRenderer) then
    FRenderer.Stop;

  WaitForMore := false;

  inherited Terminate;
end;

procedure TRenderThread.Suspend;
begin
  if NrThreads > 1 then
    if assigned(FRenderer) then FRenderer.Pause;

  inherited;
end;

procedure TRenderThread.Resume;
begin
  if NrThreads > 1 then
    if assigned(FRenderer) then FRenderer.UnPause;

  inherited;
end;

procedure TRenderThread.Break;
begin
  if assigned(FRenderer) then
    FRenderer.Break;
end;

///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetNrSlices: integer;
begin
  if assigned(FRenderer) then
    Result := FRenderer.NrSlices
  else
    Result := 1;
end;

///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetSlice: integer;
begin
  if assigned(FRenderer) then
    Result := FRenderer.Slice
  else
    Result := 1;
end;

//////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetRenderer: TBaseRenderer;
begin
  Result := FRenderer;
  FRenderer := nil;
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetBitsPerSample(const bits: Integer);
begin
  if FRenderer = nil then FBitsPerSample := bits
  else assert(false);
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SaveImage(const FileName: String);
begin
  if assigned(FRenderer) then
    FRenderer.SaveImage(FileName);
end;

///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.GetBucketStats(var Stats: TBucketStats);
begin
  if assigned(FRenderer) then
    FRenderer.GetBucketStats(Stats);
end;

end.