Multithread rendering

2.10/Source/BucketFillerThread.pas

@@ -0,0 +1,169 @@
+unit BucketFillerThread;
+
+interface
+
+uses
+  Classes, Windows,
+  Controlpoint,Render;
+
+type
+  TBucketFillerThread = class(TThread)
+  private
+    fcp: TControlPoint;
+    points: TPointsArray;
+  public
+    nrbatches: integer;
+    batchcounter: Pinteger;
+
+    BucketWidth: Int64;
+    BucketHeight: Int64;
+    bounds: array[0..3] of extended;
+    size: array[0..1] of extended;
+    RotationCenter: array[0..1] of extended;
+    Buckets: PBucketArray;
+    ColorMap: TColorMapArray;
+    CriticalSection: TRTLCriticalSection;
+
+    constructor Create(cp: TControlPoint);
+    destructor Destroy; override;
+
+    procedure Execute; override;
+
+    procedure AddPointsToBuckets(const points: TPointsArray); overload;
+    procedure AddPointsToBucketsAngle(const points: TPointsArray); overload;
+  end;
+
+implementation
+
+{ PixelRenderThread }
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TBucketFillerThread.AddPointsToBuckets(const points: TPointsArray);
+var
+  i: integer;
+  px, py: double;
+  bws, bhs: double;
+  bx, by: double;
+  wx, wy: double;
+  Bucket: PBucket;
+  MapColor: PColorMapColor;
+begin
+  bws := (BucketWidth - 0.5)  * size[0];
+  bhs := (BucketHeight - 0.5) * size[1];
+  bx := bounds[0];
+  by := bounds[1];
+  wx := bounds[2] - bounds[0];
+  wy := bounds[3] - bounds[1];
+
+  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
+    px := points[i].x - bx;
+    py := points[i].y - by;
+
+    if ((px < 0) or (px > wx) or
+        (py < 0) or (py > wy)) then
+      continue;
+
+    MapColor := @ColorMap[Round(points[i].c * 255)];
+    Bucket := @TbucketArray(buckets^)[Round(bws * px) + Round(bhs * py) * BucketWidth];
+
+    Inc(Bucket.Red,   MapColor.Red);
+    Inc(Bucket.Green, MapColor.Green);
+    Inc(Bucket.Blue,  MapColor.Blue);
+    Inc(Bucket.Count);
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TBucketFillerThread.AddPointsToBucketsAngle(const points: TPointsArray);
+var
+  i: integer;
+  px, py: double;
+  ca,sa: double;
+  nx, ny: double;
+  bws, bhs: double;
+  bx, by: double;
+  wx, wy: double;
+  Bucket: PBucket;
+  MapColor: PColorMapColor;
+begin
+  bws := (BucketWidth - 0.5)  * size[0];
+  bhs := (BucketHeight - 0.5) * size[1];
+  bx := bounds[0];
+  by := bounds[1];
+  wx := bounds[2] - bounds[0];
+  wy := bounds[3] - bounds[1];
+
+  ca := cos(FCP.FAngle);
+  sa := sin(FCP.FAngle);
+
+  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
+    px := points[i].x - RotationCenter[0];
+    py := points[i].y - RotationCenter[1];
+
+    nx := px * ca + py * sa;
+    ny := -px * sa + py * ca;
+
+    px := nx + FCP.Center[0] - bx;
+    py := ny + FCP.Center[1] - by;
+
+    if ((px < 0) or (px > wx) or
+        (py < 0) or (py > wy)) then
+      continue;
+
+    MapColor := @ColorMap[Round(points[i].c * 255)];
+    Bucket := @TbucketArray(buckets^)[Round(bws * px) + Round(bhs * py) * BucketWidth];
+
+    Inc(Bucket.Red,   MapColor.Red);
+    Inc(Bucket.Green, MapColor.Green);
+    Inc(Bucket.Blue,  MapColor.Blue);
+    Inc(Bucket.Count);
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+constructor TBucketFillerThread.Create(cp: TControlPoint);
+begin
+  inherited Create(True);
+  Self.FreeOnTerminate := True;
+
+  Fcp := cp.Clone;
+
+  SetLength(Points, SUB_BATCH_SIZE);
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+destructor TBucketFillerThread.Destroy;
+begin
+   FCP.Free;
+
+  inherited;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TBucketFillerThread.Execute;
+var
+  bc: integer;
+begin
+  inherited;
+
+  bc := 0;
+  while (not Terminated) and (bc < Nrbatches) do begin
+    fcp.iterateXYC(SUB_BATCH_SIZE, points);
+    try
+      EnterCriticalSection(CriticalSection);
+
+      if FCP.FAngle = 0 then
+        AddPointsToBuckets(Points)
+      else
+        AddPointsToBucketsAngle(Points);
+
+      Inc(batchcounter^);
+      bc := batchcounter^
+    finally
+      LeaveCriticalSection(CriticalSection);
+    end;
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+end.

2.10/Source/ControlPoint.pas

