laz-doublcmd/components/Image32/source/Img32.Draw.pas

unit Img32.Draw;

(*******************************************************************************
* Author    :  Angus Johnson                                                   *
* Version   :  4.8                                                             *
* Date      :  10 January 2025                                                 *
* Website   :  http://www.angusj.com                                           *
* Copyright :  Angus Johnson 2019-2025                                         *
*                                                                              *
* Purpose   :  Polygon renderer for TImage32                                   *
*                                                                              *
* License   :  Use, modification & distribution is subject to                  *
*              Boost Software License Ver 1                                    *
*              http://www.boost.org/LICENSE_1_0.txt                            *
*******************************************************************************)

interface

{$I Img32.inc}

uses
  SysUtils, Classes, Types, Math, Img32, Img32.Vector;

type
  TFillRule = Img32.Vector.TFillRule;

  // TGradientColor: used internally by both
  // TLinearGradientRenderer and TRadialGradientRenderer
  TGradientColor = record
    offset: double;
    color: TColor32;
  end;
  TArrayOfGradientColor = array of TGradientColor;

  TGradientFillStyle = (gfsClamp, gfsMirror, gfsRepeat);

  // TBoundsProc: Function template for TCustomRenderer.
  TBoundsProc = function(dist, colorsCnt: integer): integer;
  TBoundsProcD = function(dist: double; colorsCnt: integer): integer;

  TImage32ChangeProc = procedure of object;

  // TCustomRenderer: can accommodate pixels of any size
  TCustomRenderer = class {$IFDEF ABSTRACT_CLASSES} abstract {$ENDIF}
  private
    fImgWidth    : integer;
    fImgHeight   : integer;
    fImgBase     : Pointer;
    fCurrY       : integer;
    fCurrLinePtr : Pointer;
    fPixelSize   : integer;
    fChangeProc  : TImage32ChangeProc;
    fOpacity     : Byte;
  protected
    procedure NotifyChange;
    function Initialize(imgBase: Pointer;
      imgWidth, imgHeight, pixelSize: integer): Boolean; overload; virtual;
    function Initialize(targetImage: TImage32): Boolean; overload; virtual;
    function GetDstPixel(x,y: integer): Pointer;
    // RenderProc: x & y refer to pixel coords in the destination image and
    // where x1 is the start (and left) and x2 is the end of the render
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); virtual; abstract;
    // RenderProcSkip: is called for every skipped line block if
    // SupportsRenderProcSkip=True and the Rasterize() function skips scanlines.
    procedure RenderProcSkip(const skippedRect: TRect); virtual;
    // SetClipRect is called by the Rasterize() function with the
    // rasterization clipRect. The default implementation does nothing.
    procedure SetClipRect(const clipRect: TRect); virtual;
    // If SupportsRenderProcSkip returns True the Rasterize() function
    // will call RenderProcSkip() for every scanline where it didn't have
    // anything to rasterize.
    function SupportsRenderProcSkip: Boolean; virtual;
  public
    constructor Create; virtual;
    property ImgWidth: integer read fImgWidth;
    property ImgHeight: integer read fImgHeight;
    property ImgBase: Pointer read fImgBase;
    property PixelSize: integer read fPixelSize;
    property Opacity: Byte read fOpacity write fOpacity;
  end;

  TCustomColorRenderer = class(TCustomRenderer)
  private
    fColor: TColor32;
  protected
    property Color: TColor32 read fColor write fColor;
  public
    procedure SetColor(value: TColor32); virtual;
  end;

  TColorRenderer = class(TCustomColorRenderer)
  private
    fAlpha: Byte;
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
    function Initialize(targetImage: TImage32): Boolean; override;
  public
    constructor Create(color: TColor32 = clNone32); reintroduce;
    procedure SetColor(value: TColor32); override;
  end;

  TAliasedColorRenderer = class(TCustomColorRenderer)
  protected
    function Initialize(targetImage: TImage32): Boolean; override;
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
  public
    constructor Create(color: TColor32 = clNone32); reintroduce;
  end;

  // TMaskRenderer masks all pixels inside the clipRect area
  // where the alpha[]-array is zero.
  TMaskRenderer = class(TCustomRenderer)
  private
    fClipRect: TRect;
  protected
    procedure SetClipRect(const clipRect: TRect); override;
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
    procedure RenderProcSkip(const skippedRect: TRect); override;
    function SupportsRenderProcSkip: Boolean; override;
  end;

  // TCustomRendererCache is used to not create Renderer
  // objects for every DrawPolygon/DrawLine function call. The color
  // of the TCustomColorRenderer will be changed by the DrawPolygon/
  // DrawLine method.
  TCustomRendererCache = class(TObject)
  private
    fColorRenderer: TColorRenderer;
    fAliasedColorRenderer: TAliasedColorRenderer;
    fMaskRenderer: TMaskRenderer;
  public
    constructor Create;
    destructor Destroy; override;
    function GetColorRenderer(color: TColor32): TColorRenderer;

    property ColorRenderer: TColorRenderer read fColorRenderer;
    property AliasedColorRenderer: TAliasedColorRenderer read fAliasedColorRenderer;
    property MaskRenderer: TMaskRenderer read fMaskRenderer;
  end;

  TEraseRenderer = class(TCustomRenderer)
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
  end;

  TInverseRenderer = class(TCustomRenderer)
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
  end;

  TImageRenderer = class(TCustomRenderer)
  private
    fImage        : TImage32;
    fOffset       : TPoint;
    fBrushPixel   :  PARGB;
    fLastYY       : integer;
    fMirrorY      : Boolean;
    fBoundsProc   : TBoundsProc;
    function GetFirstBrushPixel(x, y: integer): PColor32;
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
    function Initialize(targetImage: TImage32): Boolean; override;
  public
    constructor Create(tileFillStyle: TTileFillStyle = tfsRepeat;
      brushImage: TImage32 = nil); reintroduce;
    destructor Destroy; override;
    procedure SetTileFillStyle(value: TTileFillStyle);
    property Image: TImage32 read fImage;
    property Offset: TPoint read fOffset write fOffset;
  end;

  // TCustomGradientRenderer is also an abstract class
  TCustomGradientRenderer = class(TCustomRenderer)
  private
    fBoundsProc      : TBoundsProc;
    fGradientColors  : TArrayOfGradientColor;
  protected
    fColors          : TArrayOfColor32;
    fColorsCnt       : integer;
    procedure SetGradientFillStyle(value: TGradientFillStyle); virtual;
  public
    constructor Create; override;
    procedure SetParameters(startColor, endColor: TColor32;
      gradFillStyle: TGradientFillStyle = gfsClamp); virtual;
    procedure InsertColorStop(offsetFrac: double; color: TColor32);
    procedure Clear;
  end;

  TLinearGradientRenderer = class(TCustomGradientRenderer)
  private
    fStartPt         : TPointD;
    fEndPt           : TPointD;
    fPerpendicOffsets: TArrayOfInteger;
    fIsVert          : Boolean;
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
    function Initialize(targetImage: TImage32): Boolean; override;
  public
    procedure SetParameters(const startPt, endPt: TPointD;
      startColor, endColor: TColor32;
      gradFillStyle: TGradientFillStyle = gfsClamp); reintroduce;
  end;

  TRadialGradientRenderer = class(TCustomGradientRenderer)
  private
    fCenterPt       : TPointD;
    fScaleX         : double;
    fScaleY         : double;
    fColors         : TArrayOfColor32;
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
    function Initialize(targetImage: TImage32): Boolean; override;
  public
    procedure SetParameters(const focalRect: TRect;
      innerColor, outerColor: TColor32;
      gradientFillStyle: TGradientFillStyle = gfsClamp); reintroduce;
  end;

  TSvgRadialGradientRenderer = class(TCustomGradientRenderer)
  private
    fA, fB          : double;
    fAA, fBB        : double;
    fCenterPt       : TPointD;
    fFocusPt        : TPointD;
    fBoundsProcD    : TBoundsProcD;
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
    function Initialize(targetImage: TImage32): Boolean; override;
  public
    procedure SetParameters(const ellipseRect: TRect;
      const focus: TPoint; innerColor, outerColor: TColor32;
      gradientFillStyle: TGradientFillStyle = gfsClamp); reintroduce;
  end;

  // Barycentric rendering colorizes inside triangles
  TBarycentricRenderer = class(TCustomRenderer)
  private
    a: TPointD;
    c1, c2, c3: TARGB;
    v0, v1: TPointD;
    d00, d01, d11, invDenom: double;
    function GetColor(const pt: TPointD): TColor32;
  protected
    procedure RenderProc(x1, x2, y: integer; alpha: PByte); override;
  public
    procedure SetParameters(const a, b, c: TPointD; c1, c2, c3: TColor32);
  end;

  // /////////////////////////////////////////////////////////////////////////
  // DRAWING FUNCTIONS
  // /////////////////////////////////////////////////////////////////////////

  procedure DrawPoint(img: TImage32; const pt: TPointD;
    radius: double; color: TColor32); overload;
  procedure DrawPoint(img: TImage32; const pt: TPointD;
    radius: double; renderer: TCustomRenderer); overload;
  procedure DrawPoint(img: TImage32; const points: TPathD;
    radius: double; color: TColor32); overload;
  procedure DrawPoint(img: TImage32; const paths: TPathsD;
    radius: double; color: TColor32); overload;

  procedure DrawInvertedPoint(img: TImage32; const pt: TPointD; radius: double);

  procedure DrawLine(img: TImage32;
    const pt1, pt2: TPointD; lineWidth: double; color: TColor32); overload;
  procedure DrawLine(img: TImage32;
    const line: TPathD; lineWidth: double; color: TColor32;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    miterLimit: double = 2); overload;
  procedure DrawLine(img: TImage32;
    const line: TPathD; lineWidth: double; color: TColor32;
    rendererCache: TCustomRendererCache;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    miterLimit: double = 2); overload;
  procedure DrawLine(img: TImage32;
    const line: TPathD; lineWidth: double; renderer: TCustomRenderer;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    miterLimit: double = 2); overload;
  procedure DrawLine(img: TImage32; const lines: TPathsD;
    lineWidth: double; color: TColor32;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    miterLimit: double = 2); overload;
  procedure DrawLine(img: TImage32; const lines: TPathsD;
    lineWidth: double; color: TColor32; rendererCache: TCustomRendererCache;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    miterLimit: double = 2); overload;
  procedure DrawLine(img: TImage32; const lines: TPathsD;
    lineWidth: double; renderer: TCustomRenderer;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    miterLimit: double = 2); overload;

   procedure DrawInvertedLine(img: TImage32;
     const line: TPathD; lineWidth: double;
     endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto); overload;
   procedure DrawInvertedLine(img: TImage32;
     const lines: TPathsD; lineWidth: double;
     endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto); overload;

  procedure DrawDashedLine(img: TImage32; const line: TPathD;
    dashPattern: TArrayOfDouble; patternOffset: PDouble;
    lineWidth: double; color: TColor32;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto;
    rendererCache: TCustomRendererCache = nil); overload;
  procedure DrawDashedLine(img: TImage32; const lines: TPathsD;
    dashPattern: TArrayOfDouble; patternOffset: PDouble;
    lineWidth: double; color: TColor32; endStyle: TEndStyle;
    joinStyle: TJoinStyle = jsAuto;
    rendererCache: TCustomRendererCache = nil); overload;
  procedure DrawDashedLine(img: TImage32; const line: TPathD;
    dashPattern: TArrayOfDouble; patternOffset: PDouble;
    lineWidth: double; renderer: TCustomRenderer; endStyle: TEndStyle;
    joinStyle: TJoinStyle = jsAuto); overload;
  procedure DrawDashedLine(img: TImage32; const lines: TPathsD;
    dashPattern: TArrayOfDouble; patternOffset: PDouble;
    lineWidth: double; renderer: TCustomRenderer;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto); overload;

  procedure DrawInvertedDashedLine(img: TImage32;
    const line: TPathD; dashPattern: TArrayOfDouble;
    patternOffset: PDouble; lineWidth: double; endStyle: TEndStyle;
    joinStyle: TJoinStyle = jsAuto); overload;
  procedure DrawInvertedDashedLine(img: TImage32;
    const lines: TPathsD; dashPattern: TArrayOfDouble;
    patternOffset: PDouble; lineWidth: double;
    endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto); overload;

  procedure DrawPolygon(img: TImage32; const polygon: TPathD;
    fillRule: TFillRule; color: TColor32); overload;
  procedure DrawPolygon(img: TImage32; const polygon: TPathD;
    fillRule: TFillRule; renderer: TCustomRenderer); overload;
  procedure DrawPolygon(img: TImage32; const polygons: TPathsD;
    fillRule: TFillRule; color: TColor32); overload;
  procedure DrawPolygon(img: TImage32; const polygons: TPathsD;
    fillRule: TFillRule; color: TColor32;
    rendererCache: TCustomRendererCache); overload;
  procedure DrawPolygon(img: TImage32; const polygons: TPathsD;
    fillRule: TFillRule; renderer: TCustomRenderer); overload;

  procedure DrawInvertedPolygon(img: TImage32; const polygon: TPathD;
    fillRule: TFillRule); overload;
  procedure DrawInvertedPolygon(img: TImage32; const polygons: TPathsD;
    fillRule: TFillRule); overload;

  // 'Clear Type' text rendering is quite useful for low resolution
  // displays (96 ppi). However it's of little to no benefit on higher
  // resolution displays and becomes unnecessary overhead. See also:
  // https://en.wikipedia.org/wiki/Subpixel_rendering
  // https://www.grc.com/ctwhat.htm
  // https://www.grc.com/cttech.htm
  procedure DrawPolygon_ClearType(img: TImage32; const polygons: TPathsD;
    fillRule: TFillRule; color: TColor32; backColor: TColor32 = clWhite32);

  // /////////////////////////////////////////////////////////////////////////
  // MISCELLANEOUS FUNCTIONS
  // /////////////////////////////////////////////////////////////////////////

  procedure ErasePolygon(img: TImage32; const polygon: TPathD;
    fillRule: TFillRule); overload;
  procedure ErasePolygon(img: TImage32; const polygons: TPathsD;
    fillRule: TFillRule); overload;

  // Both DrawBoolMask and DrawAlphaMask require
  // 'mask' length to equal 'img' width * height
  procedure DrawBoolMask(img: TImage32;
    const mask: TArrayOfByte; color: TColor32 = clBlack32);
  procedure DrawAlphaMask(img: TImage32;
    const mask: TArrayOfByte; color: TColor32 = clBlack32);

  procedure Rasterize(const paths: TPathsD;
    const clipRec: TRect; fillRule: TFillRule; renderer: TCustomRenderer); overload;
  procedure Rasterize(img: TImage32; const paths: TPathsD;
    const clipRec: TRect; fillRule: TFillRule; renderer: TCustomRenderer); overload;

