apophysis/2.10/Source/BucketFillerThread.pas

unit BucketFillerThread;

interface

uses
  Classes, Windows,
  ControlPoint, Render, XForm;

type
  TBucketFillerThread = class(TThread)
  private
    fcp: TControlPoint;
    points: TPointsArray;
  public
    nrbatches: integer;
    batchcounter: Pinteger;

    BucketWidth, BucketHeight: integer;

    camX0, camY0, camW, camH,
    bws, bhs, cosa, sina, rcX, rcY: double;

    Buckets: PBucketArray;
    ColorMap: TColorMapArray;
    CriticalSection: TRTLCriticalSection;

    constructor Create(cp: TControlPoint);
    destructor Destroy; override;

    procedure Execute; override;

    procedure AddPointsToBuckets(const points: TPointsArray);
    procedure AddPointsToBucketsAngle(const points: TPointsArray);
  end;

implementation

{ PixelRenderThread }

///////////////////////////////////////////////////////////////////////////////
procedure TBucketFillerThread.AddPointsToBuckets(const points: TPointsArray);
var
  i: integer;
  px, py: double;
//  R: double;
//  V1, v2, v3: integer;
  Bucket: PBucket;
  MapColor: PColorMapColor;
begin
  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
//    if FStop then Exit;

    px := points[i].x - camX0;
    if (px < 0) or (px > camW) then continue;
    py := points[i].y - camY0;
    if (py < 0) or (py > camH) then continue;

    Bucket := @TBucketArray(buckets^)[Round(bws * px) + Round(bhs * py) * BucketWidth];
    MapColor := @ColorMap[Round(points[i].c * 255)];

    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;
  Bucket: PBucket;
  MapColor: PColorMapColor;
begin
  for i := SUB_BATCH_SIZE - 1 downto 0 do begin
//    if FStop then Exit;

    px := points[i].x * cosa + points[i].y * sina + rcX;
    if (px < 0) or (px > camW) then continue;
    py := points[i].y * cosa - points[i].x * sina + rcY;
    if (py < 0) or (py > camH) then continue;

    Bucket := @TBucketArray(buckets^)[Round(bws * px) + Round(bhs * py) * BucketWidth];
    MapColor := @ColorMap[Round(points[i].c * 255)];

    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);
var
  i, n: integer;
begin
  inherited Create(True);
  Self.FreeOnTerminate := True;

  Fcp := cp.Clone;

  SetLength(Points, SUB_BATCH_SIZE);

  fcp.Prepare;
end;

///////////////////////////////////////////////////////////////////////////////
destructor TBucketFillerThread.Destroy;
begin
  FCP.Free;

  inherited;
end;

///////////////////////////////////////////////////////////////////////////////
procedure TBucketFillerThread.Execute;
var
  bc: integer;
  AddPointsProc: procedure (const points: TPointsArray) of object;
begin
  inherited;

  if FCP.FAngle = 0 then 
    AddPointsProc := AddPointsToBuckets
  else
    AddPointsProc := AddPointsToBucketsAngle;

  bc := 0;
  while (not Terminated) and (bc < Nrbatches) do begin
    fcp.iterateXYC(SUB_BATCH_SIZE, points);
    try
      EnterCriticalSection(CriticalSection);

      AddPointsProc(Points);

      Inc(batchcounter^);
      bc := batchcounter^
    finally
      LeaveCriticalSection(CriticalSection);
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////
end.