@@ -21,7 +21,7 @@ unit ControlPoint;
 interface
 
 uses
-  Classes, Windows, Cmap, Xform;
+  Classes, Windows, Cmap, Xform, XFormMan;
 
 const
   EPS = 1E-10;
@@ -30,6 +30,7 @@ const
   PREFILTER_WHITE = (1 shl 26);
   FILTER_CUTOFF = 1.8;
   BRIGHT_ADJUST = 2.3;
+  FUSE = 15;
 
 type
   TVariation = (vLinear, vSinusoidal, vSpherical, vSwirl, vHorseshoe, vPolar,
@@ -131,6 +132,7 @@ type
 
 function add_symmetry_to_control_point(var cp: TControlPoint; sym: integer): integer;
 function CalcUPRMagn(const cp: TControlPoint): double;
+procedure FillVarDisturb;
 
 implementation
 
@@ -139,8 +141,8 @@ uses
   SysUtils, math, global;
 
 var
-  var_distrib: array[0..NRVISVAR + 18] of integer;
+  var_distrib: array of integer;
-  mixed_var_distrib: array[0..NRVISVAR + 8] of integer;
+  mixed_var_distrib: array of integer;
 
 { TControlPoint }
 
@@ -242,6 +244,7 @@ var
   i: Integer;
   px, py, pc: double;
   dx, dy, tx, ty: double;
+  nx, ny: double;
   r: double;
   s, v, a: double;
   n0, n1, m0, m1: double;
@@ -252,7 +255,7 @@ begin
 
   PreparePropTable;
 
-  for i := -100 to NrPoints - 1 do begin
+  for i := -FUSE to NrPoints - 1 do begin
     with xform[PropTable[Random(1024)]] do begin
 
       // first compute the color coord
@@ -481,20 +484,20 @@ begin
   for i := 0 to NXFORMS - 1 do
     xform[i].prepare;
 
-  for i := -100 to NrPoints - 1 do begin
+  try
-    try
+    for i := 0 to FUSE do
+      xform[PropTable[Random(1024)]].NextPointXY(px,py);
+
+    for i := 0 to NrPoints - 1 do begin
       xform[PropTable[Random(1024)]].NextPointXY(px,py);
-    except
-      on EMathError do begin
-        exit;
-      end;
-    end;
-    // store points
-    if i >= 0 then begin
       CurrentPoint := @Points[i];
       CurrentPoint.X := px;
       CurrentPoint.Y := py;
     end
+  except
+    on EMathError do begin
+      exit;
+    end;
   end;
 end;
 
@@ -514,21 +517,21 @@ begin
   for i := 0 to NXFORMS - 1 do
     xform[i].prepare;
 
-  for i := -100 to NrPoints - 1 do begin
+  try
-    try
+    for i := 0 to FUSE do
+      xform[PropTable[Random(1024)]].NextPoint(px,py,pc);
+
+    for i := 0 to NrPoints - 1 do begin
       xform[PropTable[Random(1024)]].NextPoint(px,py,pc);
-    except
-      on EMathError do begin
-        exit;
-      end;
-    end;
-    // store points
-    if i >= 0 then begin
       CurrentPoint := @Points[i];
       CurrentPoint.X := px;
       CurrentPoint.Y := py;
       CurrentPoint.C := pc;
     end
+  except
+    on EMathError do begin
+      exit;
+    end;
   end;
 end;
 
@@ -595,22 +598,22 @@ begin
   for i := 0 to NXFORMS - 1 do
     xform[i].prepare;
 
-  for i := -100 to NrPoints - 1 do begin
+  try
-    try
+    for i := 0 to FUSE do
+      xform[PropTable[Random(1024)]].NextPoint2C(px, py, pc1, pc2);
+
+    for i := 0 to NrPoints - 1 do begin
       xform[PropTable[Random(1024)]].NextPoint2C(px, py, pc1, pc2);
-    except
-      on EMathError do begin
-        exit;
-      end;
-    end;
-    // store points
-    if i >= 0 then begin
       CurrentPoint := @Points[i];
-      CurrentPoint.X  := px;
+      CurrentPoint.X := px;
-      CurrentPoint.Y  := py;
+      CurrentPoint.Y := py;
       CurrentPoint.C1 := pc1;
       CurrentPoint.C2 := pc2;
     end
+  except
+    on EMathError do begin
+      exit;
+    end;
   end;
 end;
 
@@ -635,19 +638,20 @@ begin
   for i := 0 to NXFORMS - 1 do
     xform[i].prepare;
 
-  for i := -100 to NrPoints - 1 do begin
+  try
-    try
+    for i := 0 to FUSE do
       xform[PropTable[Random(1024)]].NextPointXY(px,py);
-      if i >= 0 then begin
+
-        CurrentPoint := @Points[i];
+    for i := 0 to NrPoints - 1 do begin
-        CurrentPoint.X := px;
+      xform[PropTable[Random(1024)]].NextPointXY(px,py);
-        CurrentPoint.Y := py;
+      CurrentPoint := @Points[i];
-      end
+      CurrentPoint.X := px;
-    except
+      CurrentPoint.Y := py;
-      on EMathError do begin
+    end;
-        Result := True;
+  except
-        Exit;
+    on EMathError do begin
-      end;
+      Result := True;
+      Exit;
     end;
   end;
 
@@ -858,8 +862,9 @@ var
   rv: integer;
   VarPossible: boolean;
 begin
+  FillVarDisturb;
   VarPossible := false;
-  for j := 0 to NRVISVAR - 1 do begin
+  for j := 0 to NRVAR - 1 do begin
     VarPossible := VarPossible or Variations[j];
   end;
 
@@ -913,8 +918,9 @@ begin
 //nrXforms := xform_distrib[random(13)];
   nrXforms := random(Max - (Min - 1)) + Min;
 
+  FillVarDisturb;
   VarPossible := false;
-  for j := 0 to NRVISVAR - 1 do begin
+  for j := 0 to NRVAR - 1 do begin
     VarPossible := VarPossible or Variations[j];
   end;
 
@@ -1466,6 +1472,7 @@ end;
 
 function TControlPoint.Clone: TControlPoint;
 var
+  i: integer;
   sl: TStringList;
 begin
   sl := TStringList.Create;
@@ -1477,11 +1484,16 @@ begin
   Result.name := name;
   Result.nick := nick;
   Result.url := url;
+
+  for i := 0 to NXFORMS - 1 do
+    Result.xform[i].assign(xform[i]);
+
   sl.Free;
 end;
 
 procedure TControlPoint.Copy(cp1: TControlPoint);
 var
+  i: integer;
   sl: TStringList;
 begin
   Clear;
@@ -1493,6 +1505,10 @@ begin
   name := cp1.name;
   nick := cp1.nick;
   url := cp1.url;
+
+  for i := 0 to NXFORMS - 1 do
+    xform[i].assign(cp1.xform[i]);
+
   sl.Free;
 end;
 
@@ -1715,27 +1731,6 @@ begin
   FAngle := FAngle + Angle;
 end;
 
-///////////////////////////////////////////////////////////////////////////////
-procedure FillVarDisturb;
-const
-  startvar_distrib: array[0..26] of integer = (-1, -1, -1, -1, -1, -1, -1, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7);
-  startmixed_var_distrib: array[0..16] of integer = (0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 6, 6, 7);
-var
-  i: integer;
-begin
-  for i := 0 to High(startvar_distrib) do
-    var_distrib[i] := startvar_distrib[i];
-
-  for i := High(startvar_distrib) + 1 to high(var_distrib) do
-    var_distrib[i] := 8 + i - High(startvar_distrib) - 1;
-
-  for i := 0 to High(startmixed_var_distrib) do
-    mixed_var_distrib[i] := startmixed_var_distrib[i];
-
-  for i := High(startmixed_var_distrib) + 1 to high(mixed_var_distrib) do
-    mixed_var_distrib[i] := 8 + i - High(startmixed_var_distrib) - 1;
-end;
-
 ///////////////////////////////////////////////////////////////////////////////
 function TControlPoint.getppux: double;
 begin
@@ -1749,7 +1744,37 @@ begin
 end;
 
 ///////////////////////////////////////////////////////////////////////////////
-initialization
+var
-  FillVarDisturb
+  vdfilled: boolean = False;
+
+procedure FillVarDisturb;
+const
+  startvar_distrib: array[0..26] of integer = (-1, -1, -1, -1, -1, -1, -1, 0, 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7);
+  startmixed_var_distrib: array[0..16] of integer = (0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 6, 6, 7);
+var
+  i: integer;
+begin
+  if vdfilled then
+    Exit;
+
+  setlength(var_distrib, NRVAR + 19);
+  setlength(mixed_var_distrib, NRVAR + 9);
+
+  for i := 0 to High(startvar_distrib) do
+    var_distrib[i] := startvar_distrib[i];
+
+  for i := High(startvar_distrib) + 1 to high(var_distrib) do
+    var_distrib[i] := 8 + i - High(startvar_distrib) - 1;
+
+  for i := 0 to High(startmixed_var_distrib) do
+    mixed_var_distrib[i] := startmixed_var_distrib[i];
+
+  for i := High(startmixed_var_distrib) + 1 to high(mixed_var_distrib) do
+    mixed_var_distrib[i] := 8 + i - High(startmixed_var_distrib) - 1;
+
+  vdfilled := true;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
 end.
 

2.10/Source/Render32.pas

@@ -46,6 +46,11 @@ type
   PBucket = ^TBucket;
   TBucketArray = array of TBucket;
 
+  PLongintArray = ^TLongintArray;
+  TLongintArray = array[0..0] of Longint;
+  PByteArray = ^TByteArray;
+  TByteArray = array[0..0] of Byte;
+
 type
   TRenderer32 = class(TBaseRenderer)
   private

2.10/Source/Render64MT.pas

@@ -22,39 +22,14 @@ interface
 
 uses
   Windows, Classes, Graphics,
-   Render, Controlpoint, ImageMaker;
+   Render, Controlpoint, ImageMaker, BucketFillerthread;
-
-type
-  TPixelRenderThread = class(TThread)
-  private
-    fcp: TControlPoint;
-    points: TPointsArray;
-  public
-    nrbatches: integer;
-    batchcounter: Pinteger;
-
-    BucketWidth: Int64;
-    BucketHeight: Int64;
-    bounds: array[0..3] of extended;
-    size: array[0..1] of extended;
-    Buckets: PBucketArray;
-    ColorMap: TColorMapArray;
-    CriticalSection: TRTLCriticalSection;
-
-    constructor Create(cp: TControlPoint);
-
-    procedure Execute; override;
-
-    procedure AddPointsToBuckets(const points: TPointsArray); overload;
-    procedure AddPointsToBucketsAngle(const points: TPointsArray); overload;
-  end;
 
 type
   TRenderer64MT = class(TBaseRenderer)
   private
     oversample: Int64;
     batchcounter: Integer;
-    FNrBatches: Integer;
+    FNrBatches: Int64;
 
     BucketWidth: Int64;
     BucketHeight: Int64;
@@ -71,7 +46,7 @@ type
     size: array[0..1] of extended;
     ppux, ppuy: extended;
     FNrOfTreads: integer;
-    WorkingThreads: array of TPixelRenderThread;
+    WorkingThreads: array of TBucketFillerThread;
     CriticalSection: TRTLCriticalSection;
 
     FImageMaker: TImageMaker;
@@ -87,7 +62,7 @@ type
     procedure SetPixelsMT;
     procedure SetNrOfTreads(const Value: integer);
 
-    function NewThread: TPixelRenderThread;
+    function NewThread: TBucketFillerThread;
   public
     constructor Create; override;
     destructor Destroy; override;
@@ -239,6 +214,7 @@ procedure TRenderer64MT.SetPixelsMT;
 var
   i: integer;
   nsamples: Int64;
+  bc : integer;
 begin
   nsamples := Round(sample_density * bucketSize / (oversample * oversample));
   FNrBatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
@@ -251,13 +227,23 @@ begin
   for i := 0 to NrOfTreads - 1 do
     WorkingThreads[i] := NewThread;
 
-  while (Not FStop) and (batchcounter < FNrBatches) do begin
+  for i := 0 to NrOfTreads - 1 do
-    if batchcounter > 0 then
+    WorkingThreads[i].Resume;
-      Progress(batchcounter / FNrBatches)
-    else
-      Progress(0);
 
-    sleep(200)
+  bc := 0;
+  while (Not FStop) and (bc < FNrBatches) do begin
+    sleep(200);
+    try
+      EnterCriticalSection(CriticalSection);
+      if batchcounter > 0 then
+        Progress(batchcounter / FNrBatches)
+      else
+        Progress(0);
+
+       bc := batchcounter;
+     finally
+       LeaveCriticalSection(CriticalSection);
+     end;
   end;
 
   DeleteCriticalSection(CriticalSection);
@@ -325,146 +311,25 @@ begin
 end;
 
 ///////////////////////////////////////////////////////////////////////////////
-function TRenderer64MT.NewThread: TPixelRenderThread;
+function TRenderer64MT.NewThread: TBucketFillerThread;
 begin
-  Result := TPixelRenderThread.Create(fcp);
+  Result := TBucketFillerThread.Create(fcp);
-//  Result.OnTerminate := OnThreadTerminated;
   Result.BucketWidth := BucketWidth;
   Result.BucketHeight := BucketHeight;
+  Result.Buckets := @Buckets;
   Result.size[0] := size[0];
   Result.size[1] := size[1];
   Result.bounds[0] := Bounds[0];
   Result.bounds[1] := Bounds[1];
   Result.bounds[2] := Bounds[2];
   Result.bounds[3] := Bounds[3];
+  Result.RotationCenter[0] := FCP.Center[0];
+  Result.RotationCenter[1] := FCP.Center[1];
   Result.ColorMap := colorMap;
-  Result.Buckets := @Buckets;
   Result.CriticalSection := CriticalSection;
   Result.Nrbatches := FNrBatches;
   Result.batchcounter := @batchcounter;
-  Result.Resume;
+//  Result.Resume;
-end;
-
-{ PixelRenderThread }
-
-///////////////////////////////////////////////////////////////////////////////
-procedure TPixelRenderThread.AddPointsToBuckets(const points: TPointsArray);
-var
-  i: integer;
-  px, py: double;
-  bws, bhs: double;
-  bx, by: double;
-  wx, wy: double;
-//  R: double;
-//  V1, v2, v3: integer;
-  Bucket: PBucket;
-  MapColor: PColorMapColor;
-begin
-  bws := (BucketWidth - 0.5)  * size[0];
-  bhs := (BucketHeight - 0.5) * size[1];
-  bx := bounds[0];
-  by := bounds[1];
-  wx := bounds[2] - bounds[0];
-  wy := bounds[3] - bounds[1];
-
-  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
-    px := points[i].x - bx;
-    py := points[i].y - by;
-
-    if ((px < 0) or (px > wx) or
-        (py < 0) or (py > wy)) then
-      continue;
-
-    MapColor := @ColorMap[Round(points[i].c * 255)];
-    Bucket := @TbucketArray(buckets^)[Round(bws * px) + Round(bhs * py) * BucketWidth];
-
-    Inc(Bucket.Red,   MapColor.Red);
-    Inc(Bucket.Green, MapColor.Green);
-    Inc(Bucket.Blue,  MapColor.Blue);
-    Inc(Bucket.Count);
-  end;
-end;
-
-///////////////////////////////////////////////////////////////////////////////
-procedure TPixelRenderThread.AddPointsToBucketsAngle(const points: TPointsArray);
-var
-  i: integer;
-  px, py: double;
-  ca,sa: double;
-  nx, ny: double;
-  bws, bhs: double;
-  bx, by: double;
-  wx, wy: double;
-  Bucket: PBucket;
-  MapColor: PColorMapColor;
-begin
-
-  bws := (BucketWidth - 0.5)  * size[0];
-  bhs := (BucketHeight - 0.5) * size[1];
-  bx := bounds[0];
-  by := bounds[1];
-  wx := bounds[2] - bounds[0];
-  wy := bounds[3] - bounds[1];
-
-  ca := cos(FCP.FAngle);
-  sa := sin(FCP.FAngle);
-
-  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
-    px := points[i].x - FCP.Center[0];
-    py := points[i].y - FCP.Center[1];
-
-    nx := px * ca + py * sa;
-    ny := -px * sa + py * ca;
-
-    px := nx + FCP.Center[0] - bx;
-    py := ny + FCP.Center[1] - by;
-
-    if ((px < 0) or (px > wx) or
-        (py < 0) or (py > wy)) then
-      continue;
-
-    MapColor := @ColorMap[Round(points[i].c * 255)];
-    Bucket := @TbucketArray(buckets^)[Round(bws * px) + Round(bhs * py) * BucketWidth];
-
-    Inc(Bucket.Red,   MapColor.Red);
-    Inc(Bucket.Green, MapColor.Green);
-    Inc(Bucket.Blue,  MapColor.Blue);
-    Inc(Bucket.Count);
-  end;
-end;
-
-///////////////////////////////////////////////////////////////////////////////
-constructor TPixelRenderThread.Create(cp: TControlPoint);
-begin
-  inherited Create(True);
-  Self.FreeOnTerminate := True;
-
-  fcp := cp;
-
-  SetLength(Points, SUB_BATCH_SIZE);
-end;
-
-///////////////////////////////////////////////////////////////////////////////
-procedure TPixelRenderThread.Execute;
-begin
-  inherited;
-
-//  while true do begin
-  while (not Terminated) and (batchcounter^ < Nrbatches) do begin
-    fcp.iterateXYC(SUB_BATCH_SIZE, points);
-    try
-      EnterCriticalSection(CriticalSection);
-
-      if FCP.FAngle = 0 then
-        AddPointsToBuckets(Points)
-      else
-        AddPointsToBucketsAngle(Points);
-
-      Inc(batchcounter^);
-    finally
-      LeaveCriticalSection(CriticalSection);
-    end;
-  end;
 end;
 
 ///////////////////////////////////////////////////////////////////////////////
@@ -473,5 +338,6 @@ begin
   FImageMaker.SaveImage(FileName);
 end;
 
+///////////////////////////////////////////////////////////////////////////////
 end.
 

2.10/Source/RenderMM.pas

@@ -28,8 +28,6 @@ type
   TRendererMM64 = class(TBaseRenderer)
   private
     oversample: Integer;
-    filter_width: Integer;
-    filter: array of array of extended;
 
     image_Width: Int64;
     image_Height: Int64;

2.10/Source/RenderMM_MT.pas

@@ -0,0 +1,512 @@
+{
+     Flame screensaver Copyright (C) 2002 Ronald Hordijk
+     Apophysis Copyright (C) 2001-2004 Mark Townsend
+
+     This program is free software; you can redistribute it and/or modify
+     it under the terms of the GNU General Public License as published by
+     the Free Software Foundation; either version 2 of the License, or
+     (at your option) any later version.
+
+     This program is distributed in the hope that it will be useful,
+     but WITHOUT ANY WARRANTY; without even the implied warranty of
+     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+     GNU General Public License for more details.
+
+     You should have received a copy of the GNU General Public License
+     along with this program; if not, write to the Free Software
+     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+}
+unit RenderMM_MT;
+
+interface
+
+uses
+  Windows, Graphics,
+   Render, Controlpoint, ImageMaker, BucketFillerThread;
+
+type
+  TRendererMM64_MT = class(TBaseRenderer)
+  private
+    oversample: Integer;
+
+    image_Width: Int64;
+    image_Height: Int64;
+    BucketWidth: Integer;
+    BucketHeight: Integer;
+    BucketSize: Integer;
+    gutter_width: Integer;
+
+    sample_density: extended;
+
+    Buckets: TBucketArray;
+    ColorMap: TColorMapArray;
+
+    bounds: array[0..3] of extended;
+    size: array[0..1] of extended;
+    FRotationCenter: array[0..1] of extended;
+    ppux, ppuy: extended;
+    nrSlices: int64;
+    Slice: int64;
+    FImageMaker: TImageMaker;
+    FNrBatches: int64;
+    batchcounter: Integer;
+
+    FNrOfTreads: integer;
+    WorkingThreads: array of TBucketFillerThread;
+    CriticalSection: TRTLCriticalSection;
+
+    procedure InitValues;
+    procedure InitBuffers;
+    procedure ClearBuffers;
+    procedure ClearBuckets;
+    procedure CreateColorMap;
+    procedure CreateCamera;
+
+    procedure AddPointsToBuckets(const points: TPointsArray); overload;
+    procedure AddPointsToBucketsAngle(const points: TPointsArray); overload;
+
+    procedure SetPixels;
+    procedure SetPixelsMT;
+    procedure SetNrOfTreads(const Value: integer);
+
+    function NewThread: TBucketFillerThread;
+  protected
+    function GetSlice: integer; override;
+    function GetNrSlices: integer; override;
+
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+
+    function  GetImage: TBitmap; override;
+    procedure SaveImage(const FileName: String); override;
+
+    procedure Render; override;
+
+    property NrOfTreads: integer
+        read FNrOfTreads
+       write SetNrOfTreads;
+  end;
+
+implementation
+
+uses
+  Math, Sysutils;
+
+{ TRendererMM64_MT }
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.ClearBuckets;
+var
+  i: integer;
+begin
+  for i := 0 to BucketSize - 1 do begin
+    buckets[i].Red   := 0;
+    buckets[i].Green := 0;
+    buckets[i].Blue  := 0;
+    buckets[i].Count := 0;
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.ClearBuffers;
+begin
+  ClearBuckets;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.CreateCamera;
+var
+  scale: double;
+  t0, t1: double;
+  corner0, corner1: double;
+  shift: Integer;
+begin
+  scale := power(2, fcp.zoom);
+  sample_density := fcp.sample_density * scale * scale;
+  ppux := fcp.pixels_per_unit * scale;
+  ppuy := fcp.pixels_per_unit * scale;
+  // todo field stuff
+  shift := 0;
+  t0 := gutter_width / (oversample * ppux);
+  t1 := gutter_width / (oversample * ppuy);
+  corner0 := fcp.center[0] - image_width / ppux / 2.0;
+  corner1 := fcp.center[1] - image_height / ppuy / 2.0;
+  bounds[0] := corner0 - t0;
+  bounds[1] := corner1 - t1 + shift;
+  bounds[2] := corner0 + image_width / ppux + t0;
+  bounds[3] := corner1 + image_height / ppuy + t1; //+ shift;
+  if abs(bounds[2] - bounds[0]) > 0.01 then
+    size[0] := 1.0 / (bounds[2] - bounds[0])
+  else
+    size[0] := 1;
+  if abs(bounds[3] - bounds[1]) > 0.01 then
+    size[1] := 1.0 / (bounds[3] - bounds[1])
+  else
+    size[1] := 1;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.CreateColorMap;
+var
+  i: integer;
+begin
+  for i := 0 to 255 do begin
+    ColorMap[i].Red   := (fcp.CMap[i][0] * fcp.white_level) div 256;
+    ColorMap[i].Green := (fcp.CMap[i][1] * fcp.white_level) div 256;
+    ColorMap[i].Blue  := (fcp.CMap[i][2] * fcp.white_level) div 256;
+//    cmap[i][3] := fcp.white_level;
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+destructor TRendererMM64_MT.Destroy;
+begin
+  FImageMaker.Free;
+
+  inherited;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+function TRendererMM64_MT.GetImage: TBitmap;
+begin
+  Result := FImageMaker.GetImage;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.InitBuffers;
+begin
+  oversample := fcp.spatial_oversample;
+  gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
+  BucketHeight := oversample * image_height + 2 * gutter_width;
+  Bucketwidth := oversample * image_width + 2 * gutter_width;
+  BucketSize := BucketWidth * BucketHeight;
+
+  if high(buckets) <> (BucketSize - 1) then begin
+    SetLength(buckets, BucketSize);
+  end;
+
+  // share the buffer with imagemaker
+  FImageMaker.SetBucketData(Buckets, BucketWidth);
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.InitValues;
+begin
+  image_height := fcp.Height;
+  image_Width := fcp.Width;
+
+  CreateCamera;
+
+  InitBuffers;
+
+  CreateColorMap;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.AddPointsToBuckets(const points: TPointsArray);
+var
+  i: integer;
+  px, py: double;
+  bws, bhs: double;
+  bx, by: double;
+  wx, wy: double;
+//  R: double;
+//  V1, v2, v3: integer;
+  Bucket: PBucket;
+  MapColor: PColorMapColor;
+begin
+  bws := (BucketWidth - 0.5)  * size[0];
+  bhs := (BucketHeight - 0.5) * size[1];
+  bx := bounds[0];
+  by := bounds[1];
+  wx := bounds[2] - bounds[0];
+  wy := bounds[3] - bounds[1];
+
+  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
+    if FStop then
+      Exit;
+
+    px := points[i].x - bx;
+    py := points[i].y - by;
+
+    if ((px < 0) or (px > wx) or
+        (py < 0) or (py > wy)) then
+      continue;
+
+    MapColor := @ColorMap[Round(points[i].c * 255)];
+    Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
+
+    Inc(Bucket.Red,   MapColor.Red);
+    Inc(Bucket.Green, MapColor.Green);
+    Inc(Bucket.Blue,  MapColor.Blue);
+    Inc(Bucket.Count);
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.AddPointsToBucketsAngle(const points: TPointsArray);
+var
+  i: integer;
+  px, py: double;
+  ca,sa: double;
+  nx, ny: double;
+  bws, bhs: double;
+  bx, by: double;
+  wx, wy: double;
+//  R: double;
+//  V1, v2, v3: integer;
+  Bucket: PBucket;
+  MapColor: PColorMapColor;
+begin
+
+  bws := (BucketWidth - 0.5)  * size[0];
+  bhs := (BucketHeight - 0.5) * size[1];
+  bx := bounds[0];
+  by := bounds[1];
+  wx := bounds[2] - bounds[0];
+  wy := bounds[3] - bounds[1];
+
+  ca := cos(FCP.FAngle);
+  sa := sin(FCP.FAngle);
+
+  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
+    if FStop then
+      Exit;
+
+    px := points[i].x - FRotationCenter[0];
+    py := points[i].y - FRotationCenter[1];
+
+    nx := px * ca + py * sa;
+    ny := -px * sa + py * ca;
+
+    px := nx + FRotationCenter[0] - bx;
+    py := ny + FRotationCenter[1] - by;
+
+    if ((px < 0) or (px > wx) or
+        (py < 0) or (py > wy)) then
+      continue;
+
+    MapColor := @ColorMap[Round(points[i].c * 255)];
+    Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
+
+    Inc(Bucket.Red,   MapColor.Red);
+    Inc(Bucket.Green, MapColor.Green);
+    Inc(Bucket.Blue,  MapColor.Blue);
+    Inc(Bucket.Count);
+  end;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.SetPixels;
+var
+  i: integer;
+  nsamples: Int64;
+  nrbatches: Integer;
+  points: TPointsArray;
+begin
+  SetLength(Points, SUB_BATCH_SIZE);
+
+  nsamples := Round(sample_density * bucketSize / (oversample * oversample));
+  nrbatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
+  Randomize;
+
+  for i := 0 to nrbatches do begin
+    if FStop then
+      Exit;
+
+    if (i and $F = 0) then
+      if nrbatches > 0 then
+        Progress(i / nrbatches)
+      else
+        Progress(0);
+
+    // generate points
+    case Compatibility of
+      0: fcp.iterate_Old(SUB_BATCH_SIZE, points);
+      1: fcp.iterateXYC(SUB_BATCH_SIZE, points);
+    end;
+
+    if FCP.FAngle = 0 then
+      AddPointsToBuckets(points)
+    else
+      AddPointsToBucketsAngle(points);
+  end;
+
+  Progress(1);
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+constructor TRendererMM64_MT.Create;
+begin
+  inherited Create;
+
+  FImageMaker  := TImageMaker.Create;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.Render;
+const
+  Dividers: array[0..15] of integer = (1, 2, 3, 4, 5, 6, 7, 8, 10, 16, 20, 32, 64, 128, 256, 512);
+var
+  ApproxMemory, MaxMemory: int64;
+  i: integer;
+  zoom_scale, center_base, center_y: double;
+begin
+  FStop := False;
+
+  FRotationCenter[0] := fcp.center[0];
+  FRotationCenter[1] := fcp.center[1];
+
+  image_height := fcp.Height;
+  image_Width := fcp.Width;
+  oversample := fcp.spatial_oversample;
+
+  // entered memory - imagesize
+  MaxMemory := FMaxMem * 1024 * 1024 - 4 * image_height * image_width;
+
+  ApproxMemory := 32 * oversample * oversample * image_height * image_width;
+
+  if (MaxMemory < 0) then
+    Exit;
+
+  nrSlices := 1 + ApproxMemory div MaxMemory;
+
+  if nrSlices > Dividers[High(Dividers)] then begin
+    for i := High(Dividers) downto 0 do begin
+      if image_height <> (image_height div dividers[i]) * dividers[i] then begin
+        nrSlices := dividers[i];
+        break;
+      end;
+    end;
+  end else begin
+    for i := 0 to High(Dividers) do begin
+      if image_height <> (image_height div dividers[i]) * dividers[i] then
+        continue;
+      if nrslices <= dividers[i] then begin
+        nrSlices := dividers[i];
+        break;
+      end;
+    end;
+  end;
+
+  FImageMaker.SetCP(FCP);
+  FImageMaker.Init;
+
+  fcp.sample_density := fcp.sample_density * nrslices;
+  fcp.height := fcp.height div nrslices;
+  center_y := fcp.center[1];
+  zoom_scale := power(2.0, fcp.zoom);
+  center_base := center_y - ((nrslices - 1) * fcp.height) /  (2 * fcp.pixels_per_unit * zoom_scale);
+
+  InitValues;
+
+  for i := 0 to NrSlices - 1 do begin
+    if FStop then
+      Exit;
+
+    Slice := i;
+    fcp.center[1] := center_base + fcp.height * slice / (fcp.pixels_per_unit * zoom_scale);
+    CreateCamera;
+    ClearBuffers;
+    SetPixelsMT;
+
+    if not FStop then begin
+      FImageMaker.OnProgress := OnProgress;
+      FImageMaker.CreateImage(Slice * fcp.height);
+    end;
+  end;
+
+  fcp.sample_density := fcp.sample_density / nrslices;
+  fcp.height := fcp.height * nrslices;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+function TRendererMM64_MT.GetSlice: integer;
+begin
+  Result := Slice;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+function TRendererMM64_MT.GetNrSlices: integer;
+begin
+  Result := NrSlices;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.SaveImage(const FileName: String);
+begin
+  FImageMaker.SaveImage(FileName);
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.SetNrOfTreads(const Value: integer);
+begin
+  FNrOfTreads := Value;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+procedure TRendererMM64_MT.SetPixelsMT;
+var
+  i: integer;
+  nsamples: Int64;
+  bc : integer;
+begin
+  nsamples := Round(sample_density * bucketSize / (oversample * oversample));
+  FNrBatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
+  batchcounter := 0;
+  Randomize;
+
+  InitializeCriticalSection(CriticalSection);
+
+  SetLength(WorkingThreads, NrOfTreads);
+  for i := 0 to NrOfTreads - 1 do
+    WorkingThreads[i] := NewThread;
+
+  for i := 0 to NrOfTreads - 1 do
+    WorkingThreads[i].Resume;
+
+  bc := 0;
+  while (Not FStop) and (bc < FNrBatches) do begin
+    sleep(200);
+    try
+      EnterCriticalSection(CriticalSection);
+      if batchcounter > 0 then
+        Progress(batchcounter / FNrBatches)
+      else
+        Progress(0);
+
+       bc := batchcounter;
+     finally
+       LeaveCriticalSection(CriticalSection);
+     end;
+  end;
+
+  DeleteCriticalSection(CriticalSection);
+  Progress(1);
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+function TRendererMM64_MT.NewThread: TBucketFillerThread;
+begin
+  Result := TBucketFillerThread.Create(fcp);
+  Result.BucketWidth := BucketWidth;
+  Result.BucketHeight := BucketHeight;
+  Result.Buckets := @Buckets;
+  Result.size[0] := size[0];
+  Result.size[1] := size[1];
+  Result.bounds[0] := Bounds[0];
+  Result.bounds[1] := Bounds[1];
+  Result.bounds[2] := Bounds[2];
+  Result.bounds[3] := Bounds[3];
+  Result.RotationCenter[0] := FRotationCenter[0];
+  Result.RotationCenter[1] := FRotationCenter[1];
+  Result.ColorMap := colorMap;
+  Result.CriticalSection := CriticalSection;
+  Result.Nrbatches := FNrBatches;
+  Result.batchcounter := @batchcounter;
+end;
+
+///////////////////////////////////////////////////////////////////////////////
+end.
+

2.10/Source/RenderThread.pas

@@ -22,7 +22,7 @@ interface
 
 uses
   Classes, windows, Messages, Graphics,
-   controlPoint, Render, Render64, Render64MT, RenderMM;
+   controlPoint, Render, Render64, Render64MT, RenderMM, RenderMM_MT;
 
 const
   WM_THREAD_COMPLETE = WM_APP + 5437;
@@ -132,7 +132,12 @@ begin
       TRenderer64MT(FRenderer).NrOfTreads := NrThreads;
     end;
   end else begin
-    FRenderer := TRendererMM64.Create;
+    if NrThreads <= 1 then begin
+      FRenderer := TRendererMM64.Create;
+    end else begin
+      FRenderer := TRendererMM64_MT.Create;
+      TRendererMM64_MT(FRenderer).NrOfTreads := NrThreads;
+    end;
     FRenderer.MaxMem := MaxMem
   end;