implementation

{$IFDEF CPUX86}
const
  // Use faster Trunc for x86 code in this unit.
  Trunc: function(Value: Double): Integer = __Trunc;
{$ENDIF CPUX86}

type

  // A horizontal scanline contains any number of line fragments. A fragment
  // can be a number of pixels wide but it can't be more than one pixel high.
  PFragment = ^TFragment;
  TFragment = record
    botX, topX, dy, dydx: double; // ie x at bottom and top of scanline
  end;

  TScanLine = record
    Y: integer;
    minX, maxX: integer;
    fragCnt: integer;
    fragOffset: integer;
  end;
  PScanline = ^TScanline;
  TArrayOfScanline = array of TScanline;

// ------------------------------------------------------------------------------
// ApplyClearType (see DrawPolygon_ClearType below)
// ------------------------------------------------------------------------------

type
  PArgbs = ^TArgbs;
  TArgbs = array [0.. (Maxint div SizeOf(TARGB)) -1] of TARGB;

procedure ApplyClearType(img: TImage32; textColor: TColor32 = clBlack32;
  bkColor: TColor32 = clWhite32);
const
  centerWeighting = 5; //0 <= centerWeighting <= 25
var
  h, w: integer;
  src, dst: PARGB;
  srcArr: PArgbs;
  fgColor: TARGB absolute textColor;
  bgColor: TARGB absolute bkColor;
  diff_R, diff_G, diff_B: integer;
  bg8_R, bg8_G, bg8_B: integer;
  rowBuffer: TArrayOfARGB;
  primeTbl, nearTbl, FarTbl: PByteArray;
begin
  // Precondition: the background to text drawn onto 'img' must be transparent

  // 85 + (2 * 57) + (2 * 28) == 255
  primeTbl := PByteArray(@MulTable[85 + centerWeighting *2]);
  nearTbl  := PByteArray(@MulTable[57]);
  farTbl   := PByteArray(@MulTable[28 - centerWeighting]);
  SetLength(rowBuffer, img.Width +4);

  for h := 0 to img.Height -1 do
  begin
    // each row of the image is copied into a temporary buffer ...
    // noting that while 'dst' (img.Pixels) is initially the source
    // it will later be destination (during image compression).
    dst := PARGB(@img.Pixels[h * img.Width]);
    src := PARGB(@rowBuffer[2]);
    Move(dst^, src^, img.Width * SizeOf(TColor32));
    srcArr := PArgbs(rowBuffer);

    // using this buffer compress the image ...
    w := 2;
    while w < img.Width do
    begin
      dst.R := primeTbl[srcArr[w].A] +
        nearTbl[srcArr[w-1].A] + farTbl[srcArr[w-2].A] +
        nearTbl[srcArr[w+1].A] + farTbl[srcArr[w+2].A];
      inc(w);
      dst.G := primeTbl[srcArr[w].A] +
        nearTbl[srcArr[w-1].A] + farTbl[srcArr[w-2].A] +
        nearTbl[srcArr[w+1].A] + farTbl[srcArr[w+2].A];
      inc(w);
      dst.B := primeTbl[srcArr[w].A] +
        nearTbl[srcArr[w-1].A] + farTbl[srcArr[w-2].A] +
        nearTbl[srcArr[w+1].A] + farTbl[srcArr[w+2].A];
      inc(w);
      dst.A := 255;
      inc(dst);
    end;
  end;

  // Following compression the right 2/3 of the image is redundant
   img.Crop(Types.Rect(0,0, img.Width div 3, img.Height));

  // currently text is white and the background is black
  // so blend in the text and background colors ...
  diff_R := fgColor.R - bgColor.R;
  diff_G := fgColor.G - bgColor.G;
  diff_B := fgColor.B - bgColor.B;
  bg8_R := bgColor.R shl 8;
  bg8_G := bgColor.G shl 8;
  bg8_B := bgColor.B shl 8;
  dst := PARGB(img.PixelBase);
  for h := 0 to img.Width * img.Height -1 do
  begin
    if dst.R = 0 then
      dst.Color := bkColor
    else
    begin
      // blend front (text) and background colors ...
      dst.R := (bg8_R + diff_R * dst.R) shr 8;
      dst.G := (bg8_G + diff_G * dst.G) shr 8;
      dst.B := (bg8_B + diff_B * dst.B) shr 8;
    end;
    inc(dst);
  end;
end;

// ------------------------------------------------------------------------------
// Other miscellaneous functions
// ------------------------------------------------------------------------------

function ClampByte(val: double): byte; {$IFDEF INLINE} inline; {$ENDIF}
begin
  if val < 0 then result := 0
  else if val > 255 then result := 255
  else result := Round(val);
end;
// ------------------------------------------------------------------------------

function GetPixel(current: PARGB; delta: integer): PARGB;
{$IFDEF INLINE} inline; {$ENDIF}
begin
  Result := current;
  inc(Result, delta);
end;
// ------------------------------------------------------------------------------

// Here "const" is used for opimization reasons, to skip the
// dyn-array reference counting. "const" for dyn-arrays doesn't
// prevent one from changing the array's content.
procedure ReverseColors(const colors: TArrayOfGradientColor);
var
  highI: integer;
  dst, src: ^TGradientColor;
  // Not using a TGradientColor record for the temporary value
  // allows the 64-bit compiler to use an XMM register for it.
  tmpOffset: double;
  tmpColor: TColor32;
begin
  highI := High(colors);

  dst := @colors[0];
  src := @colors[highI];
  while PByte(dst) < PByte(src) do
  begin
    tmpColor := dst.color;
    tmpOffset := dst.offset;

    dst.color := src.color;
    dst.offset := 1 - src.offset;

    src.color := tmpColor;
    src.offset := 1 - tmpOffset;

    inc(dst);
    dec(src);
  end;
end;
// ------------------------------------------------------------------------------

procedure SwapColors(var color1, color2: TColor32);
var
  c: TColor32;
begin
  c := color1;
  color1 := color2;
  color2 := c;
end;
// ------------------------------------------------------------------------------

procedure SwapPoints(var point1, point2: TPoint); overload;
var
  pt: TPoint;
begin
  pt := point1;
  point1 := point2;
  point2 := pt;
end;
// ------------------------------------------------------------------------------

procedure SwapPoints(var point1, point2: TPointD); overload;
var
  pt: TPointD;
begin
  pt := point1;
  point1 := point2;
  point2 := pt;
end;
// ------------------------------------------------------------------------------

function ClampQ(q, endQ: integer): integer;
begin
  if q < 0 then result := 0
  else if q >= endQ then result := endQ -1
  else result := q;
end;
// ------------------------------------------------------------------------------

function ClampD(d: double; colorCnt: integer): integer;
begin
  dec(colorCnt);
  if d < 0 then result := 0
  else if d >= 1 then result := colorCnt
  else result := Round(d * colorCnt);
end;
// ------------------------------------------------------------------------------

function MirrorQ(q, endQ: integer): integer;
begin
  result := q mod endQ;
  if (result < 0) then result := -result;
  if Odd(q div endQ) then
    result := (endQ -1) - result;
end;
// ------------------------------------------------------------------------------

function MirrorD(d: double; colorCnt: integer): integer;
begin
  dec(colorCnt);
  if Odd(Trunc(d)) then
    result := Trunc((1 - frac(d)) * colorCnt) else
    result := Trunc(frac(d)  * colorCnt);
end;
// ------------------------------------------------------------------------------

function RepeatQ(q, endQ: integer): integer;
begin
  if (q < 0) or (q >= endQ) then
  begin
    endQ := Abs(endQ);
    result := q mod endQ;
    if result < 0 then inc(result, endQ);
  end
  else result := q;
end;
// ------------------------------------------------------------------------------

function SoftRptQ(q, endQ: integer): integer;
begin
  if (q < 0) then
    result := endQ + (q mod endQ) else
    result := (q mod endQ);
  if result = 0 then result := endQ div 2;
end;
// ------------------------------------------------------------------------------

function RepeatD(d: double; colorCnt: integer): integer;
begin
  dec(colorCnt);
  if (d < 0) then
    result := Trunc((1 + frac(d)) * colorCnt) else
    result := Trunc(frac(d)  * colorCnt);
end;
// ------------------------------------------------------------------------------

function BlendColorUsingMask(bgColor, fgColor: TColor32; mask: Byte): TColor32;
var
  bg: TARGB absolute bgColor;
  fg: TARGB absolute fgColor;
  res: TARGB absolute Result;
  R, invR: PByteArray;
begin
  if fg.A = 0 then
  begin
    Result := bgColor;
    res.A := MulTable[res.A, not mask];
  end
  else if bg.A = 0 then
  begin
    Result := fgColor;
    res.A := MulTable[res.A, mask];
  end
  else if (mask = 0) then
    Result := bgColor
  else if (mask = 255) then
    Result := fgColor
  else
  begin
    R    := PByteArray(@MulTable[mask]);
    InvR := PByteArray(@MulTable[not mask]);
    res.A := R[fg.A] + InvR[bg.A];
    res.R := R[fg.R] + InvR[bg.R];
    res.G := R[fg.G] + InvR[bg.G];
    res.B := R[fg.B] + InvR[bg.B];
  end;
