From: Peter S. <zu...@us...> - 2006-09-06 12:34:03
|
Update of /cvsroot/apophysis/2.10/Source In directory sc8-pr-cvs11.sourceforge.net:/tmp/cvs-serv15063/Source Modified Files: Render.pas RenderMT.pas RenderST.pas RenderThread.pas RenderTypes.pas Log Message: bugfixes Index: Render.pas =================================================================== RCS file: /cvsroot/apophysis/2.10/Source/Render.pas,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Render.pas 23 Aug 2006 15:57:47 -0000 1.10 --- Render.pas 6 Sep 2006 12:33:59 -0000 1.11 *************** *** 36,39 **** --- 36,40 ---- private FOnProgress: TOnProgress; + strOutput: TStrings; protected *************** *** 55,59 **** FImageMaker: TImageMaker; - strOutput: TStrings; ColorMap: TColorMapArray; --- 56,59 ---- *************** *** 72,80 **** FRenderOver: boolean; ! RenderTime: TDateTime; procedure Progress(value: double); - procedure SetNumThreads(const n: integer); procedure SetMinDensity(const q: double); --- 72,79 ---- FRenderOver: boolean; ! RenderTime, PauseTime: TDateTime; procedure Progress(value: double); procedure SetMinDensity(const q: double); *************** *** 95,98 **** --- 94,100 ---- procedure RenderMM; + procedure Trace(const str: string); + procedure TimeTrace(const str: string); + public constructor Create; virtual; *************** *** 108,116 **** procedure Stop; virtual; ! procedure Break; virtual; ! procedure Pause; virtual; abstract; ! procedure UnPause; virtual; abstract; ! procedure GetBucketStats(var Stats: TBucketStats); property OnProgress: TOnProgress --- 110,121 ---- procedure Stop; virtual; ! procedure BreakRender; virtual; ! procedure Pause; virtual; ! procedure UnPause; virtual; ! function Failed: boolean; ! ! procedure ShowBigStats; ! procedure ShowSmallStats; property OnProgress: TOnProgress *************** *** 126,130 **** property NumThreads: integer read FNumThreads ! write SetNumThreads; property Output: TStrings write strOutput; --- 131,135 ---- property NumThreads: integer read FNumThreads ! write FNumThreads; property Output: TStrings write strOutput; *************** *** 135,139 **** end; - /////////////////////////////////////////////////////////////////////////////// --- 140,143 ---- *************** *** 151,155 **** FMaxMem: int64; - public destructor Destroy; override; --- 155,158 ---- *************** *** 212,222 **** /////////////////////////////////////////////////////////////////////////////// procedure TBaseRenderer.Stop; begin FStop := 1; //True; end; ! procedure TBaseRenderer.Break; begin FStop := -1; end; --- 215,260 ---- /////////////////////////////////////////////////////////////////////////////// + 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.BreakRender; begin + TimeTrace('Stopping render'); + FStop := -1; end; *************** *** 230,251 **** /////////////////////////////////////////////////////////////////////////////// ! procedure TBaseRenderer.SetNumThreads(const n: integer); begin ! FNumThreads := n; end; /////////////////////////////////////////////////////////////////////////////// ! procedure TBaseRenderer.SetMinDensity(const q: double); begin ! if q < fcp.sample_density then FMinDensity := q ! else FMinDensity := fcp.sample_density; end; /////////////////////////////////////////////////////////////////////////////// ! procedure TBaseRenderer.GetBucketStats(var Stats: TBucketStats); begin FImageMaker.GetBucketStats(Stats); ! Stats.TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ? ! Stats.RenderTime := RenderTime; end; --- 268,326 ---- /////////////////////////////////////////////////////////////////////////////// ! procedure TBaseRenderer.SetMinDensity(const q: double); begin ! if q < fcp.sample_density then FMinDensity := q ! else FMinDensity := fcp.sample_density; end; /////////////////////////////////////////////////////////////////////////////// ! 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); ! 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; *************** *** 265,273 **** begin if FStop > 0 then begin ! assert(false); ! FImageMaker.OnProgress := OnProgress; ! FImageMaker.CreateImage; ! end; ! Result := FImageMaker.GetTransparentImage; end; --- 340,350 ---- begin if FStop > 0 then begin ! Trace('WARNING: Trying to get unprepared image!?'); ! Result := nil; ! // FImageMaker.OnProgress := OnProgress; ! // FImageMaker.CreateImage; ! end ! else ! Result := FImageMaker.GetTransparentImage; end; *************** *** 293,303 **** begin if FStop > 0 then begin ! if Assigned(strOutput) then ! strOutput.Add(TimeToStr(Now) + 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'); FImageMaker.SaveImage(FileName); end; --- 370,378 ---- begin if FStop > 0 then begin ! TimeTrace(Format('Creating image with quality = %f', [fcp.actual_density])); FImageMaker.OnProgress := OnProgress; FImageMaker.CreateImage; end; ! TimeTrace('Saving image'); FImageMaker.SaveImage(FileName); end; *************** *** 434,462 **** /////////////////////////////////////////////////////////////////////////////// procedure TBaseRenderer.InitBuffers; var ! w, h, 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])); ! AllocateBuckets; // SetLength(buckets, BucketHeight, BucketWidth); // hmm :-/ except on EOutOfMemory do begin if Assigned(strOutput) then ! strOutput.Add('Error: not enough memory for this render!') else ! Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48); BucketWidth := 0; BucketHeight := 0; ! FStop := 1; //true; exit; end; --- 509,534 ---- /////////////////////////////////////////////////////////////////////////////// procedure TBaseRenderer.InitBuffers; + const + error_string = 'ERROR: Not enough memory for this render!'; var ! bits: integer; begin bits := GetBits; CalcBufferSize; try ! TimeTrace(Format('Allocating %n Mb of memory', [BucketSize * SizeOfBucket[bits] / 1048576])); ! AllocateBuckets; // SetLength(buckets, BucketHeight, BucketWidth); except on EOutOfMemory do begin if Assigned(strOutput) then ! strOutput.Add(error_string) else ! Application.MessageBox(error_string, 'Apophysis', 48); BucketWidth := 0; BucketHeight := 0; ! FStop := 1; exit; end; *************** *** 476,480 **** FImageMaker.Init; - InitBuffers; if FStop <> 0 then exit; // memory allocation error? --- 548,551 ---- *************** *** 491,500 **** 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; FImageMaker.OnProgress := OnProgress; FImageMaker.CreateImage; --- 562,570 ---- if FStop <= 0 then begin ! 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; *************** *** 578,582 **** if FStop = 0 then begin ! if Assigned(strOutput) then strOutput.Add(TimeToStr(Now) + ' : Creating image'); FImageMaker.OnProgress := OnProgress; FImageMaker.CreateImage(Slice * fcp.height); --- 648,652 ---- if FStop = 0 then begin ! TimeTrace('Creating image'); FImageMaker.OnProgress := OnProgress; FImageMaker.CreateImage(Slice * fcp.height); *************** *** 615,625 **** end; - { - /////////////////////////////////////////////////////////////////////////////// - constructor TRenderer.Create; - begin - end; - } - /////////////////////////////////////////////////////////////////////////////// procedure TRenderer.Render; --- 685,688 ---- *************** *** 629,641 **** assert(Fmaxmem=0); ! if FMaxMem = 0 then begin FRenderer := TRenderer32.Create; ! end else begin ! FRenderer := TRenderer32MM.Create; ! FRenderer.MaxMem := FMaxMem ! end; FRenderer.SetCP(FCP); - // FRenderer.compatibility := compatibility; FRenderer.OnProgress := FOnProgress; FRenderer.Render; --- 692,703 ---- assert(Fmaxmem=0); ! // if FMaxMem = 0 then begin FRenderer := TRenderer32.Create; ! // end else begin ! // FRenderer := TRenderer32MM.Create; ! // FRenderer.MaxMem := FMaxMem ! // end; FRenderer.SetCP(FCP); FRenderer.OnProgress := FOnProgress; FRenderer.Render; *************** *** 649,671 **** 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. --- 711,714 ---- Index: RenderMT.pas =================================================================== RCS file: /cvsroot/apophysis/2.10/Source/RenderMT.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** RenderMT.pas 22 Aug 2006 13:39:27 -0000 1.1 --- RenderMT.pas 6 Sep 2006 12:34:00 -0000 1.2 *************** *** 46,50 **** public procedure Stop; override; ! procedure Break; override; procedure Pause; override; --- 46,50 ---- public procedure Stop; override; ! procedure BreakRender; override; procedure Pause; override; *************** *** 67,76 **** 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; nSamples := Round(sample_density * NrSlices * BucketSize / (oversample * oversample)); --- 67,74 ---- bc : integer; begin ! 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)); *************** *** 135,139 **** end; ! procedure TBaseMTRenderer.Break; var i: integer; --- 133,137 ---- end; ! procedure TBaseMTRenderer.BreakRender; var i: integer; *************** *** 152,155 **** --- 150,155 ---- i: integer; begin + inherited; + for i := 0 to High(WorkingThreads) do WorkingThreads[i].Suspend; *************** *** 160,163 **** --- 160,165 ---- i: integer; begin + inherited; + for i := 0 to High(WorkingThreads) do WorkingThreads[i].Resume; Index: RenderThread.pas =================================================================== RCS file: /cvsroot/apophysis/2.10/Source/RenderThread.pas,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** RenderThread.pas 23 Aug 2006 15:57:47 -0000 1.11 --- RenderThread.pas 6 Sep 2006 12:34:00 -0000 1.12 *************** *** 28,32 **** Render64, Render64MT, Render48, Render48MT, ! Render32, Render32MT, Render32f, Render32fMT; --- 28,32 ---- Render64, Render64MT, Render48, Render48MT, ! Render32, Render32MT, Render32f, Render32fMT; *************** *** 42,46 **** FOnProgress: TOnProgress; FCP: TControlPoint; - // Fcompatibility: Integer; FMaxMem: int64; FNrThreads: Integer; --- 42,45 ---- *************** *** 52,60 **** 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; --- 51,58 ---- function GetNrSlices: integer; function GetSlice: integer; procedure SetBitsPerSample(const bits: Integer); + procedure Trace(const str: string); + public TargetHandle: HWND; *************** *** 75,81 **** procedure Suspend; procedure Resume; ! procedure Break; ! procedure GetBucketStats(var Stats: TBucketStats); property OnProgress: TOnProgress --- 73,81 ---- procedure Suspend; procedure Resume; ! procedure BreakRender; ! // procedure GetBucketStats(var Stats: TBucketStats); ! procedure ShowBigStats; ! procedure ShowSmallStats; property OnProgress: TOnProgress *************** *** 106,110 **** uses ! Math, Sysutils; { TRenderThread } --- 106,111 ---- uses ! Math, SysUtils, ! Tracer; { TRenderThread } *************** *** 117,120 **** --- 118,123 ---- FRenderer := nil; + if assigned(FCP) then FCP.Free; + inherited; end; *************** *** 139,143 **** procedure TRenderThread.SetCP(CP: TControlPoint); begin ! FCP := CP; end; --- 142,146 ---- procedure TRenderThread.SetCP(CP: TControlPoint); begin ! FCP := CP.Clone; end; *************** *** 156,161 **** procedure TRenderThread.CreateRenderer; begin ! if assigned(FRenderer) then FRenderer.Free; if NrThreads <= 1 then begin --- 159,167 ---- procedure TRenderThread.CreateRenderer; begin ! if assigned(FRenderer) then begin ! Trace('Destroying previous renderer (?)'); FRenderer.Free; + end; + Trace('Creating renderer'); if NrThreads <= 1 then begin *************** *** 202,208 **** FRenderer.OnProgress := FOnProgress; FRenderer.Output := FOutput; - - // FRenderer.Render; - //?... if FRenderer.Failed then Terminate; // hmm end; --- 208,211 ---- *************** *** 214,232 **** 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; --- 217,246 ---- RenderMore: + assert(assigned(FRenderer)); + + Trace('Rendering'); FRenderer.Render; ! if Terminated or FRenderer.Failed then begin ! Trace('Sending WM_THREAD_TERMINATE'); ! PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, ThreadID); ! Trace('Terminated'); exit; end ! 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; *************** *** 244,249 **** procedure TRenderThread.Suspend; begin ! if NrThreads > 1 then ! if assigned(FRenderer) then FRenderer.Pause; inherited; --- 258,262 ---- procedure TRenderThread.Suspend; begin ! if assigned(FRenderer) then FRenderer.Pause; inherited; *************** *** 252,265 **** 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; --- 265,277 ---- procedure TRenderThread.Resume; begin ! if assigned(FRenderer) then FRenderer.UnPause; inherited; end; ! procedure TRenderThread.BreakRender; begin if assigned(FRenderer) then ! FRenderer.BreakRender; end; *************** *** 304,312 **** /////////////////////////////////////////////////////////////////////////////// ! procedure TRenderThread.GetBucketStats(var Stats: TBucketStats); begin if assigned(FRenderer) then ! FRenderer.GetBucketStats(Stats); end; end. --- 316,338 ---- /////////////////////////////////////////////////////////////////////////////// ! procedure TRenderThread.Trace(const str: string); ! begin ! 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. Index: RenderTypes.pas =================================================================== RCS file: /cvsroot/apophysis/2.10/Source/RenderTypes.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** RenderTypes.pas 22 Aug 2006 13:39:27 -0000 1.1 --- RenderTypes.pas 6 Sep 2006 12:34:00 -0000 1.2 *************** *** 12,16 **** Green, Blue: integer; //Int64; - // Count: Int64; end; PColorMapColor = ^TColorMapColor; --- 12,15 ---- *************** *** 82,90 **** TBucketStats = record MaxR, MaxG, MaxB, MaxA, ! TotalA, TotalSamples: int64; ! RenderTime: TDateTime; end; implementation end. --- 81,119 ---- TBucketStats = record MaxR, MaxG, MaxB, MaxA, ! 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. Index: RenderST.pas =================================================================== RCS file: /cvsroot/apophysis/2.10/Source/RenderST.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** RenderST.pas 22 Aug 2006 13:39:27 -0000 1.1 --- RenderST.pas 6 Sep 2006 12:34:00 -0000 1.2 *************** *** 76,85 **** 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; Randomize; --- 76,83 ---- IterateBatchProc: procedure of object; begin ! if FNumSlices > 1 then ! TimeTrace(Format('Rendering slice #%d of %d...', [FSlice + 1, FNumSlices])) ! else ! TimeTrace('Rendering...'); Randomize; *************** *** 106,110 **** for i := 0 to FNumBatches-1 do begin if FStop <> 0 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 --- 104,108 ---- for i := 0 to FNumBatches-1 do begin if FStop <> 0 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 |