This commit is contained in:
zueuk 2006-09-06 12:34:00 +00:00
parent 8289fc9b91
commit 0d6de238b2
5 changed files with 221 additions and 123 deletions

View File

@ -35,6 +35,7 @@ type
TBaseRenderer = class
private
FOnProgress: TOnProgress;
strOutput: TStrings;
protected
camX0, camX1, camY0, camY1, // camera bounds
@ -54,7 +55,6 @@ type
FStop: integer;//boolean;
FImageMaker: TImageMaker;
strOutput: TStrings;
ColorMap: TColorMapArray;
@ -71,11 +71,10 @@ type
FMinBatches: integer;
FRenderOver: boolean;
RenderTime: TDateTime;
RenderTime, PauseTime: TDateTime;
procedure Progress(value: double);
procedure SetNumThreads(const n: integer);
procedure SetMinDensity(const q: double);
procedure CreateColorMap; virtual;
@ -94,6 +93,9 @@ type
procedure ClearBuckets; virtual; abstract;
procedure RenderMM;
procedure Trace(const str: string);
procedure TimeTrace(const str: string);
public
constructor Create; virtual;
destructor Destroy; override;
@ -107,11 +109,14 @@ type
procedure SaveImage(const FileName: String);
procedure Stop; virtual;
procedure Break; virtual;
procedure Pause; virtual; abstract;
procedure UnPause; virtual; abstract;
procedure BreakRender; virtual;
procedure Pause; virtual;
procedure UnPause; virtual;
procedure GetBucketStats(var Stats: TBucketStats);
function Failed: boolean;
procedure ShowBigStats;
procedure ShowSmallStats;
property OnProgress: TOnProgress
read FOnProgress
@ -125,7 +130,7 @@ type
read FSlice;
property NumThreads: integer
read FNumThreads
write SetNumThreads;
write FNumThreads;
property Output: TStrings
write strOutput;
property MinDensity: double
@ -134,7 +139,6 @@ type
write FRenderOver;
end;
///////////////////////////////////////////////////////////////////////////////
{ TRenderer }
@ -150,7 +154,6 @@ type
FCP: TControlPoint;
FMaxMem: int64;
public
destructor Destroy; override;
@ -210,14 +213,49 @@ begin
FCP := Cp.Clone;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Trace(const str: string);
begin
if assigned(strOutput) then
strOutput.Add(str);
end;
procedure TBaseRenderer.TimeTrace(const str: string);
begin
if assigned(strOutput) then
strOutput.Add(TimeToStr(Now) + ' : ' + str);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Pause;
begin
PauseTime := Now;
TimeTrace('Pausing render');
end;
procedure TBaseRenderer.UnPause;
var
tNow: TDateTime;
begin
tNow := Now;
RenderTime := RenderTime + (tNow - PauseTime);
TimeTrace('Resuming render');
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Stop;
begin
TimeTrace('Terminating render');
FStop := 1; //True;
end;
procedure TBaseRenderer.Break;
procedure TBaseRenderer.BreakRender;
begin
TimeTrace('Stopping render');
FStop := -1;
end;
@ -228,12 +266,6 @@ begin
FOnprogress(Value);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetNumThreads(const n: integer);
begin
FNumThreads := n;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetMinDensity(const q: double);
begin
@ -242,11 +274,54 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.GetBucketStats(var Stats: TBucketStats);
function TBaseRenderer.Failed: boolean;
begin
Result := (FStop > 0);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.ShowBigStats;
var
Stats: TBucketStats;
TotalSamples: int64;
begin
if not assigned(strOutput) then exit;
strOutput.Add('');
if NrSlices = 1 then
strOutput.Add('Render Statistics:')
else
strOutput.Add('Render Statistics for the last slice:'); // not really useful :-\
TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ?
if TotalSamples <= 0 then begin
strOutput.Add(' Nothing to talk about!'); // normally shouldn't happen
exit;
end;
strOutput.Add(Format(' Max possible bits: %2.3f', [8 + log2(TotalSamples)]));
FImageMaker.GetBucketStats(Stats);
Stats.TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ?
Stats.RenderTime := RenderTime;
with Stats do begin
strOutput.Add(Format(' Max Red: %2.3f bits', [log2(MaxR)]));
strOutput.Add(Format(' Max Green: %2.3f bits', [log2(MaxG)]));
strOutput.Add(Format(' Max Blue: %2.3f bits', [log2(MaxB)]));
strOutput.Add(Format(' Max Count: %2.3f bits', [log2(MaxA)]));
strOutput.Add(Format(' Point hit ratio: %2.2f%%', [100.0*(TotalA/TotalSamples)]));
if RenderTime > 0 then // hmm
strOutput.Add(Format(' Average speed: %n points per second', [TotalSamples / (RenderTime * 24 * 60 * 60)]));
strOutput.Add(' Pure rendering time:' + TimeToString(RenderTime));
end;
end;
procedure TBaseRenderer.ShowSmallStats;
var
TotalSamples: int64;
begin
if not assigned(strOutput) then exit;
TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ?
if RenderTime > 0 then // hmm
strOutput.Add(Format(' Average speed: %n points per second', [TotalSamples / (RenderTime * 24 * 60 * 60)]));
strOutput.Add(' Pure rendering time:' + TimeToString(RenderTime));
end;
///////////////////////////////////////////////////////////////////////////////
@ -264,11 +339,13 @@ end;
function TBaseRenderer.GetTransparentImage: TPngObject;
begin
if FStop > 0 then begin
assert(false);
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
Result := FImageMaker.GetTransparentImage;
Trace('WARNING: Trying to get unprepared image!?');
Result := nil;
// FImageMaker.OnProgress := OnProgress;
// FImageMaker.CreateImage;
end
else
Result := FImageMaker.GetTransparentImage;
end;
///////////////////////////////////////////////////////////////////////////////
@ -292,13 +369,11 @@ end;
procedure TBaseRenderer.SaveImage(const FileName: String);
begin
if FStop > 0 then begin
if Assigned(strOutput) then
strOutput.Add(TimeToStr(Now) + Format(' : Creating image with quality = %f', [fcp.actual_density]));
TimeTrace(Format('Creating image with quality = %f', [fcp.actual_density]));
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
if Assigned(strOutput) then
strOutput.Add(TimeToStr(Now) + ' : Saving image');
TimeTrace('Saving image');
FImageMaker.SaveImage(FileName);
end;
@ -433,31 +508,28 @@ end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.InitBuffers;
const
error_string = 'ERROR: Not enough memory for this render!';
var
w, h, bits: integer;
bits: integer;
begin
bits := GetBits;
w := BucketWidth;
h := BucketHeight;
CalcBufferSize;
try
if Assigned(strOutput) then
strOutput.Add(TimeToStr(Now) +
Format(' : Allocating %n Mb of memory', [BucketSize * SizeOfBucket[bits] / 1048576]));
TimeTrace(Format('Allocating %n Mb of memory', [BucketSize * SizeOfBucket[bits] / 1048576]));
AllocateBuckets; // SetLength(buckets, BucketHeight, BucketWidth); // hmm :-/
AllocateBuckets; // SetLength(buckets, BucketHeight, BucketWidth);
except
on EOutOfMemory do begin
if Assigned(strOutput) then
strOutput.Add('Error: not enough memory for this render!')
strOutput.Add(error_string)
else
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48);
Application.MessageBox(error_string, 'Apophysis', 48);
BucketWidth := 0;
BucketHeight := 0;
FStop := 1; //true;
FStop := 1;
exit;
end;
end;
@ -475,7 +547,6 @@ begin
FImageMaker.SetCP(FCP);
FImageMaker.Init;
InitBuffers;
if FStop <> 0 then exit; // memory allocation error?
@ -490,12 +561,11 @@ begin
RenderTime := Now - RenderTime;
if FStop <= 0 then begin
if Assigned(strOutput) then begin
if fcp.sample_density = fcp.actual_density then
strOutput.Add(TimeToStr(Now) + ' : Creating image')
else
strOutput.Add(TimeToStr(Now) + Format(' : Creating image with quality = %f', [fcp.actual_density]));
end;
if fcp.sample_density = fcp.actual_density then
TimeTrace('Creating image')
else
TimeTrace(Format('Creating image with quality = %f', [fcp.actual_density]));
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
@ -577,7 +647,7 @@ begin
RenderTime := RenderTime + (Now - t);
if FStop = 0 then begin
if Assigned(strOutput) then strOutput.Add(TimeToStr(Now) + ' : Creating image');
TimeTrace('Creating image');
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage(Slice * fcp.height);
end;
@ -614,13 +684,6 @@ begin
FCP := CP;
end;
{
///////////////////////////////////////////////////////////////////////////////
constructor TRenderer.Create;
begin
end;
}
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.Render;
begin
@ -628,15 +691,14 @@ begin
FRenderer.Free;
assert(Fmaxmem=0);
if FMaxMem = 0 then begin
// if FMaxMem = 0 then begin
FRenderer := TRenderer32.Create;
end else begin
FRenderer := TRenderer32MM.Create;
FRenderer.MaxMem := FMaxMem
end;
// end else begin
// FRenderer := TRenderer32MM.Create;
// FRenderer.MaxMem := FMaxMem
// end;
FRenderer.SetCP(FCP);
// FRenderer.compatibility := compatibility;
FRenderer.OnProgress := FOnProgress;
FRenderer.Render;
end;
@ -648,24 +710,5 @@ begin
FRenderer.Stop;
end;
{
procedure TRenderer.UpdateImage(CP: TControlPoint);
begin
end;
procedure TRenderer.SaveImage(const FileName: String);
begin
if assigned(FRenderer) then
FRenderer.SaveImage(FileName);
end;
procedure TRenderer.GetBucketStats(var Stats: TBucketStats);
begin
if assigned(FRenderer) then
FRenderer.GetBucketStats(Stats);
end;
}
end.