end;
// ------------------------------------------------------------------------------

// MakeColorGradient: using the supplied array of TGradientColor,
// create an array of TColor32 of the specified length
procedure MakeColorGradient(const gradColors: TArrayOfGradientColor;
  len: integer; var result: TArrayOfColor32);
var
  i,j, lenC: integer;
  dist, offset1, offset2, step, pos, reciprocalDistTimes255: double;
  color1, color2: TColor32;
begin
  lenC := length(gradColors);
  if (len = 0) or (lenC < 2) then Exit;
  if Length(result) <> len then // we can reuse the array
    SetLength(result, len);

  color2 := gradColors[0].color;
  result[0] := color2;
  if len = 1 then Exit;

  reciprocalDistTimes255 := 0;
  step := 1/(len-1);
  pos := step;
  offset2 := 0;
  i := 1; j := 1;
  repeat
    offset1 := offset2;
    offset2 := gradColors[i].offset;
    dist := offset2 - offset1;
    color1 := color2;
    color2 := gradColors[i].color;
    if dist > 0 then
      reciprocalDistTimes255 := 255/dist; // 1/dist*255
    while (pos <= dist) and (j < len) do
    begin
      result[j] := BlendColorUsingMask(color1, color2, Round(pos * reciprocalDistTimes255));
      inc(j);
      pos := pos + step;
    end;
    pos := pos - dist;
    inc(i);
  until i = lenC;
  if j < len then result[j] := result[j-1];
end;

// ------------------------------------------------------------------------------
// Rasterize() support functions
// ------------------------------------------------------------------------------

procedure AllocateScanlines(const polygons: TPathsD;
  const scanlines: TArrayOfScanline; var fragments: PFragment; clipBottom, clipRight: integer);
var
  i,j, highI, highJ: integer;
  y1, y2: integer;
  fragOff: Cardinal;
  psl: PScanline;
begin
  // first count how often each edge intersects with each horizontal scanline
  for i := 0 to high(polygons) do
  begin
    highJ := high(polygons[i]);
    if highJ < 2 then continue;
    y1 := Trunc(polygons[i][highJ].Y);
    for j := 0 to highJ do
    begin
      y2 := Trunc(polygons[i][j].Y);
      if y1 < y2 then
      begin
        // descending (but ignore edges outside the clipping range)
        if (y2 >= 0) and (y1 <= clipBottom) then
        begin
          if (y1 > 0) then
            dec(scanlines[y1 -1].fragCnt);
          if y2 >= clipBottom then
            inc(scanlines[clipBottom].fragCnt) else
            inc(scanlines[y2].fragCnt);
        end;
      end else
      begin
        // ascending (but ignore edges outside the clipping range)
        if (y1 >= 0) and (y2 <= clipBottom) then
        begin
          if (y2 > 0) then
            dec(scanlines[y2 -1].fragCnt);
          if y1 >= clipBottom then
            inc(scanlines[clipBottom].fragCnt) else
            inc(scanlines[y1].fragCnt);
        end;
      end;
      y1 := y2;
    end;
  end;

  // convert 'count' accumulators into real counts and allocate storage
  j := 0;
  fragOff := 0;
  highI := high(scanlines);
  psl := @scanlines[highI];

  // 'fragments' is a pointer and not a dynamic array because
  // dynamic arrays are zero initialized (hence slower than GetMem).
  for i := highI downto 0 do
  begin
    inc(j, psl.fragCnt); // nb: psl.fragCnt may be < 0 here!
    if j > 0 then
    begin
      psl.fragOffset := fragOff;
      inc(fragOff, j);
    end else
      psl.fragOffset := -1;
    psl.fragCnt := 0; // reset for later
    psl.minX := clipRight;
    psl.maxX := 0;
    psl.Y := i;
    dec(psl);
  end;
  // allocate fragments as a single block of memory
  GetMem(fragments, fragOff * sizeOf(TFragment));
end;
// ------------------------------------------------------------------------------

procedure SplitEdgeIntoFragments(const pt1, pt2: TPointD;
  const scanlines: TArrayOfScanline; fragments: PFragment; const clipRec: TRect);
var
  x,y, dx,dy, absDx, dydx, dxdy: double;
  i, scanlineY, maxY, maxX: integer;
  psl: PScanLine;
  pFrag: PFragment;
  bot, top: TPointD;
begin
  dy := pt1.Y - pt2.Y;

  if dy > 0 then
  begin
    // ASCENDING EDGE (+VE WINDING DIR)
    if dy < 0.0001 then Exit;            //ignore near horizontals
    bot := pt1; top := pt2;
  end else
  begin
    // DESCENDING EDGE (-VE WINDING DIR)
    if dy > -0.0001 then Exit;           //ignore near horizontals
    bot := pt2; top := pt1;
  end;
  // exclude edges that are completely outside the top or bottom clip region
  RectWidthHeight(clipRec, maxX, maxY);
  if (top.Y >= maxY) or (bot.Y <= 0) then Exit;

  dx := pt2.X - pt1.X;
  absDx := abs(dx);

  if absDx < 0.000001 then
  begin
    // VERTICAL EDGE
    top.X := bot.X; //this circumvents v. rare rounding issues.

    // exclude vertical edges that are outside the right clip region
    // but still update maxX for each scanline the edge passes
    if bot.X > maxX then
    begin
      for i := Min(maxY, Trunc(bot.Y)) downto Max(0, Trunc(top.Y)) do
        scanlines[i].maxX := maxX;
      Exit;
    end;

    dxdy := 0;
    if dy > 0 then dydx := 1 else dydx := -1;
  end else
  begin
    dxdy := dx/dy;
    dydx := dy/absDx;
  end;

  // TRIM EDGES THAT CROSS CLIPPING BOUNDARIES (EXCEPT THE LEFT BOUNDARY)
  if bot.X >= maxX then
  begin
    if top.X >= maxX then
    begin
      for i := Min(maxY, Trunc(bot.Y)) downto Max(0, Trunc(top.Y)) do
        scanlines[i].maxX := maxX;
      Exit;
    end;
    // here the edge must be oriented bottom-right to top-left
    y := bot.Y - (bot.X - maxX) * Abs(dydx);
    for i := Min(maxY, Trunc(bot.Y)) downto Max(0, Trunc(y)) do
      scanlines[i].maxX := maxX;
    bot.Y := y;
    if bot.Y <= 0 then Exit;
    bot.X := maxX;
  end
  else if top.X > maxX then
  begin
    // here the edge must be oriented bottom-left to top-right
    y := top.Y + (top.X - maxX) * Abs(dydx);
    for i := Min(maxY, Trunc(y)) downto Max(0, Trunc(top.Y)) do
      scanlines[i].maxX := maxX;
    top.Y := y;
    if top.Y >= maxY then Exit;
    top.X := maxX;
  end;
  if bot.Y > maxY then
  begin
    bot.X := bot.X + dxdy * (bot.Y - maxY);
    if (bot.X > maxX) then Exit;        //nb: no clipping on the left
    bot.Y := maxY;
  end;
  if top.Y < 0 then
  begin
    top.X := top.X + (dxdy * top.Y);
    if (top.X > maxX) then Exit;        //nb: no clipping on the left
    top.Y := 0;
  end;

  // SPLIT THE EDGE INTO MULTIPLE SCANLINE FRAGMENTS
  scanlineY := Trunc(bot.Y);
  if bot.Y = scanlineY then dec(scanlineY);

  // at the lower-most extent of the edge 'split' the first fragment
  if scanlineY < 0 then Exit;

  psl := @scanlines[scanlineY];
  if psl.fragOffset < 0 then Exit; //a very rare event

  pFrag := fragments;
  inc(pFrag, psl.fragOffset + psl.fragCnt);
  inc(psl.fragCnt);

  pFrag.botX := bot.X;
  if scanlineY <= top.Y then
  begin
    // the whole edge is within 1 scanline
    pFrag.topX := top.X;
    pFrag.dy := bot.Y - top.Y;
    pFrag.dydx := dydx;
    Exit;
  end;

  x := bot.X + (bot.Y - scanlineY) * dxdy;
  pFrag.topX := x;
  pFrag.dy := bot.Y - scanlineY;
  pFrag.dydx := dydx;
  // 'split' subsequent fragments until the top fragment
  dec(psl);
  while psl.Y > top.Y do
  begin
    pFrag := fragments;
    inc(pFrag, psl.fragOffset + psl.fragCnt);
    inc(psl.fragCnt);
    pFrag.botX := x;
    x := x + dxdy;
    pFrag.topX := x;
    pFrag.dy := 1;
    pFrag.dydx := dydx;
    dec(psl);
  end;
  // and finally the top fragment
  pFrag := fragments;
  inc(pFrag, psl.fragOffset + psl.fragCnt);
  inc(psl.fragCnt);
  pFrag.botX := x;
  pFrag.topX := top.X;
  pFrag.dy := psl.Y + 1 - top.Y;
  pFrag.dydx := dydx;
end;
// ------------------------------------------------------------------------------

procedure InitializeScanlines(const polygons: TPathsD;
  const scanlines: TArrayOfScanline; fragments: PFragment; const clipRec: TRect);
var
  i,j, highJ: integer;
  pt1, pt2: PPointD;
begin
 for i := 0 to high(polygons) do
  begin
    highJ := high(polygons[i]);
    if highJ < 2 then continue;
    pt1 := @polygons[i][highJ];
    pt2 := @polygons[i][0];
    for j := 0 to highJ do
    begin
      SplitEdgeIntoFragments(pt1^, pt2^, scanlines, fragments, clipRec);
      pt1 := pt2;
      inc(pt2);
    end;
  end;
end;
// ------------------------------------------------------------------------------

procedure ProcessScanlineFragments(var scanline: TScanLine;
  fragments: PFragment; const buffer: TArrayOfDouble);
var
  i,j, leftXi,rightXi: integer;
  fracX, yy, q{, windDir}: double;
  left, right, dy, dydx: double;
  frag: PFragment;
  pd: PDouble;
begin
  frag := fragments;
  inc(frag, scanline.fragOffset);
  for i := 1 to scanline.fragCnt do
  begin
    left := frag.botX;
    right := frag.topX;
    dy := frag.dy;
    dydx := frag.dydx;
    inc(frag);

    // converting botX & topX to left & right simplifies code
    if {botX > topX} left > right then
    begin
      q := left;
      left := right;
      right := q;
    end;

    leftXi := Max(0, Trunc(left));
    rightXi := Max(0, Trunc(right));
    if (leftXi = rightXi) then
    begin
      // the fragment is only one pixel wide
      //if dydx < 0 then windDir := -1.0 else windDir := 1.0;
      if dydx < 0 then dy := -dy;

      if leftXi < scanline.minX then
        scanline.minX := leftXi;
      if rightXi > scanline.maxX then
        scanline.maxX := rightXi;
      pd := @buffer[leftXi];
      if (left <= 0) then
      begin
        pd^ := pd^ + dy {* windDir};
      end else
      begin
        q := (left + right) * 0.5 - leftXi;
        pd^ := pd^ + (1-q) * dy {* windDir};
        inc(pd);
        pd^ := pd^ + q * dy {* windDir};
      end;
    end else
    begin
      if leftXi < scanline.minX then
        scanline.minX := leftXi;
      if rightXi > scanline.maxX then
        scanline.maxX := rightXi;
      pd := @buffer[leftXi];
      // left pixel
      fracX := leftXi + 1 - left;
      yy := dydx * fracX;
      q := fracX * yy * 0.5;
      pd^ := pd^ + q;
      q :=  yy - q;
      inc(pd);
      // middle pixels
      for j := leftXi +1 to rightXi -1 do
      begin
        pd^ := pd^ + q + dydx * 0.5;
        q := dydx * 0.5;
        inc(pd);
      end;
      // right pixel
      fracX := right - rightXi;
      yy :=  fracX * dydx;
      pd^ := pd^ + q + (1 - fracX * 0.5) * yy;
      inc(pd);
      // overflow
      pd^ := pd^ + fracX * 0.5 * yy;
    end;
  end;
