added thread priority control

This commit is contained in:
zueuk 2008-09-08 11:25:20 +00:00
parent 92b97a9b01
commit fe7d7253cf
7 changed files with 79 additions and 5 deletions

View File

@ -562,6 +562,15 @@ object RenderForm: TRenderForm
end end
end end
end end
object chkThreadPriority: TCheckBox
Left = 176
Top = 358
Width = 73
Height = 17
Caption = 'Low priority'
TabOrder = 10
OnClick = chkThreadPriorityClick
end
object SaveDialog: TSaveDialog object SaveDialog: TSaveDialog
Left = 136 Left = 136
Top = 360 Top = 360

View File

@ -74,6 +74,7 @@ type
chkLimitMem: TCheckBox; chkLimitMem: TCheckBox;
cbBitsPerSample: TComboBox; cbBitsPerSample: TComboBox;
Output: TMemo; Output: TMemo;
chkThreadPriority: TCheckBox;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure btnRenderClick(Sender: TObject); procedure btnRenderClick(Sender: TObject);
@ -96,6 +97,7 @@ type
procedure chkMaintainClick(Sender: TObject); procedure chkMaintainClick(Sender: TObject);
procedure chkSaveIncompleteRendersClick(Sender: TObject); procedure chkSaveIncompleteRendersClick(Sender: TObject);
procedure cbBitsPerSampleSelect(Sender: TObject); procedure cbBitsPerSampleSelect(Sender: TObject);
procedure chkThreadPriorityClick(Sender: TObject);
private private
StartTime, EndTime, oldElapsed, edt: TDateTime; StartTime, EndTime, oldElapsed, edt: TDateTime;
oldProg: double; oldProg: double;
@ -510,6 +512,11 @@ begin
Renderer := TRenderThread.Create; Renderer := TRenderThread.Create;
assert(Renderer <> nil); assert(Renderer <> nil);
if chkThreadPriority.Checked then
Renderer.SetPriority(tpLower)
else
Renderer.SetPriority(tpNormal);
Renderer.BitsPerSample := BitsPerSample; Renderer.BitsPerSample := BitsPerSample;
if chkLimitMem.checked then if chkLimitMem.checked then
Renderer.MaxMem := MaxMemory;//StrToInt(cbMaxMemory.text); Renderer.MaxMem := MaxMemory;//StrToInt(cbMaxMemory.text);
@ -577,6 +584,12 @@ begin
Renderer := TRenderThread.Create; Renderer := TRenderThread.Create;
assert(Renderer <> nil); assert(Renderer <> nil);
if chkThreadPriority.Checked then
Renderer.SetPriority(tpLower)
else
Renderer.SetPriority(tpNormal);
Renderer.BitsPerSample := BitsPerSample; Renderer.BitsPerSample := BitsPerSample;
if chkLimitMem.checked then if chkLimitMem.checked then
Renderer.MaxMem := MaxMemory;//StrToInt(cbMaxMemory.text); Renderer.MaxMem := MaxMemory;//StrToInt(cbMaxMemory.text);
@ -640,6 +653,7 @@ begin
ShowMemoryStatus; ShowMemoryStatus;
Ratio := ImageWidth / ImageHeight; Ratio := ImageWidth / ImageHeight;
chkSaveIncompleteRenders.Checked := SaveIncompleteRenders; chkSaveIncompleteRenders.Checked := SaveIncompleteRenders;
chkThreadPriority.Checked := LowerRenderPriority;
end; end;
procedure TRenderForm.txtWidthChange(Sender: TObject); procedure TRenderForm.txtWidthChange(Sender: TObject);
@ -1038,5 +1052,17 @@ begin
ShowMemoryStatus; ShowMemoryStatus;
end; end;
procedure TRenderForm.chkThreadPriorityClick(Sender: TObject);
begin
LowerRenderPriority := chkThreadPriority.Checked;
if Assigned(Renderer) then begin
if LowerRenderPriority then
Renderer.SetPriority(tpLower)
else
Renderer.SetPriority(tpNormal);
end;
end;
end. end.