View File

@ -45,7 +45,7 @@ type
public
procedure Stop; override;
procedure Break; override;
procedure BreakRender; override;
procedure Pause; override;
procedure UnPause; override;
@ -66,12 +66,10 @@ var
nSamples: Int64;
bc : integer;
begin
if strOutput <> nil then begin
if FNumSlices > 1 then
strOutput.Add(TimeToStr(Now) + Format(' : Rendering slice #%d...', [FSlice + 1]))
else
strOutput.Add(TimeToStr(Now) + ' : Rendering...');
end;
if FNumSlices > 1 then
TimeTrace(Format('Rendering slice #%d of %d...', [FSlice + 1, FNumSlices]))
else
TimeTrace('Rendering...');
nSamples := Round(sample_density * NrSlices * BucketSize / (oversample * oversample));
FNumBatches := Round(nSamples / (fcp.nbatches * SUB_BATCH_SIZE));
@ -134,7 +132,7 @@ begin
inherited; // FStop := 1;
end;
procedure TBaseMTRenderer.Break;
procedure TBaseMTRenderer.BreakRender;
var
i: integer;
begin
@ -151,6 +149,8 @@ procedure TBaseMTRenderer.Pause;
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Suspend;
end;
@ -159,6 +159,8 @@ procedure TBaseMTRenderer.UnPause;
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Resume;
end;

