diff --git a/2.10/Source/Render.pas b/2.10/Source/Render.pas index 6f8b919..fdfd5b7 100644 --- a/2.10/Source/Render.pas +++ b/2.10/Source/Render.pas @@ -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. diff --git a/2.10/Source/RenderMT.pas b/2.10/Source/RenderMT.pas index 4213c3d..2f6a1ed 100644 --- a/2.10/Source/RenderMT.pas +++ b/2.10/Source/RenderMT.pas @@ -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; diff --git a/2.10/Source/RenderST.pas b/2.10/Source/RenderST.pas index ec29bf3..6499ee3 100644 --- a/2.10/Source/RenderST.pas +++ b/2.10/Source/RenderST.pas @@ -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; diff --git a/2.10/Source/RenderThread.pas b/2.10/Source/RenderThread.pas index 6305746..e426a1c 100644 --- a/2.10/Source/RenderThread.pas +++ b/2.10/Source/RenderThread.pas @@ -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. diff --git a/2.10/Source/RenderTypes.pas b/2.10/Source/RenderTypes.pas index 6700e66..f270d8b 100644 --- a/2.10/Source/RenderTypes.pas +++ b/2.10/Source/RenderTypes.pas @@ -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.