bugfixes

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 BreakRender; virtual;
-    procedure Pause; virtual; abstract;
+    procedure Pause; virtual;
-    procedure UnPause; virtual; abstract;
+    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 ?
+  with Stats do begin
-  Stats.RenderTime := RenderTime;
+    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);
+    Trace('WARNING: Trying to get unprepared image!?');
-    FImageMaker.OnProgress := OnProgress;
+    Result := nil;
-    FImageMaker.CreateImage;
+//    FImageMaker.OnProgress := OnProgress;
-  end;
+//    FImageMaker.CreateImage;
-  Result := FImageMaker.GetTransparentImage;
+  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
+    TimeTrace(Format('Creating image with quality = %f', [fcp.actual_density]));
-      strOutput.Add(TimeToStr(Now) + Format(' : Creating image with quality = %f', [fcp.actual_density]));
     FImageMaker.OnProgress := OnProgress;
     FImageMaker.CreateImage;
   end;
-  if Assigned(strOutput) then
+  TimeTrace('Saving image');
-    strOutput.Add(TimeToStr(Now) + ' : 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
+    TimeTrace(Format('Allocating %n Mb of memory', [BucketSize * SizeOfBucket[bits] / 1048576]));
-      strOutput.Add(TimeToStr(Now) +
-             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
-      if fcp.sample_density = fcp.actual_density then
+      TimeTrace('Creating image')
-        strOutput.Add(TimeToStr(Now) + ' : Creating image')
+    else
-      else
+      TimeTrace(Format('Creating image with quality = %f', [fcp.actual_density]));
-        strOutput.Add(TimeToStr(Now) + Format(' : Creating image with quality = %f', [fcp.actual_density]));
+
-    end;
     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
+//  end else begin
-    FRenderer := TRenderer32MM.Create;
+//    FRenderer := TRenderer32MM.Create;
-    FRenderer.MaxMem := FMaxMem
+//    FRenderer.MaxMem := FMaxMem
-  end;
+//  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.
 

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
-    if FNumSlices > 1 then
+    TimeTrace(Format('Rendering slice #%d of %d...', [FSlice + 1, FNumSlices]))
-      strOutput.Add(TimeToStr(Now) + Format(' : Rendering slice #%d...', [FSlice + 1]))
+  else
-    else
+    TimeTrace('Rendering...');
-      strOutput.Add(TimeToStr(Now) + ' : Rendering...');
-  end;
 
   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;

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
-    if FNumSlices > 1 then
+    TimeTrace(Format('Rendering slice #%d of %d...', [FSlice + 1, FNumSlices]))
-      strOutput.Add(TimeToStr(Now) + Format(' : Rendering slice #%d...', [FSlice + 1]))
+  else
-    else
+    TimeTrace('Rendering...');
-      strOutput.Add(TimeToStr(Now) + ' : Rendering...');
-  end;
 
   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;

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
+  if Terminated or FRenderer.Failed then begin
-    PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, 0);
+    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
+  if assigned(FOutput) and (TraceLevel >= 2) then
-    FRenderer.GetBucketStats(Stats);
+    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.

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;
+    TotalA: int64;
-    RenderTime: TDateTime;
   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.