end;
// ------------------------------------------------------------------------------

{$RANGECHECKS OFF} // negative array index is used
{ CPU register optimized implementations. Every data type must be exactly the one used. }
procedure FillByteBufferEvenOdd(byteBuffer: PByte;
  windingAccum: PDouble; count: nativeint);
var
  accum: double;
  lastValue: integer;
  start: nativeint;
  buf: PByteArray;
begin
  accum := 0; //winding count accumulator
  lastValue := 0;
  // Copy byteBuffer to a local variable, so Delphi's 32bit compiler
  // can put buf into a CPU register.
  buf := PByteArray(byteBuffer);

  // Use the negative offset trick to only increment "count"
  // until it reaches zero. And by offsetting the arrays, "count"
  // also becomes the index for those.
  inc(PByte(buf), count);
  inc(windingAccum, count);
  count := -count;
  while count < 0 do
  begin
    // lastValue can be used if accum doesn't change
    if PInt64Array(windingAccum)[count] = 0 then
    begin
      start := count;
      repeat
        inc(count);
      until (count = 0) or (PInt64Array(windingAccum)[count] <> 0);
      FillChar(buf[start], count - start, Byte(lastValue));
      if count = 0 then break;
    end;

    accum := accum + PDoubleArray(windingAccum)[count];

    // EvenOdd
    lastValue := Trunc(Abs(accum) * 1275) mod 2550; // mul 5
    if lastValue > 1275 then
      lastValue := (2550 - lastValue) shr 2 else    // div 4
      lastValue := lastValue shr 2;                 // div 4
    if lastValue > 255 then lastValue := 255;

    buf[count] := Byte(lastValue);
    PDoubleArray(windingAccum)[count] := 0;
    inc(count); // walk towards zero
  end;
end;

procedure FillByteBufferNonZero(byteBuffer: PByte;
  windingAccum: PDouble; count: nativeint);
var
  accum: double;
  lastValue: integer;
  start: nativeint;
  buf: PByteArray;
begin
  accum := 0; //winding count accumulator
  lastValue := 0;
  // Copy byteBuffer to a local variable, so Delphi's 32bit compiler
  // can put buf into a CPU register.
  buf := PByteArray(byteBuffer);

  // Use the negative offset trick to only increment "count"
  // until it reaches zero. And by offsetting the arrays, "count"
  // also becomes the index for those.
  inc(PByte(buf), count);
  inc(windingAccum, count);
  count := -count;
  while count < 0 do
  begin
    // lastValue can be used if accum doesn't change
    if PInt64Array(windingAccum)[count] = 0 then
    begin
      start := count;
      repeat
        inc(count);
      until (count = 0) or (PInt64Array(windingAccum)[count] <> 0);
      FillChar(buf[start], count - start, Byte(lastValue));
      if count = 0 then break;
    end;

    accum := accum + PDoubleArray(windingAccum)[count];

    // NonZero
    lastValue := Trunc(Abs(accum) * 318);
    if lastValue > 255 then lastValue := 255;

    buf[count] := Byte(lastValue);
    PDoubleArray(windingAccum)[count] := 0;
    inc(count); // walk towards zero
  end;
end;

procedure FillByteBufferPositive(byteBuffer: PByte;
  windingAccum: PDouble; count: nativeint);
var
  accum: double;
  lastValue: integer;
  start: nativeint;
  buf: PByteArray;
begin
  accum := 0; //winding count accumulator
  lastValue := 0;
  // Copy byteBuffer to a local variable, so Delphi's 32bit compiler
  // can put buf into a CPU register.
  buf := PByteArray(byteBuffer);

  // Use the negative offset trick to only increment "count"
  // until it reaches zero. And by offsetting the arrays, "count"
  // also becomes the index for those.
  inc(PByte(buf), count);
  inc(windingAccum, count);
  count := -count;
  while count < 0 do
  begin
    // lastValue can be used if accum doesn't change
    if PInt64Array(windingAccum)[count] = 0 then
    begin
      start := count;
      repeat
        inc(count);
      until (count = 0) or (PInt64Array(windingAccum)[count] <> 0);
      FillChar(buf[start], count - start, Byte(lastValue));
      if count = 0 then break;
    end;

    accum := accum + PDoubleArray(windingAccum)[count];

    // Positive
    lastValue := 0;
    if accum > 0.002 then
    begin
      lastValue := Trunc(accum * 318);
      if lastValue > 255 then lastValue := 255;
    end;

    buf[count] := Byte(lastValue);
    PDoubleArray(windingAccum)[count] := 0;
    inc(count); // walk towards zero
  end;
end;

procedure FillByteBufferNegative(byteBuffer: PByte;
  windingAccum: PDouble; count: nativeint);
var
  accum: double;
  lastValue: integer;
  start: nativeint;
  buf: PByteArray;
begin
  accum := 0; //winding count accumulator
  lastValue := 0;
  // Copy byteBuffer to a local variable, so Delphi's 32bit compiler
  // can put buf into a CPU register.
  buf := PByteArray(byteBuffer);

  // Use the negative offset trick to only increment "count"
  // until it reaches zero. And by offsetting the arrays, "count"
  // also becomes the index for those.
  inc(PByte(buf), count);
  inc(windingAccum, count);
  count := -count;
  while count < 0 do
  begin
    // lastValue can be used if accum doesn't change
    if PInt64Array(windingAccum)[count] = 0 then
    begin
      start := count;
      repeat
        inc(count);
      until (count = 0) or (PInt64Array(windingAccum)[count] <> 0);
      FillChar(buf[start], count - start, Byte(lastValue));
      if count = 0 then break;
    end;

    accum := accum + PDoubleArray(windingAccum)[count];

    // Negative
    lastValue := 0;
    if accum < -0.002 then
    begin
      lastValue := Trunc(accum * -318);
      if lastValue > 255 then lastValue := 255;
    end;

    buf[count] := Byte(lastValue);
    PDoubleArray(windingAccum)[count] := 0;
    inc(count); // walk towards zero
  end;
end;
{$IFDEF RANGECHECKS_ENABLED}
  {$RANGECHECKS ON}
{$ENDIF}

procedure Rasterize(const paths: TPathsD; const clipRec: TRect;
  fillRule: TFillRule; renderer: TCustomRenderer);
var
  i, xli,xri, maxW, maxH: integer;
  clipRec2: TRect;
  paths2: TPathsD;
  windingAccum: TArrayOfDouble;
  byteBuffer: PByteArray;
  scanlines: TArrayOfScanline;
  fragments: PFragment;
  scanline: PScanline;
  skippedScanlines: integer;
  skipRenderer: boolean;

  // FPC generates wrong code if "count" isn't NativeInt
  FillByteBuffer: procedure(byteBuffer: PByte; windingAccum: PDouble; count: nativeint);
begin
  // See also https://nothings.org/gamedev/rasterize/
  if not assigned(renderer) then Exit;
  renderer.SetClipRect(clipRec);
  skipRenderer := renderer.SupportsRenderProcSkip;

  Types.IntersectRect(clipRec2, clipRec, GetBounds(paths));
  if IsEmptyRect(clipRec2) then
  begin
    if skipRenderer then renderer.RenderProcSkip(clipRec);
    Exit;
  end;

  if (clipRec2.Left = 0) and (clipRec2.Top = 0) then
    paths2 := paths
  else
    paths2 := TranslatePath(paths, -clipRec2.Left, -clipRec2.Top);

  // Delphi's Round() function is *much* faster than Trunc(),
  // and even a little faster than Trunc() above (except
  // when the FastMM4 memory manager is enabled.)
  fragments := nil;
  byteBuffer := nil;
  try
    RectWidthHeight(clipRec2, maxW, maxH);
    if maxW <= 0 then Exit;
    GetMem(byteBuffer, maxW); // no need for dyn. array zero initialize
    SetLength(scanlines, maxH +1);
    SetLength(windingAccum, maxW +2);
    AllocateScanlines(paths2, scanlines, fragments, maxH, maxW-1);
    InitializeScanlines(paths2, scanlines, fragments, clipRec2);

    case fillRule of
      frEvenOdd:
        FillByteBuffer := FillByteBufferEvenOdd;
      frNonZero:
        FillByteBuffer := FillByteBufferNonZero;
{$IFDEF REVERSE_ORIENTATION}
      frPositive:
{$ELSE}
      frNegative:
{$ENDIF}
        FillByteBuffer := FillByteBufferPositive;
{$IFDEF REVERSE_ORIENTATION}
      frNegative:
{$ELSE}
      frPositive:
{$ENDIF}
        FillByteBuffer := FillByteBufferNegative;
      else
        if skipRenderer then renderer.RenderProcSkip(clipRec);
        Exit;
    end;

    // Notify the renderer about the parts at the top
    // that we didn't touch.
    if skipRenderer and (clipRec2.Top > clipRec.Top) then
    begin
      renderer.RenderProcSkip(Rect(clipRec.Left, clipRec.Top,
                                   clipRec.Right, clipRec2.Top - 1));
    end;

    skippedScanlines := 0;
    scanline := @scanlines[0];
    for i := 0 to high(scanlines) do
    begin
      if scanline.fragCnt = 0 then
      begin
        inc(scanline);
        if skipRenderer then inc(skippedScanlines);
        Continue;
      end;

      // If we have skipped some scanlines, we must notify the renderer.
      if skipRenderer and (skippedScanlines > 0) then
      begin
        renderer.RenderProcSkip(Rect(clipRec.Left, clipRec2.Top + i - skippedScanlines,
                                     clipRec.Right, clipRec2.Top + i - 1));
        skippedScanlines := 0;
      end;

      // process each scanline to fill the winding count accumulation buffer
      ProcessScanlineFragments(scanline^, fragments, windingAccum);
      // it's faster to process only the modified sub-array of windingAccum
      xli := scanline.minX;
      xri := Min(maxW -1, scanline.maxX +1);

      // a 25% weighting has been added to the alpha channel to minimize any
      // background bleed-through where polygons join with a common edge.

      // FillByteBuffer overwrites every byte in byteBuffer[xli..xri] and also resets
      // windingAccum[xli..xri] to 0.
      FillByteBuffer(@byteBuffer[xli], @windingAccum[xli], xri - xli +1);

      renderer.RenderProc(clipRec2.Left + xli, clipRec2.Left + xri,
        clipRec2.Top + i, @byteBuffer[xli]);

      inc(scanline);
    end;

    // Notify the renderer about the last skipped scanlines
    if skipRenderer then
    begin
      clipRec2.Bottom := clipRec2.top + High(scanlines) - skippedScanlines;
      if clipRec2.Bottom < clipRec.Bottom then
      begin
        renderer.RenderProcSkip(Rect(clipRec.Left, clipRec2.Bottom + 1,
                                     clipRec.Right, clipRec.Bottom));
      end;
    end;
  finally
    // cleanup and deallocate memory
    FreeMem(fragments);
    FreeMem(byteBuffer);
  end;
end;
// ------------------------------------------------------------------------------

procedure Rasterize(img: TImage32; const paths: TPathsD;
  const clipRec: TRect; fillRule: TFillRule; renderer: TCustomRenderer);
begin
  if renderer.Initialize(img) then
  begin
    Rasterize(paths, clipRec, fillRule, renderer);
    renderer.NotifyChange;
  end;
end;

// ------------------------------------------------------------------------------
// TAbstractRenderer
// ------------------------------------------------------------------------------

constructor TCustomRenderer.Create;
begin
  inherited;
  fOpacity := 255;
end;
// ------------------------------------------------------------------------------

function TCustomRenderer.Initialize(imgBase: Pointer;
  imgWidth, imgHeight, pixelSize: integer): Boolean;