View File

@ -75,12 +75,10 @@ var
nsamples: int64;
IterateBatchProc: procedure of object;
begin
if Assigned(strOutput) then begin
if FNumSlices > 1 then
strOutput.Add(TimeToStr(Now) + Format(' : Rendering slice #%d...', [FSlice + 1]))
else
strOutput.Add(TimeToStr(Now) + ' : Rendering...');
end;
if FNumSlices > 1 then
TimeTrace(Format('Rendering slice #%d of %d...', [FSlice + 1, FNumSlices]))
else
TimeTrace('Rendering...');
Randomize;
@ -105,7 +103,7 @@ begin
for i := 0 to FNumBatches-1 do begin
if FStop <> 0 then begin
// if (FStop < 0) or (i >= FMinBatches) then begin //?
// if (FStop <> 0) or (i >= FMinBatches) then begin //?
fcp.actual_density := fcp.actual_density +
fcp.sample_density * i / FNumBatches; // actual quality of incomplete render
FNumBatches := i;

View File

@ -27,7 +27,7 @@ uses
Global, RenderTypes, PngImage,
Render64, Render64MT,
Render48, Render48MT,
Render32, Render32MT,
Render32, Render32MT,
Render32f, Render32fMT;
const
@ -41,7 +41,6 @@ type
FOnProgress: TOnProgress;
FCP: TControlPoint;
// Fcompatibility: Integer;
FMaxMem: int64;
FNrThreads: Integer;
FBitsPerSample: integer;
@ -51,11 +50,10 @@ type
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);
procedure Trace(const str: string);
public
TargetHandle: HWND;
WaitForMore, More: boolean;
@ -74,9 +72,11 @@ type
procedure Terminate;
procedure Suspend;
procedure Resume;
procedure Break;
procedure BreakRender;
procedure GetBucketStats(var Stats: TBucketStats);
// procedure GetBucketStats(var Stats: TBucketStats);
procedure ShowBigStats;
procedure ShowSmallStats;
property OnProgress: TOnProgress
read FOnProgress
@ -105,7 +105,8 @@ type
implementation
uses
Math, Sysutils;
Math, SysUtils,
Tracer;
{ TRenderThread }
@ -116,6 +117,8 @@ begin
FRenderer.Free;
FRenderer := nil;
if assigned(FCP) then FCP.Free;
inherited;
end;
@ -138,7 +141,7 @@ end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetCP(CP: TControlPoint);
begin
FCP := CP;
FCP := CP.Clone;
end;
///////////////////////////////////////////////////////////////////////////////
@ -155,8 +158,11 @@ end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.CreateRenderer;
begin
if assigned(FRenderer) then
if assigned(FRenderer) then begin
Trace('Destroying previous renderer (?)');
FRenderer.Free;
end;
Trace('Creating renderer');
if NrThreads <= 1 then begin
if MaxMem = 0 then begin
@ -201,9 +207,6 @@ begin
FRenderer.MinDensity := FMinDensity;
FRenderer.OnProgress := FOnProgress;
FRenderer.Output := FOutput;
// FRenderer.Render;
//?... if FRenderer.Failed then Terminate; // hmm
end;
///////////////////////////////////////////////////////////////////////////////
@ -213,21 +216,32 @@ begin
CreateRenderer;
RenderMore:
assert(assigned(FRenderer));
Trace('Rendering');
FRenderer.Render;
if Terminated then begin
PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, 0);
if Terminated or FRenderer.Failed then begin
Trace('Sending WM_THREAD_TERMINATE');
PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, ThreadID);
Trace('Terminated');
exit;
end
else PostMessage(TargetHandle, WM_THREAD_COMPLETE, 0, 0);
else begin
Trace('Sending WM_THREAD_COMPLETE');
PostMessage(TargetHandle, WM_THREAD_COMPLETE, 0, ThreadID);
end;
if WaitForMore and (FRenderer <> nil) then begin
FRenderer.RenderMore := true;
Trace('Waiting for more');
inherited Suspend;
if WaitForMore then goto RenderMore;
end;
Trace('Finished');
end;
///////////////////////////////////////////////////////////////////////////////
@ -243,24 +257,22 @@ end;
procedure TRenderThread.Suspend;
begin
if NrThreads > 1 then
if assigned(FRenderer) then FRenderer.Pause;
if assigned(FRenderer) then FRenderer.Pause;
inherited;
end;
procedure TRenderThread.Resume;
begin
if NrThreads > 1 then
if assigned(FRenderer) then FRenderer.UnPause;
if assigned(FRenderer) then FRenderer.UnPause;
inherited;
end;
procedure TRenderThread.Break;
procedure TRenderThread.BreakRender;
begin
if assigned(FRenderer) then
FRenderer.Break;
FRenderer.BreakRender;
end;
///////////////////////////////////////////////////////////////////////////////
@ -303,10 +315,24 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.GetBucketStats(var Stats: TBucketStats);
procedure TRenderThread.Trace(const str: string);
begin
if assigned(FRenderer) then
FRenderer.GetBucketStats(Stats);
if assigned(FOutput) and (TraceLevel >= 2) then
FOutput.Add('. . > RenderThread #' + IntToStr(ThreadID) + ': ' + str);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.ShowBigStats;
begin
if assigned(FRenderer) then
FRenderer.ShowBigStats;
end;
procedure TRenderThread.ShowSmallStats;
begin
if assigned(FRenderer) then
FRenderer.ShowSmallStats;
end;
///////////////////////////////////////////////////////////////////////////////
end.