View File

@ -151,6 +151,7 @@ var
SaveIncompleteRenders: boolean; SaveIncompleteRenders: boolean;
ShowRenderStats: boolean; ShowRenderStats: boolean;
LowerRenderPriority: boolean;
SymmetryType: integer; SymmetryType: integer;
SymmetryOrder: integer; SymmetryOrder: integer;

View File

@ -556,6 +556,7 @@ begin
ShowProgress := true; ShowProgress := true;
end; end;
{ FormRender }
if Registry.ValueExists('SaveIncompleteRenders') then begin if Registry.ValueExists('SaveIncompleteRenders') then begin
SaveIncompleteRenders := Registry.ReadBool('SaveIncompleteRenders'); SaveIncompleteRenders := Registry.ReadBool('SaveIncompleteRenders');
end else begin end else begin
@ -566,6 +567,11 @@ begin
end else begin end else begin
ShowRenderStats := false; ShowRenderStats := false;
end; end;
if Registry.ValueExists('LowerRenderPriority') then begin
LowerRenderPriority := Registry.ReadBool('LowerRenderPriority');
end else begin
LowerRenderPriority := false;
end;
if Registry.ValueExists('PNGTransparency') then begin if Registry.ValueExists('PNGTransparency') then begin
PNGTransparency := Registry.ReadInteger('PNGTransparency'); PNGTransparency := Registry.ReadInteger('PNGTransparency');
@ -675,6 +681,7 @@ begin
// ResizeOnLoad := False; // ResizeOnLoad := False;
ShowProgress := true; ShowProgress := true;
SaveIncompleteRenders := false; SaveIncompleteRenders := false;
LowerRenderPriority := false;
ShowRenderStats := false; ShowRenderStats := false;
PNGTransparency := 1; PNGTransparency := 1;
ShowTransparency := False; ShowTransparency := False;
@ -1132,6 +1139,7 @@ begin
Registry.WriteBool('SaveIncompleteRenders', SaveIncompleteRenders); Registry.WriteBool('SaveIncompleteRenders', SaveIncompleteRenders);
Registry.WriteBool('ShowRenderStats', ShowRenderStats); Registry.WriteBool('ShowRenderStats', ShowRenderStats);
Registry.WriteBool('LowerRenderPriority', LowerRenderPriority);
Registry.WriteInteger('NrTreads', NrTreads); Registry.WriteInteger('NrTreads', NrTreads);
Registry.WriteInteger('UseNrThreads', UseNrThreads); Registry.WriteInteger('UseNrThreads', UseNrThreads);

View File