begin
  fImgBase := imgBase;
  fImgWidth := ImgWidth;
  fImgHeight := ImgHeight;
  fPixelSize := pixelSize;

  fCurrLinePtr := fImgBase;
  fCurrY       := 0;
  result       := true;
end;
// ------------------------------------------------------------------------------

procedure TCustomRenderer.NotifyChange;
begin
  if assigned(fChangeProc) then fChangeProc;
end;
// ------------------------------------------------------------------------------

type THackedImage32 = class(TImage32); //exposes protected Changed method.

function TCustomRenderer.Initialize(targetImage: TImage32): Boolean;
begin
  fChangeProc := THackedImage32(targetImage).Changed;
  with targetImage do
    result := Initialize(PixelBase, Width, Height, SizeOf(TColor32));
end;
// ------------------------------------------------------------------------------

function TCustomRenderer.GetDstPixel(x, y: integer): Pointer;
begin
  if (y <> fCurrY) then
  begin
    fCurrY := y;
    fCurrLinePtr := fImgBase;
    inc(PByte(fCurrLinePtr), fCurrY * fImgWidth * fPixelSize);
  end;
  Result := fCurrLinePtr;
  inc(PByte(Result), x * fPixelSize);
end;
// ------------------------------------------------------------------------------

procedure TCustomRenderer.SetClipRect(const clipRect: TRect);
begin
  // default: do nothing
end;
// ------------------------------------------------------------------------------

procedure TCustomRenderer.RenderProcSkip(const skippedRect: TRect);
begin
  // default: do nothing
end;
// ------------------------------------------------------------------------------

function TCustomRenderer.SupportsRenderProcSkip: Boolean;
begin
  Result := False;
end;

// ------------------------------------------------------------------------------
// TCustomColorRenderer
// ------------------------------------------------------------------------------

procedure TCustomColorRenderer.SetColor(value: TColor32);
begin
  fColor := value;
end;

// ------------------------------------------------------------------------------
// TColorRenderer
// ------------------------------------------------------------------------------

constructor TColorRenderer.Create(color: TColor32 = clNone32);
begin
  inherited Create;
  if color <> clNone32 then SetColor(color);
end;
// ------------------------------------------------------------------------------

function TColorRenderer.Initialize(targetImage: TImage32): Boolean;
begin
  // there's no point rendering if the color is fully transparent
  result := (fAlpha > 0) and inherited Initialize(targetImage);
end;
// ------------------------------------------------------------------------------

procedure TColorRenderer.SetColor(value: TColor32);
begin
  fColor := value and $FFFFFF;
  fAlpha := GetAlpha(value);
end;
// ------------------------------------------------------------------------------

{$RANGECHECKS OFF} // negative array index usage (Delphi 7-2007 have no pointer math)
type
  // Used to reduce the number of parameters to help the compiler's
  // optimizer.
  TRenderProcData = record
    dst: PColor32Array;
    alpha: PByteArray;
  end;

function RenderProcBlendToAlpha255(count: nativeint; dstColor: TColor32;
  var data: TRenderProcData): nativeint;
// CPU register optimized
var
  a: byte;
  dst: PColor32Array;
  alpha: PByteArray;
begin
  Result := count;
  dst := data.dst;
  alpha := data.alpha;

  a := alpha[Result];
  dst[Result] := dstColor;
  inc(Result);

  while (Result < 0) and (alpha[Result] = a) do
  begin
    dst[Result] := dstColor;
    inc(Result);
  end;
end;

procedure RenderProcBlendToAlpha(dst: PColor32Array; alpha: PByteArray;
  count: nativeint; color: TColor32; alphaTable: PByteArray);
var
  a: byte;
  lastDst, dstColor: TColor32;
  data: TRenderProcData;
begin
  // Use negative offset trick.
  alpha := @alpha[count];
  dst := @dst[count];
  count := -count;

  // store pointers for RenderProcBlendToAlpha255
  data.dst := dst;
  data.alpha := alpha;

  while count < 0 do
  begin
    a := alpha[count];
    if a > 1 then
    begin
      a := alphaTable[a];
      dstColor := (a shl 24) or color;

      // Special handling for alpha channel 255 (copy dstColor into dst)
      if a = 255 then
        count := RenderProcBlendToAlpha255(count, dstColor, data)
      else
      begin
        lastDst := dst[count];
        dstColor := BlendToAlpha(lastDst, dstColor);

        a := alpha[count];
        dst[count] := dstColor;
        inc(count);

        // if we have the same dst-pixel and the same alpha channel, we can
        // just copy the already calculated BlendToAlpha color.
        while (count < 0) and (a = alpha[count]) and (dst[count] = lastDst) do
        begin
          dst[count] := dstColor;
          inc(count);
        end;
      end;
    end
    else
      inc(count);
  end;
end;
{$IFDEF RANGECHECKS_ENABLED}
  {$RANGECHECKS ON}
{$ENDIF}

procedure TColorRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
begin
  // Help the compiler to get better CPU register allocation.
  // Without the hidden Self parameter the compiler optimizes
  // better.
  RenderProcBlendToAlpha(PColor32Array(GetDstPixel(x1, y)),
                         PByteArray(alpha), x2 - x1 + 1, fColor,
                         PByteArray(@MulTable[fAlpha]));
end;

// ------------------------------------------------------------------------------
// TAliasedColorRenderer
// ------------------------------------------------------------------------------

constructor TAliasedColorRenderer.Create(color: TColor32 = clNone32);
begin
  inherited Create;
  fColor := color;
end;
// ------------------------------------------------------------------------------

function TAliasedColorRenderer.Initialize(targetImage: TImage32): Boolean;
begin
  // there's no point rendering if the color is fully transparent
  result := (GetAlpha(fColor) > 0) and
    inherited Initialize(targetImage);
end;
// ------------------------------------------------------------------------------

procedure TAliasedColorRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i: integer;
  dst: PColor32;
  c: TColor32;
begin
  dst := GetDstPixel(x1,y);
  c := fColor; // copy fColor to local variable
  for i := x1 to x2 do
  begin
    if Ord(alpha^) > 127 then dst^ := c; //ie no blending
    inc(dst); inc(alpha);
  end;
end;

// ------------------------------------------------------------------------------
// TMaskRenderer
// ------------------------------------------------------------------------------

procedure TMaskRenderer.SetClipRect(const clipRect: TRect);
begin
  fClipRect := clipRect;
  // clipping to the image size
  if fClipRect.Left < 0 then fClipRect.Left := 0;
  if fClipRect.Top < 0 then fClipRect.Top := 0;
  if fClipRect.Right > fImgWidth then fClipRect.Right := fImgWidth;
  if fClipRect.Bottom > fImgHeight then fClipRect.Bottom := fImgHeight;
end;
// ------------------------------------------------------------------------------

procedure TMaskRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  p: PColor32;
  i: integer;
begin
  // CopyBlend excludes ClipRect.Right/Bottom, so we also
  // need to exclude it.
  if (y < fClipRect.Top) or (y >= fClipRect.Bottom) then Exit;
  if x2 >= fClipRect.Right then x2 := fClipRect.Right - 1;

  if x1 < fClipRect.Left then
  begin
    inc(alpha, fClipRect.Left - x1);
    x1 := fClipRect.Left;
  end;

  p := GetDstPixel(fClipRect.Left, y);

  // Clear the area before x1 (inside OutsideBounds)
  FillChar(p^, (x1 - fClipRect.Left) * SizeOf(TColor32), 0);
  inc(p, x1 - fClipRect.Left);

  // Fill the area between x1 and x2
  for i := x1 to x2 do
  begin
    if p^ <> 0 then
    begin
      if Ord(alpha^) = 0 then
        p^ := 0
      else if Ord(alpha^) <> 255 then
        p^ := BlendMask(p^, Ord(alpha^) shl 24);
    end;
    inc(p);
    inc(alpha);
  end;

  // Clear the area after x2 (inside OutsideBounds)
  FillChar(p^, (fClipRect.Right - (x2 + 1)) * SizeOf(TColor32), 0);
end;
// ------------------------------------------------------------------------------

procedure TMaskRenderer.RenderProcSkip(const skippedRect: TRect);
var
  i, h, w: integer;
  p: PColor32;
  r: TRect;
begin
  r := skippedRect;
  if r.Left < fClipRect.Left then r.Left := fClipRect.Left;
  if r.Top < fClipRect.Top then r.Top := fClipRect.Top;
  // CopyBlend excludes ClipRect.Right/Bottom, so we also
  // need to exclude it.
  if r.Right >= fClipRect.Right then r.Right := fClipRect.Right - 1;
  if r.Bottom >= fClipRect.Bottom then r.Bottom := fClipRect.Bottom - 1;

  if r.Right < r.Left then Exit;
  if r.Bottom < r.Top then Exit;

  w := r.Right - r.Left + 1;
  h := r.Bottom - r.Top + 1;
  p := GetDstPixel(r.Left, r.Top);
  if w = fImgWidth then
    FillChar(p^, w * h * SizeOf(TColor32), 0)
  else
  begin
    for i := 1 to h do
    begin
      FillChar(p^, w * SizeOf(TColor32), 0);
      inc(p, fImgWidth);
    end;
  end;
end;

// ------------------------------------------------------------------------------
function TMaskRenderer.SupportsRenderProcSkip: Boolean;
begin
  Result := True;
end;

// ------------------------------------------------------------------------------
// TCustomRendererCache
// ------------------------------------------------------------------------------

constructor TCustomRendererCache.Create;
begin
  inherited Create;
  fColorRenderer := TColorRenderer.Create;
  fAliasedColorRenderer := TAliasedColorRenderer.Create;
  fMaskRenderer := TMaskRenderer.Create;
end;
// ------------------------------------------------------------------------------

destructor TCustomRendererCache.Destroy;
begin
  fColorRenderer.Free;
  fAliasedColorRenderer.Free;
  fMaskRenderer.Free;
end;
// ------------------------------------------------------------------------------

function TCustomRendererCache.GetColorRenderer(color: TColor32): TColorRenderer;
begin
  Result := fColorRenderer;
  Result.SetColor(color);
end;

// ------------------------------------------------------------------------------
// TBrushImageRenderer
// ------------------------------------------------------------------------------

constructor TImageRenderer.Create(tileFillStyle: TTileFillStyle;
  brushImage: TImage32);
begin
  inherited Create;
  fImage := TImage32.Create(brushImage);
  SetTileFillStyle(tileFillStyle);
end;
// ------------------------------------------------------------------------------

destructor TImageRenderer.Destroy;
begin
  fImage.Free;
  inherited;
end;
// ------------------------------------------------------------------------------

procedure TImageRenderer.SetTileFillStyle(value: TTileFillStyle);
begin
  case value of
    tfsRepeat: fBoundsProc := RepeatQ;
    tfsMirrorHorz: fBoundsProc := MirrorQ;
    tfsMirrorVert: fBoundsProc := RepeatQ;
    tfsRotate180 : fBoundsProc := MirrorQ;
  end;
  fMirrorY := value in [tfsMirrorVert, tfsRotate180];
end;
// ------------------------------------------------------------------------------

function TImageRenderer.Initialize(targetImage: TImage32): Boolean;
begin
  result := inherited Initialize(targetImage) and (not fImage.IsEmpty);
  if not result then Exit;
  fLastYY := 0;
  fBrushPixel := PARGB(fImage.PixelBase);
end;
// ------------------------------------------------------------------------------

procedure TImageRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i: integer;
  pDst: PColor32;
  pImg: PColor32;
  opacityTable: PByteArray;