View File

@ -11,7 +11,6 @@ type
Red,
Green,
Blue: integer; //Int64;
// Count: Int64;
end;
PColorMapColor = ^TColorMapColor;
TColorMapArray = array[0..255] of TColorMapColor;
@ -81,10 +80,40 @@ const
type
TBucketStats = record
MaxR, MaxG, MaxB, MaxA,
TotalA, TotalSamples: int64;
RenderTime: TDateTime;
TotalA: int64;
end;
function TimeToString(t: TDateTime): string;
implementation
uses SysUtils;
function TimeToString(t: TDateTime): string;
var
n: integer;
begin
n := Trunc(t);
Result := '';
if n>0 then begin
Result := Result + Format(' %d day', [n]);
if (n mod 10) <> 1 then Result := Result + 's';
end;
t := t * 24;
n := Trunc(t) mod 24;
if n>0 then begin
Result := Result + Format(' %d hour', [n]);
if (n mod 10) <> 1 then Result := Result + 's';
end;
t := t * 60;
n := Trunc(t) mod 60;
if n>0 then begin
Result := Result + Format(' %d minute', [n]);
if (n mod 10) <> 1 then Result := Result + 's';
end;
t := t * 60;
t := t - (Trunc(t) div 60) * 60;
Result := Result + Format(' %.2f seconds', [t]);
end;
end.