@ -66,6 +66,7 @@ type
FCompatibility: integer; FCompatibility: integer;
FNumThreads: integer; FNumThreads: integer;
FNumBatches: integer;//int64; FNumBatches: integer;//int64;
FThreadPriority: TThreadPriority;
FMinDensity: double; FMinDensity: double;
FMinBatches: integer; FMinBatches: integer;
@ -112,6 +113,7 @@ type
procedure BreakRender; virtual; procedure BreakRender; virtual;
procedure Pause; virtual; procedure Pause; virtual;
procedure UnPause; virtual; procedure UnPause; virtual;
procedure SetThreadPriority(p: TThreadPriority); virtual;
function Failed: boolean; function Failed: boolean;
@ -187,6 +189,7 @@ begin
FNumSlices := 1; FNumSlices := 1;
FSlice := 0; FSlice := 0;
FStop := 0; // False; FStop := 0; // False;
FThreadPriority := tpNormal;
FImageMaker := TImageMaker.Create; FImageMaker := TImageMaker.Create;
end; end;
@ -242,6 +245,11 @@ begin
TimeTrace('Resuming render'); TimeTrace('Resuming render');
end; end;
procedure TBaseRenderer.SetThreadPriority(p: TThreadPriority);
begin
FThreadPriority := p;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Stop; procedure TBaseRenderer.Stop;
begin begin
@ -311,7 +319,7 @@ begin
strOutput.Add(Format(' Max Count: %2.3f bits', [Abits])); strOutput.Add(Format(' Max Count: %2.3f bits', [Abits]));
strOutput.Add(Format(' Point hit ratio: %2.2f%%', [100.0*(TotalA/TotalSamples)])); strOutput.Add(Format(' Point hit ratio: %2.2f%%', [100.0*(TotalA/TotalSamples)]));
if RenderTime > 0 then // hmm if RenderTime > 0 then // hmm
strOutput.Add(Format(' Average speed: %n points per second', [TotalSamples / (RenderTime * 24 * 60 * 60)])); strOutput.Add(Format(' Average speed: %n iterations per second', [TotalSamples / (RenderTime * 24 * 60 * 60)]));
strOutput.Add(' Pure rendering time:' + TimeToString(RenderTime)); strOutput.Add(' Pure rendering time:' + TimeToString(RenderTime));
end; end;
end; end;
@ -324,7 +332,7 @@ begin
TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ? TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ?
if RenderTime > 0 then // hmm if RenderTime > 0 then // hmm
strOutput.Add(Format(' Average speed: %n points per second', [TotalSamples / (RenderTime * 24 * 60 * 60)])); strOutput.Add(Format(' Average speed: %n iterations per second', [TotalSamples / (RenderTime * 24 * 60 * 60)]));
strOutput.Add(' Pure rendering time:' + TimeToString(RenderTime)); strOutput.Add(' Pure rendering time:' + TimeToString(RenderTime));
end; end;

View File

@ -49,6 +49,7 @@ type
procedure Pause; override; procedure Pause; override;
procedure UnPause; override; procedure UnPause; override;
procedure SetThreadPriority(p: TThreadPriority); override;
end; end;
@ -165,11 +166,22 @@ begin
WorkingThreads[i].Resume; WorkingThreads[i].Resume;
end; end;
procedure TBaseMTRenderer.SetThreadPriority(p: TThreadPriority);
var
i: integer;
begin
inherited;
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Priority := p;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
function TBaseMTRenderer.NewThread: TBucketFillerThread; function TBaseMTRenderer.NewThread: TBucketFillerThread;
begin begin
Result := TBucketFillerThread.Create(fcp); Result := TBucketFillerThread.Create(fcp);
assert(Result<>nil); assert(Result<>nil);
Result.Priority := FThreadPriority;
if FCP.FAngle = 0 then if FCP.FAngle = 0 then
Result.AddPointsProc := self.AddPointsToBuckets Result.AddPointsProc := self.AddPointsToBuckets

View File

@ -73,6 +73,7 @@ type
procedure Suspend; procedure Suspend;
procedure Resume; procedure Resume;
procedure BreakRender; procedure BreakRender;
procedure SetPriority(p: TThreadPriority);
// procedure GetBucketStats(var Stats: TBucketStats); // procedure GetBucketStats(var Stats: TBucketStats);
procedure ShowBigStats; procedure ShowBigStats;
@ -203,6 +204,7 @@ begin
end; end;
FRenderer.SetCP(FCP); FRenderer.SetCP(FCP);
FRenderer.SetThreadPriority(self.Priority);
// FRenderer.compatibility := compatibility; // FRenderer.compatibility := compatibility;
FRenderer.MinDensity := FMinDensity; FRenderer.MinDensity := FMinDensity;
FRenderer.OnProgress := FOnProgress; FRenderer.OnProgress := FOnProgress;
@ -275,6 +277,14 @@ begin
FRenderer.BreakRender; FRenderer.BreakRender;
end; end;
procedure TRenderThread.SetPriority(p: TThreadPriority);
begin
Priority := p;
if assigned(FRenderer) then
FRenderer.SetThreadPriority(p);
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetNrSlices: integer; function TRenderThread.GetNrSlices: integer;
begin begin