begin
  pDst := GetDstPixel(x1,y);
  dec(x1, fOffset.X);
  dec(x2, fOffset.X);
  dec(y, fOffset.Y);
  pImg := GetFirstBrushPixel(x1, y);
  if Opacity < 255 then
  begin
    opacityTable := PByteArray(@MulTable[Opacity]);
    for i := x1 to x2 do
    begin
      pDst^ := BlendToAlpha3(pDst^, pImg^, opacityTable[Ord(alpha^)]);
      inc(pDst); inc(alpha);
      pImg := PColor32(GetPixel(fBrushPixel, fBoundsProc(i, fImage.Width)));
    end;
  end else
    for i := x1 to x2 do
    begin
      pDst^ := BlendToAlpha3(pDst^, pImg^, Ord(alpha^));
      inc(pDst); inc(alpha);
      pImg := PColor32(GetPixel(fBrushPixel, fBoundsProc(i, fImage.Width)));
    end;
end;
// ------------------------------------------------------------------------------

function TImageRenderer.GetFirstBrushPixel(x, y: integer): PColor32;
begin
  if fMirrorY then
    y := MirrorQ(y, fImage.Height) else
    y := RepeatQ(y, fImage.Height);
  if y <> fLastYY then
  begin
    fBrushPixel := PARGB(fImage.PixelRow[y]);
    fLastYY := y;
  end;
  x := fBoundsProc(x, fImage.Width);
  result := PColor32(GetPixel(fBrushPixel, x));
end;

// ------------------------------------------------------------------------------
// TGradientRenderer
// ------------------------------------------------------------------------------

constructor TCustomGradientRenderer.Create;
begin
  inherited Create;
  fBoundsProc := ClampQ; //default proc
end;
// ------------------------------------------------------------------------------

procedure TCustomGradientRenderer.Clear;
begin
  fGradientColors := nil;
  fColors := nil;
end;
// ------------------------------------------------------------------------------

procedure TCustomGradientRenderer.SetGradientFillStyle(value: TGradientFillStyle);
begin
  case value of
    gfsClamp: fBoundsProc := ClampQ;
    gfsMirror: fBoundsProc := MirrorQ;
    else fBoundsProc := RepeatQ;
  end;
end;
// ------------------------------------------------------------------------------

procedure TCustomGradientRenderer.SetParameters(startColor, endColor: TColor32;
  gradFillStyle: TGradientFillStyle = gfsClamp);
begin
  SetGradientFillStyle(gradFillStyle);
  // reset gradient colors if perviously set
  SetLength(fGradientColors, 2);
  fGradientColors[0].offset := 0;
  fGradientColors[0].color := startColor;
  fGradientColors[1].offset := 1;
  fGradientColors[1].color := endColor;
end;
// ------------------------------------------------------------------------------

procedure TCustomGradientRenderer.InsertColorStop(offsetFrac: double; color: TColor32);
var
  i, len: integer;
  gradColor: TGradientColor;
begin
  len := Length(fGradientColors);
  // colorstops can only be inserted after calling SetParameters
  if len = 0 then Exit;

  if offsetFrac < 0 then offsetFrac := 0
  else if offsetFrac > 1 then offsetFrac := 1;

  if offsetFrac = 0 then
  begin
    fGradientColors[0].color := color;
    Exit;
  end
  else if offsetFrac = 1 then
  begin
    fGradientColors[len -1].color := color;
    Exit;
  end;
  gradColor.offset := offsetFrac;
  gradColor.color  := color;

  i := 1;
  while (i < len-1) and
    (fGradientColors[i].offset <= offsetFrac) do inc(i);
  SetLength(fGradientColors, len +1);
  Move(fGradientColors[i],
    fGradientColors[i+1], (len -i) * SizeOf(TGradientColor));
  fGradientColors[i] := gradColor;
end;

// ------------------------------------------------------------------------------
// TLinearGradientRenderer
// ------------------------------------------------------------------------------

procedure TLinearGradientRenderer.SetParameters(const startPt, endPt: TPointD;
  startColor, endColor: TColor32; gradFillStyle: TGradientFillStyle);
begin
  inherited SetParameters(startColor, endColor, gradFillStyle);
  fStartPt := startPt;
  fEndPt := endPt;
end;
// ------------------------------------------------------------------------------

function TLinearGradientRenderer.Initialize(targetImage: TImage32): Boolean;
var
  i: integer;
  dx,dy, dxdy,dydx: double;
begin
  result := inherited Initialize(targetImage) and assigned(fGradientColors);
  if not result then Exit;

  if abs(fEndPt.Y - fStartPt.Y) > abs(fEndPt.X - fStartPt.X) then
  begin
    // gradient > 45 degrees
    if (fEndPt.Y < fStartPt.Y) then
    begin
      ReverseColors(fGradientColors);
      SwapPoints(fStartPt, fEndPt);
    end;
    fIsVert := true;
    dx := (fEndPt.X - fStartPt.X);
    dy := (fEndPt.Y - fStartPt.Y);
    dxdy := dx/dy;

    fColorsCnt := Ceil(dy + dxdy * (fEndPt.X - fStartPt.X));
    MakeColorGradient(fGradientColors, fColorsCnt, fColors);
    // get a list of perpendicular offsets for each
    NewIntegerArray(fPerpendicOffsets, ImgWidth, True);
    // from an imaginary line that's through fStartPt and perpendicular to
    // the gradient line, get a list of Y offsets for each X in image width
    for i := 0 to ImgWidth -1 do
      fPerpendicOffsets[i] := Round(dxdy * (fStartPt.X - i) + fStartPt.Y);
  end
  else //gradient <= 45 degrees
  begin
    if (fEndPt.X = fStartPt.X) then
    begin
      Result := false;
      Exit;
    end;
    if (fEndPt.X < fStartPt.X) then
    begin
      ReverseColors(fGradientColors);
      SwapPoints(fStartPt, fEndPt);
    end;
    fIsVert := false;
    dx := (fEndPt.X - fStartPt.X);
    dy := (fEndPt.Y - fStartPt.Y);
    dydx := dy/dx; //perpendicular slope

    fColorsCnt := Ceil(dx + dydx * (fEndPt.Y - fStartPt.Y));
    MakeColorGradient(fGradientColors, fColorsCnt, fColors);
    NewIntegerArray(fPerpendicOffsets, ImgHeight, True);
    // from an imaginary line that's through fStartPt and perpendicular to
    // the gradient line, get a list of X offsets for each Y in image height
    for i := 0 to ImgHeight -1 do
      fPerpendicOffsets[i] := Round(dydx * (fStartPt.Y - i) + fStartPt.X);
  end;
end;
// ------------------------------------------------------------------------------

procedure TLinearGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i, colorsCnt: integer;
  pDst: PColor32;
  color: TColor32;
  boundsProc: TBoundsProc;
  offset: Integer;
  colors: PColor32Array;
  perpendicOffsets: PIntegerArray;
  opacityTable: PByteArray;
begin
  pDst := GetDstPixel(x1,y);
  // optimize self fields access
  colorsCnt := fColorsCnt;
  colors := @fColors[0];
  boundsProc := fBoundsProc;
  if fIsVert then
  begin
    perpendicOffsets := @fPerpendicOffsets[0]; // optimize self field access
    if Opacity < 255 then
    begin
      opacityTable := PByteArray(@MulTable[Opacity]);
      for i := x1 to x2 do
      begin
        // when fIsVert = true, fPerpendicOffsets is an array of Y for each X
        color := colors[boundsProc(y - perpendicOffsets[i], colorsCnt)];
        pDst^ := BlendToAlpha3(pDst^, color, opacityTable[Ord(alpha^)]);
        inc(pDst); inc(alpha);
      end;
    end else
    begin
      for i := x1 to x2 do
      begin
        // when fIsVert = true, fPerpendicOffsets is an array of Y for each X
        color := colors[boundsProc(y - perpendicOffsets[i], colorsCnt)];
        pDst^ := BlendToAlpha3(pDst^, color, Ord(alpha^));
        inc(pDst); inc(alpha);
      end;
    end;
  end
  else
  begin
    // when fIsVert = false, fPerpendicOffsets is an array of X for each Y
    offset := fPerpendicOffsets[y];
    if Opacity < 255 then
    begin
      opacityTable := PByteArray(@MulTable[Opacity]);
      for i := x1 to x2 do
      begin
        color := colors[boundsProc(i - offset, colorsCnt)];
        pDst^ := BlendToAlpha3(pDst^, color, opacityTable[Ord(alpha^)]);
        inc(pDst); inc(alpha);
      end;
    end else
    begin
      for i := x1 to x2 do
      begin
        color := colors[boundsProc(i - offset, colorsCnt)];
        pDst^ := BlendToAlpha3(pDst^, color, Ord(alpha^));
        inc(pDst); inc(alpha);
      end;
    end;
  end;
end;

// ------------------------------------------------------------------------------
// TRadialGradientRenderer
// ------------------------------------------------------------------------------

function TRadialGradientRenderer.Initialize(targetImage: TImage32): Boolean;
begin
  result := inherited Initialize(targetImage) and (fColorsCnt > 1);
  if result then
    MakeColorGradient(fGradientColors, fColorsCnt, fColors);
end;
// ------------------------------------------------------------------------------

procedure TRadialGradientRenderer.SetParameters(const focalRect: TRect;
  innerColor, outerColor: TColor32;
  gradientFillStyle: TGradientFillStyle);
var
  w,h: integer;
  radX,radY: double;
begin
  inherited SetParameters(innerColor, outerColor, gradientFillStyle);
  fColorsCnt := 0;
  if IsEmptyRect(focalRect) then Exit;

  fCenterPt.X  := (focalRect.Left + focalRect.Right) * 0.5;
  fCenterPt.Y  := (focalRect.Top + focalRect.Bottom) * 0.5;
  RectWidthHeight(focalRect, w, h);
  radX    :=  w * 0.5;
  radY    :=  h * 0.5;
  if radX >= radY then
  begin
    fScaleX     := 1;
    fScaleY     := radX/radY;
    fColorsCnt := Ceil(radX) +1;
  end else
  begin
    fScaleX     := radY/radX;
    fScaleY     := 1;
    fColorsCnt := Ceil(radY) +1;
  end;
end;
// ------------------------------------------------------------------------------

procedure TRadialGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i: integer;
  dist: double;
  color: TColor32;
  pDst: PColor32;
  opacityTable: PByteArray;
begin
  pDst := GetDstPixel(x1,y);
  if Opacity < 255 then
  begin
    opacityTable := PByteArray(@MulTable[Opacity]);
    for i := x1 to x2 do
    begin
      dist := Hypot((y - fCenterPt.Y) *fScaleY, (i - fCenterPt.X) *fScaleX);
      color := fColors[fBoundsProc(Trunc(dist), fColorsCnt)];
      pDst^ := BlendToAlpha3(pDst^, color, opacityTable[Ord(alpha^)]);
      inc(pDst); inc(alpha);
    end;
  end else
  begin
    for i := x1 to x2 do
    begin
      dist := Hypot((y - fCenterPt.Y) *fScaleY, (i - fCenterPt.X) *fScaleX);
      color := fColors[fBoundsProc(Trunc(dist), fColorsCnt)];
      pDst^ := BlendToAlpha3(pDst^, color, Ord(alpha^));
      inc(pDst); inc(alpha);
    end;
  end;
end;

// ------------------------------------------------------------------------------
// TSvgRadialGradientRenderer
// ------------------------------------------------------------------------------

function TSvgRadialGradientRenderer.Initialize(targetImage: TImage32): Boolean;
begin
  result := inherited Initialize(targetImage) and (fColorsCnt > 1);
  if result then
    MakeColorGradient(fGradientColors, fColorsCnt, fColors);
end;
// ------------------------------------------------------------------------------

procedure TSvgRadialGradientRenderer.SetParameters(const ellipseRect: TRect;
  const focus: TPoint; innerColor, outerColor: TColor32;
  gradientFillStyle: TGradientFillStyle = gfsClamp);
var
  w, h  : integer;
begin
  inherited SetParameters(innerColor, outerColor);
  case gradientFillStyle of
    gfsMirror: fBoundsProcD := MirrorD;
    gfsRepeat: fBoundsProcD := RepeatD;
    else fBoundsProcD := ClampD;
  end;

  fColorsCnt := 0;
  if IsEmptyRect(ellipseRect) then Exit;

  fCenterPt  := RectD(ellipseRect).MidPoint;
  RectWidthHeight(ellipseRect, w, h);
  fA    := w * 0.5;
  fB    := h * 0.5;

  fFocusPt.X := focus.X - fCenterPt.X;
  fFocusPt.Y := focus.Y - fCenterPt.Y;
  fColorsCnt := Ceil(Hypot(fA*2, fB*2)) +1;
  fAA := fA * fA;
  fBB := fB * fB;
end;
// ------------------------------------------------------------------------------

procedure TSvgRadialGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i: integer;
  q,qq, m,c, qa,qb,qc,qs: double;
  dist, dist2: double;
  color: TColor32;
  pDst: PColor32;
  pt, ellipsePt: TPointD;
  opacityTable: PByteArray;
begin
  opacityTable := PByteArray(@MulTable[Opacity]);
  // get the left-most pixel to render
  pDst := GetDstPixel(x1,y);
  pt.X := x1 - fCenterPt.X; pt.Y := y - fCenterPt.Y;
  for i := x1 to x2 do
  begin
    // equation of ellipse = (x*x)/aa + (y*y)/bb = 1
    // equation of line = y = mx + c;
    if (pt.X = fFocusPt.X) then //vertical line
    begin
      // let x = pt.X, then y*y = b*b(1 - Sqr(pt.X)/aa)
      qq := (1 - Sqr(pt.X)/fAA);
      if (qq > 1) then qq := 1
      else if (qq < 0) then qq := 0;
      q := Sqrt(fBB*qq);
      ellipsePt.X := pt.X;
      if pt.Y >= fFocusPt.Y then
        ellipsePt.Y := q else
        ellipsePt.Y := -q;
      dist := abs(pt.Y - fFocusPt.Y);
      dist2 := abs(ellipsePt.Y - fFocusPt.Y);
      if dist2 = 0 then
        q := 1 else
        q := dist/ dist2;
    end else
    begin
      // using simultaneous equations and substitution
      // given y = mx + c
      m := (pt.Y - fFocusPt.Y)/(pt.X - fFocusPt.X);
      c := pt.Y - m * pt.X;
      // given (x*x)/aa + (y*y)/bb = 1
      // (x*x)/aa*bb + (y*y) = bb
      // bb/aa *(x*x) + Sqr(m*x +c) = bb
      // bb/aa *(x*x) + (m*m)*(x*x) + 2*m*x*c +c*c = b*b
      // (bb/aa +(m*m)) *(x*x) + 2*m*c*(x) + (c*c) - bb = 0
      // solving quadratic equation
      qa := (fBB/fAA +(m*m));
      qb := 2*m*c;
      qc := (c*c) - fBB;
      qs := (qb*qb) - 4*qa*qc;
      if qs >= 0 then
      begin
        qs := Sqrt(qs);
        if pt.X <= fFocusPt.X then
          ellipsePt.X := (-qb -qs)/(2 * qa) else
          ellipsePt.X := (-qb +qs)/(2 * qa);
        ellipsePt.Y := m * ellipsePt.X + c;

        // Use sqr'ed distances (Sqrt(a^2+b^2)/Sqrt(x^2+y^2) => Sqrt((a^2+b^2)/(x^2+y^2))
        dist := Sqr(pt.X - fFocusPt.X) + Sqr(pt.Y - fFocusPt.Y);
        dist2 := Sqr(ellipsePt.X - fFocusPt.X) + Sqr(ellipsePt.Y - fFocusPt.Y);
        if dist2 = 0 then
          q := 1 else
          q := Sqrt(dist/dist2);
      end else
        q := 1; //shouldn't happen :)
    end;
    color := fColors[fBoundsProcD(Abs(q), fColorsCnt)];
    pDst^ := BlendToAlpha3(pDst^, color, opacityTable[Ord(alpha^)]);
    inc(pDst); pt.X := pt.X + 1; inc(alpha);
  end;
end;

// ------------------------------------------------------------------------------
// TEraseRenderer
// ------------------------------------------------------------------------------

procedure TEraseRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i: integer;
  dst: PARGB;
begin
  dst := PARGB(GetDstPixel(x1,y));
  for i := x1 to x2 do
  begin
    {$IFDEF PBYTE}
    dst.A := MulTable[dst.A, not alpha^];
    {$ELSE}
    dst.A := MulTable[dst.A, not Ord(alpha^)];
    {$ENDIF}
    inc(dst); inc(alpha);
  end;
end;

// ------------------------------------------------------------------------------
// TInverseRenderer
// ------------------------------------------------------------------------------

procedure TInverseRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  i: integer;
  dst: PARGB;
  c: TARGB;
begin
  dst := PARGB(GetDstPixel(x1,y));
  for i := x1 to x2 do
  begin
    c.Color := not dst.Color;
    c.A := MulTable[dst.A, Ord(alpha^)];
    dst.Color := BlendToAlpha(dst.Color, c.Color);
    inc(dst); inc(alpha);
  end;
end;

// ------------------------------------------------------------------------------

procedure TBarycentricRenderer.SetParameters(const a, b, c: TPointD;
  c1, c2, c3: TColor32);
begin

  self.a := a;
  self.c1.Color := c1;
  self.c2.Color := c2;
  self.c3.Color := c3;

  v0.X := b.X - a.X;
  v0.Y := b.Y - a.Y;
  v1.X := c.X - a.X;
  v1.Y := c.Y - a.Y;
  d00 := (v0.X * v0.X + v0.Y * v0.Y);
  d01 := (v0.X * v1.X + v0.Y * v1.Y);
  d11 := (v1.X * v1.X + v1.Y * v1.Y);
  invDenom := 1/(d00 * d11 - d01 * d01);
end;
// ------------------------------------------------------------------------------

function TBarycentricRenderer.GetColor(const pt: TPointD): TColor32;
var
  v2: TPointD;
  d20, d21, v, w, u: Double;
  res: TARGB absolute Result;
begin
  Result := 0;
  v2.X := pt.X - a.X;
  v2.Y := pt.Y - a.Y;
  d20 := (v2.X * v0.X + v2.Y * v0.Y);
  d21 := (v2.X * v1.X + v2.Y * v1.Y);

  v := (d11 * d20 - d01 * d21) * invDenom;
  w := (d00 * d21 - d01 * d20) * invDenom;
  u := 1.0 - v - w;

  Res.A := ClampByte(c1.A * u + c2.A * v + c3.A * w);
  Res.R := ClampByte(c1.R * u + c2.R * v + c3.R * w);
  Res.G := ClampByte(c1.G * u + c2.G * v + c3.G * w);
  Res.B := ClampByte(c1.B * u + c2.B * v + c3.B * w);
end;
// ------------------------------------------------------------------------------

procedure TBarycentricRenderer.RenderProc(x1, x2, y: integer; alpha: PByte);
var
  x: integer;
  p: PARGB;
  c: TARGB;
  opacityTable: PByteArray;
begin
  p := PARGB(fImgBase);
  inc(p, y * ImgWidth + x1);
  if Opacity < 255 then
  begin
    opacityTable := PByteArray(@MulTable[Opacity]);
    for x := x1 to x2 do
    begin
      c.Color := GetColor(PointD(x, y));
      c.A := opacityTable[MulTable[c.A, Ord(alpha^)]];
      p.Color := BlendToAlpha(p.Color, c.Color);
      inc(p); inc(alpha);
    end
  end
  else
    for x := x1 to x2 do
    begin
      c.Color := GetColor(PointD(x, y));
      c.A := MulTable[c.A, Ord(alpha^)];
      p.Color := BlendToAlpha(p.Color, c.Color);
      inc(p); inc(alpha);
    end


end;

// ------------------------------------------------------------------------------
// Draw functions
// ------------------------------------------------------------------------------

procedure DrawPoint(img: TImage32;
  const pt: TPointD; radius: double; color: TColor32);
var
  path: TPathD;
begin
  if radius <= 1 then
    path := Rectangle(pt.X-radius, pt.Y-radius, pt.X+radius, pt.Y+radius) else
    path := Ellipse(RectD(pt.X-radius, pt.Y-radius, pt.X+radius, pt.Y+radius));
  DrawPolygon(img, path, frEvenOdd, color);
end;
// ------------------------------------------------------------------------------

procedure DrawPoint(img: TImage32; const pt: TPointD;
  radius: double; renderer: TCustomRenderer);
var
  path: TPathD;
begin
  path := Ellipse(RectD(pt.X -radius, pt.Y -radius, pt.X +radius, pt.Y +radius));
  DrawPolygon(img, path, frEvenOdd, renderer);
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedPoint(img: TImage32; const pt: TPointD; radius: double);
var
  cr: TCustomRenderer;
begin
  cr := TInverseRenderer.Create;
  try
    DrawPoint(img, pt, radius, cr);
  finally
    cr.Free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawPoint(img: TImage32; const points: TPathD;
  radius: double; color: TColor32);
var
  i: integer;
begin
  for i := 0 to high(points) do
    DrawPoint(img, points[i], radius, color);
end;
// ------------------------------------------------------------------------------

procedure DrawPoint(img: TImage32; const paths: TPathsD;
  radius: double; color: TColor32);
var
  i: integer;
begin
  for i := 0 to high(paths) do
    DrawPoint(img, paths[i], radius, color);
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32;
  const pt1, pt2: TPointD; lineWidth: double; color: TColor32);
var
  lines: TPathsD;
begin
  setLength(lines, 1);
  NewPointDArray(lines[0], 2, True);
  lines[0][0] := pt1;
  lines[0][1] := pt2;
  DrawLine(img, lines, lineWidth, color, esRound);
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32; const line: TPathD; lineWidth: double;
  color: TColor32; endStyle: TEndStyle; joinStyle: TJoinStyle;
  miterLimit: double);
var
  lines: TPathsD;
begin
  setLength(lines, 1);
  lines[0] := line;
  DrawLine(img, lines, lineWidth, color, endStyle, joinStyle, miterLimit);
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32; const line: TPathD; lineWidth: double;
  color: TColor32; rendererCache: TCustomRendererCache;
  endStyle: TEndStyle; joinStyle: TJoinStyle; miterLimit: double);
var
  lines: TPathsD;
begin
  setLength(lines, 1);
  lines[0] := line;
  DrawLine(img, lines, lineWidth, color, rendererCache, endStyle, joinStyle,
    miterLimit);
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32; const line: TPathD; lineWidth: double;
  renderer: TCustomRenderer; endStyle: TEndStyle; joinStyle: TJoinStyle;
  miterLimit: double);
var
  lines: TPathsD;
begin
  setLength(lines, 1);
  lines[0] := line;
  DrawLine(img, lines, lineWidth, renderer, endStyle, joinStyle, miterLimit);
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedLine(img: TImage32; const line: TPathD;
lineWidth: double; endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto);
var
  lines: TPathsD;
begin
  setLength(lines, 1);
  lines[0] := line;
  DrawInvertedLine(img, lines, lineWidth, endStyle, joinStyle);
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32; const lines: TPathsD;
  lineWidth: double; color: TColor32;
  endStyle: TEndStyle; joinStyle: TJoinStyle; miterLimit: double);
var
  cr: TCustomColorRenderer;
begin
  if not assigned(lines) then exit;

  if img.AntiAliased then
    cr := TColorRenderer.Create(color) else
    cr := TAliasedColorRenderer.Create(color);
  try
    DrawLine(img, lines, lineWidth, cr, endStyle, joinStyle, miterLimit);
  finally
    cr.free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32; const lines: TPathsD;
  lineWidth: double; color: TColor32; rendererCache: TCustomRendererCache;
  endStyle: TEndStyle; joinStyle: TJoinStyle; miterLimit: double);
var
  cr: TCustomColorRenderer;
begin
  if not assigned(lines) then exit;
  if rendererCache = nil then
    DrawLine(img, lines, lineWidth, color, endStyle, joinStyle, miterLimit)
  else
  begin
    if img.AntiAliased then
      cr := rendererCache.ColorRenderer else
      cr := rendererCache.AliasedColorRenderer;
    DrawLine(img, lines, lineWidth, cr, endStyle, joinStyle, miterLimit);
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawLine(img: TImage32; const lines: TPathsD;
  lineWidth: double; renderer: TCustomRenderer;
  endStyle: TEndStyle; joinStyle: TJoinStyle;
  miterLimit: double);
var
  lines2: TPathsD;
begin
  if (not assigned(lines)) or (not assigned(renderer)) then exit;
  if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth;
  lines2 := RoughOutline(lines, lineWidth, joinStyle, endStyle, miterLimit);
  Rasterize(img, lines2, img.bounds, frNonZero, renderer);
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedLine(img: TImage32;
  const lines: TPathsD; lineWidth: double;
  endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto);
var
  lines2: TPathsD;
  ir: TInverseRenderer;
begin
  if not assigned(lines) then exit;
  if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth;
  lines2 := RoughOutline(lines, lineWidth, joinStyle, endStyle, 2);
  ir := TInverseRenderer.Create;
  try
    Rasterize(img, lines2, img.bounds, frNonZero, ir);
  finally
    ir.free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawDashedLine(img: TImage32; const line: TPathD;
  dashPattern: TArrayOfDouble; patternOffset: PDouble; lineWidth: double;
  color: TColor32; endStyle: TEndStyle; joinStyle: TJoinStyle;
  rendererCache: TCustomRendererCache);
var
  lines: TPathsD;
  cr: TColorRenderer;
  i: integer;
begin
  if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth;
  if not assigned(line) then exit;

  for i := 0 to High(dashPattern) do
    if dashPattern[i] <= 0 then dashPattern[i] := 1;

  lines := GetDashedPath(line, endStyle = esPolygon, dashPattern, patternOffset);
  if Length(lines) = 0 then Exit;

  case joinStyle of
    jsAuto:
      if endStyle = esRound then
        joinStyle := jsRound else
        joinStyle := jsSquare;
    jsSquare, jsMiter:
      endStyle := esSquare;
    jsRound:
      endStyle := esRound;
    jsButt:
      endStyle := esButt;
  end;
  lines := RoughOutline(lines, lineWidth, joinStyle, endStyle);

  if rendererCache = nil then
    cr := TColorRenderer.Create(color) else
    cr := rendererCache.GetColorRenderer(color);
  try
    Rasterize(img, lines, img.bounds, frNonZero, cr);
  finally
    if rendererCache = nil then
      cr.free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawDashedLine(img: TImage32; const lines: TPathsD;
  dashPattern: TArrayOfDouble; patternOffset: PDouble; lineWidth: double;
  color: TColor32; endStyle: TEndStyle; joinStyle: TJoinStyle;
  rendererCache: TCustomRendererCache);
var
  i: integer;
begin
  if not assigned(lines) then exit;
  for i := 0 to high(lines) do
    DrawDashedLine(img, lines[i],
      dashPattern, patternOffset, lineWidth, color, endStyle, joinStyle,
      rendererCache);
end;
// ------------------------------------------------------------------------------

procedure DrawDashedLine(img: TImage32; const line: TPathD;
  dashPattern: TArrayOfDouble; patternOffset: PDouble; lineWidth: double;
  renderer: TCustomRenderer; endStyle: TEndStyle; joinStyle: TJoinStyle);
var
  i: integer;
  lines: TPathsD;
begin
  if (not assigned(line)) or (not assigned(renderer)) then exit;
  if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth;

  for i := 0 to High(dashPattern) do
    if dashPattern[i] <= 0 then dashPattern[i] := 1;

  lines := GetDashedPath(line, endStyle = esPolygon, dashPattern, patternOffset);
  if Length(lines) = 0 then Exit;
  lines := RoughOutline(lines, lineWidth, joinStyle, endStyle);
  Rasterize(img, lines, img.bounds, frNonZero, renderer);
end;
// ------------------------------------------------------------------------------

procedure DrawDashedLine(img: TImage32; const lines: TPathsD;
  dashPattern: TArrayOfDouble; patternOffset: PDouble; lineWidth: double;
  renderer: TCustomRenderer; endStyle: TEndStyle; joinStyle: TJoinStyle);
var
  i: integer;
begin
  if not assigned(lines) then exit;
  for i := 0 to high(lines) do
    DrawDashedLine(img, lines[i],
      dashPattern, patternOffset, lineWidth, renderer, endStyle, joinStyle);
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedDashedLine(img: TImage32;
  const line: TPathD; dashPattern: TArrayOfDouble;
  patternOffset: PDouble; lineWidth: double; endStyle: TEndStyle;
  joinStyle: TJoinStyle = jsAuto);
var
  i: integer;
  lines: TPathsD;
  renderer: TInverseRenderer;
begin
  if not assigned(line) then exit;
  if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth;

  for i := 0 to High(dashPattern) do
    if dashPattern[i] <= 0 then dashPattern[i] := 1;

  lines := GetDashedPath(line, endStyle = esPolygon, dashPattern, patternOffset);
  if Length(lines) = 0 then Exit;
  lines := RoughOutline(lines, lineWidth, joinStyle, endStyle);
  renderer := TInverseRenderer.Create;
  try
    Rasterize(img, lines, img.bounds, frNonZero, renderer);
  finally
    renderer.Free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedDashedLine(img: TImage32;
  const lines: TPathsD; dashPattern: TArrayOfDouble;
  patternOffset: PDouble; lineWidth: double;
  endStyle: TEndStyle; joinStyle: TJoinStyle = jsAuto);
var
  i: integer;
begin
  if not assigned(lines) then exit;
  for i := 0 to high(lines) do
    DrawInvertedDashedLine(img, lines[i],
      dashPattern, patternOffset, lineWidth, endStyle, joinStyle);
end;
// ------------------------------------------------------------------------------

procedure DrawPolygon(img: TImage32; const polygon: TPathD;
  fillRule: TFillRule; color: TColor32);
var
  polygons: TPathsD;
begin
  if not assigned(polygon) then exit;
  setLength(polygons, 1);
  polygons[0] := polygon;
  DrawPolygon(img, polygons, fillRule, color);
end;
// ------------------------------------------------------------------------------

procedure DrawPolygon(img: TImage32; const polygon: TPathD;
  fillRule: TFillRule; renderer: TCustomRenderer);
var
  polygons: TPathsD;
begin
  if (not assigned(polygon)) or (not assigned(renderer)) then exit;
  setLength(polygons, 1);
  polygons[0] := polygon;
  Rasterize(img, polygons, img.Bounds, fillRule, renderer);
end;
// ------------------------------------------------------------------------------

procedure DrawPolygon(img: TImage32; const polygons: TPathsD;
  fillRule: TFillRule; color: TColor32);
var
  cr: TCustomRenderer;
begin
  if not assigned(polygons) then exit;
  if img.AntiAliased then
    cr := TColorRenderer.Create(color) else
    cr := TAliasedColorRenderer.Create(color);
  try
    Rasterize(img, polygons, img.bounds, fillRule, cr);
  finally
    cr.free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawPolygon(img: TImage32; const polygons: TPathsD;
  fillRule: TFillRule; color: TColor32;
  rendererCache: TCustomRendererCache);
var
  cr: TCustomColorRenderer;
begin
  if not assigned(polygons) then exit;
  if rendererCache = nil then
    DrawPolygon(img, polygons, fillRule, color)
  else
  begin
    if img.AntiAliased then
      cr := rendererCache.ColorRenderer else
      cr := rendererCache.AliasedColorRenderer;
    cr.SetColor(color);
    Rasterize(img, polygons, img.bounds, fillRule, cr);
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawPolygon(img: TImage32; const polygons: TPathsD;
  fillRule: TFillRule; renderer: TCustomRenderer);
begin
  if (not assigned(polygons)) or (not assigned(renderer)) then exit;
  Rasterize(img, polygons, img.bounds, fillRule, renderer);
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedPolygon(img: TImage32; const polygon: TPathD;
  fillRule: TFillRule);
var
  polygons: TPathsD;
begin
  if not assigned(polygon) then exit;
  setLength(polygons, 1);
  polygons[0] := polygon;
  DrawInvertedPolygon(img, polygons, fillRule);
end;
// ------------------------------------------------------------------------------

procedure DrawInvertedPolygon(img: TImage32; const polygons: TPathsD;
  fillRule: TFillRule);
var
  cr: TCustomRenderer;
begin
  if not assigned(polygons) then exit;
  cr := TInverseRenderer.Create;
  try
    Rasterize(img, polygons, img.bounds, fillRule, cr);
  finally
    cr.free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawPolygon_ClearType(img: TImage32; const polygons: TPathsD;
  fillRule: TFillRule; color: TColor32; backColor: TColor32);
var
  w, h: integer;
  tmpImg: TImage32;
  rec: TRect;
  tmpPolygons: TPathsD;
  cr: TColorRenderer;
begin
  if not assigned(polygons) then exit;

  rec := GetBounds(polygons);
  RectWidthHeight(rec, w, h);
  tmpImg := TImage32.Create(w *3, h);
  try
    tmpPolygons := TranslatePath(polygons, -rec.Left, -rec.Top);
    tmpPolygons := ScalePath(tmpPolygons, 3, 1);
    cr := TColorRenderer.Create(clBlack32);
    try
      Rasterize(tmpImg, tmpPolygons, tmpImg.bounds, fillRule, cr);
    finally
      cr.Free;
    end;
    ApplyClearType(tmpImg, color, backColor);
    img.CopyBlend(tmpImg, tmpImg.Bounds, rec, BlendToAlphaLine);
  finally
    tmpImg.Free;
  end;
end;
// ------------------------------------------------------------------------------

procedure ErasePolygon(img: TImage32; const polygon: TPathD;
  fillRule: TFillRule);
var
  polygons: TPathsD;
begin
  if not assigned(polygon) then exit;
  setLength(polygons, 1);
  polygons[0] := polygon;
  ErasePolygon(img, polygons, fillRule);
end;
// ------------------------------------------------------------------------------

procedure ErasePolygon(img: TImage32; const polygons: TPathsD;
  fillRule: TFillRule);
var
  er: TEraseRenderer;
begin
  er := TEraseRenderer.Create;
  try
    Rasterize(img, polygons, img.bounds, fillRule, er);
  finally
    er.Free;
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawBoolMask(img: TImage32; const mask: TArrayOfByte; color: TColor32);
var
  i, len: integer;
  pc: PColor32;
  pb: PByte;
begin
  len := Length(mask);
  if (len = 0) or (len <> img.Width * img.Height) then Exit;
  pc := img.PixelBase;
  pb := @mask[0];
  for i := 0 to len -1 do
  begin
    {$IFDEF PBYTE}
    if pb^ > 0 then
    {$ELSE}
    if pb^ > #0 then
    {$ENDIF}
      pc^ := color else
      pc^ := clNone32;
    inc(pc); inc(pb);
  end;
end;
// ------------------------------------------------------------------------------

procedure DrawAlphaMask(img: TImage32; const mask: TArrayOfByte; color: TColor32);
var
  i, len: integer;
  pc: PColor32;
  pb: PByte;
begin
  len := Length(mask);
  if (len = 0) or (len <> img.Width * img.Height) then Exit;
  color := color and $FFFFFF; //strip alpha value
  pc := img.PixelBase;
  pb := @mask[0];
  for i := 0 to len -1 do
  begin
    {$IFDEF PBYTE}
    if pb^ > 0 then
      pc^ := color or pb^ shl 24 else
      pc^ := clNone32;
    {$ELSE}
    if pb^ > #0 then
      pc^ := color or Ord(pb^) shl 24 else
      pc^ := clNone32;
    {$ENDIF}
    inc(pc); inc(pb);
  end;
end;
// ------------------------------------------------------------------------------

end.