bgrabitmap.lazpaint/lazpaintcontrols/lcvectorpolyshapes.pas

// SPDX-License-Identifier: GPL-3.0-only
unit LCVectorPolyShapes;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Types, LCVectorOriginal, BGRABitmapTypes, BGRALayerOriginal,
  BGRABitmap, BGRATransform, BGRAGradients, BGRAGraphics,
  BGRASVGShapes, BGRASVGType, BGRAUnits, BGRAPath;

type
  TArrowKind = (akNone, akTail, akTip, akNormal, akCut, akFlipped, akFlippedCut,
                akTriangle, akTriangleBack1, akTriangleBack2,
                akHollowTriangle, akHollowTriangleBack1, akHollowTriangleBack2);

const
  errShapeNotHandled = 'Shape not handled';
  ArrowKindToStr: array[TArrowKind] of string =
    ('none', 'tail', 'tip', 'normal', 'cut', 'flipped', 'flipped-cut',
     'triangle', 'triangle-back1', 'triangle-back2',
     'hollow-triangle', 'hollow-triangle-back1', 'hollow-triangle-back2');
  LineCapToStr: array[TPenEndCap] of string =
    ('round','square','flat');

function StrToArrowKind(AStr: string): TArrowKind;
function StrToLineCap(AStr: string): TPenEndCap;

type
  TCustomPolypointShape = class;
  TCustomPolypointPoint = record
    coord: TPointF;
    editorIndex: integer;
    data: cardinal;
  end;

  { TCustomPolypointShapeDiff }

  TCustomPolypointShapeDiff = class(TVectorShapeDiff)
  protected
    FStartPoints: array of TCustomPolypointPoint;
    FStartClosed: boolean;
    FStartArrowStartKind,FStartArrowEndKind: TArrowKind;
    FStartArrowSize: TPointF;
    FStartLineCap: TPenEndCap;
    FEndPoints: array of TCustomPolypointPoint;
    FEndClosed: boolean;
    FEndArrowStartKind,FEndArrowEndKind: TArrowKind;
    FEndArrowSize: TPointF;
    FEndLineCap: TPenEndCap;
  public
    constructor Create(AStartShape: TVectorShape); override;
    procedure ComputeDiff(AEndShape: TVectorShape); override;
    procedure Apply(AStartShape: TVectorShape); override;
    procedure Unapply(AEndShape: TVectorShape); override;
    procedure Append(ADiff: TVectorShapeDiff); override;
    function IsIdentity: boolean; override;
  end;

  { TCustomPolypointShape }

  TCustomPolypointShape = class(TVectorShape)
  private
    FClosed: boolean;
    function GetHoverPoint: integer;
    function GetLineCap: TPenEndCap;
    function GetPoint(AIndex: integer): TPointF;
    function GetPointCount: integer;
    function GetValidatedPointCount: integer;
    procedure SetArrowEndKind(AValue: TArrowKind);
    procedure SetArrowSize(AValue: TPointF);
    procedure SetArrowStartKind(AValue: TArrowKind);
    procedure SetCenterPoint(AValue: TPointF);
    procedure SetHoverCenter(AValue: boolean);
    procedure SetHoverPoint(AValue: integer);
    procedure SetLineCap(AValue: TPenEndCap);
    procedure SetPoint(AIndex: integer; AValue: TPointF);
  protected
    FPoints: array of TCustomPolypointPoint;
    FCenterPoint: TPointF;
    FCenterPointEditorIndex: integer;
    FCurPoint: integer;
    FAddingPoint, FAltPressed: boolean;
    FMousePos: TPointF;
    FHoverPoint: integer;
    FHoverCenter: boolean;
    FArrowStartKind,FArrowEndKind: TArrowKind;
    FArrowSize: TPointF;
    FViewMatrix, FViewMatrixInverse, FGridMatrix: TAffineMatrix;
    procedure OnMovePoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
    procedure OnMoveCenterPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
    procedure OnStartMove({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState);
    function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; virtual;
    function GetPath(AMatrix: TAffineMatrix): TBGRAPath; virtual; overload;
    function GetPath(const APoints: array of TPointF): TBGRAPath; overload;
    procedure SetUsermode(AValue: TVectorShapeUsermode); override;
    function GetClosed: boolean; virtual;
    procedure SetClosed(AValue: boolean); virtual;
    function PointsEqual(const APoint1, APoint2: TPointF): boolean;
    procedure OnHoverPoint({%H-}ASender: TObject; APointIndex: integer); virtual;
    procedure OnClickPoint({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState); virtual;
    procedure DoClickPoint({%H-}APointIndex: integer; {%H-}AShift: TShiftState); virtual;
    function CanMovePoints: boolean; virtual;
    procedure InsertPointAuto(AShift: TShiftState);
    function ComputeStroke(APoints: ArrayOfTPointF; AClosed: boolean;
      AStrokeMatrix: TAffineMatrix): ArrayOfTPointF; override;
    function GetLoopStartIndex: integer;
    function GetLoopPointCount: integer;
    function GetIsFollowingMouse: boolean; override;
  public
    constructor Create(AContainer: TVectorOriginal); override;
    procedure Clear;
    function AddPoint(const APoint: TPointF): integer; virtual;
    function RemovePoint(AIndex: integer): boolean;
    procedure RemovePointRange(AFromIndex, AToIndexPlus1: integer);
    procedure InsertPoint(AIndex: integer; APoint: TPointF);
    function GetPointBounds(AMatrix: TAffineMatrix): TRectF;
    procedure MouseMove({%H-}Shift: TShiftState; X, Y: single; var {%H-}ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
    procedure MouseDown(RightButton: boolean; {%H-}ClickCount: integer; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: single; var {%H-}ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
    procedure KeyDown({%H-}Shift: TShiftState; Key: TSpecialKey; var AHandled: boolean); override;
    procedure KeyUp(Shift: TShiftState; Key: TSpecialKey; var AHandled: boolean); override;
    procedure QuickDefine(constref APoint1,APoint2: TPointF); override;
    procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
    procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
    procedure ConfigureCustomEditor(AEditor: TBGRAOriginalEditor); override;
    procedure TransformFrame(const AMatrix: TAffineMatrix); override;
    class function Usermodes: TVectorShapeUsermodes; override;
    class function DefaultArrowSize: TPointF;
    property Points[AIndex:integer]: TPointF read GetPoint write SetPoint;
    property PointCount: integer read GetPointCount;
    property ValidatedPointCount: integer read GetValidatedPointCount;
    property Closed: boolean read GetClosed write SetClosed;
    property HoverPoint: integer read GetHoverPoint write SetHoverPoint;
    property HoverCenter: boolean read FHoverCenter write SetHoverCenter;
    property ArrowStartKind: TArrowKind read FArrowStartKind write SetArrowStartKind;
    property ArrowEndKind: TArrowKind read FArrowEndKind write SetArrowEndKind;
    property ArrowSize: TPointF read FArrowSize write SetArrowSize;
    property LineCap: TPenEndCap read GetLineCap write SetLineCap;
    property Center: TPointF read FCenterPoint write SetCenterPoint;
  end;

  { TPolylineShape }

  TPolylineShape = class(TCustomPolypointShape)
  public
    class function Fields: TVectorShapeFields; override;
    procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
    function AppendToSVG(AContent: TSVGContent; ADefs: TSVGDefine): TSVGElement; override;
    function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
    function PointInShape(APoint: TPointF): boolean; overload; override;
    function PointInShape(APoint: TPointF; ARadius: single): boolean; overload; override;
    function PointInBack(APoint: TPointF): boolean; overload; override;
    function PointInPen(APoint: TPointF): boolean; overload; override;
    function GetIsSlow(const {%H-}AMatrix: TAffineMatrix): boolean; override;
    class function StorageClassName: RawByteString; override;
  end;

  TCurveShape = class;

  { TCurveShapeDiff }

  TCurveShapeDiff = class(TVectorShapeDiff)
  protected
    FStartCosineAngle: single;
    FStartSplineStyle: TSplineStyle;
    FEndCosineAngle: single;
    FEndSplineStyle: TSplineStyle;
  public
    constructor Create(AStartShape: TVectorShape); override;
    procedure ComputeDiff(AEndShape: TVectorShape); override;
    procedure Apply(AStartShape: TVectorShape); override;
    procedure Unapply(AEndShape: TVectorShape); override;
    procedure Append(ADiff: TVectorShapeDiff); override;
    function IsIdentity: boolean; override;
  end;

  { TCurveShape }

  TCurveShape = class(TPolylineShape)
  private
    FCosineAngle: single;
    FSplineStyle: TSplineStyle;
    function GetCurveMode(AIndex: integer): TEasyBezierCurveMode;
    procedure SetCosineAngle(AValue: single);
    procedure SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode);
    procedure SetSplineStyle(AValue: TSplineStyle);
  protected
    function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; override;
    function GetPath(AMatrix: TAffineMatrix): TBGRAPath; override;
    function CanMovePoints: boolean; override;
    procedure DoClickPoint(APointIndex: integer; {%H-}AShift: TShiftState); override;
  public
    class function Usermodes: TVectorShapeUsermodes; override;
    constructor Create(AContainer: TVectorOriginal); override;
    constructor CreateFrom(AContainer: TVectorOriginal; AShape: TVectorShape);
    class function CanCreateFrom(AShape: TVectorShape): boolean;
    function AddPoint(const APoint: TPointF): integer; overload; override;
    function AddPoint(const APoint: TPointF; AMode: TEasyBezierCurveMode): integer; overload;
    procedure KeyPress(UTF8Key: string; var AHandled: boolean); override;
    procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
    procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
    class function StorageClassName: RawByteString; override;
    property SplineStyle: TSplineStyle read FSplineStyle write SetSplineStyle;
    property CurveMode[AIndex: integer]: TEasyBezierCurveMode read GetCurveMode write SetCurveMode;
    property CosineAngle: single read FCosineAngle write SetCosineAngle;
  end;

procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArrowKind; ASize: TPointF);

implementation

uses BGRAPen, BGRAFillInfo, math, LCVectorialFill,
  BGRAArrow, LCVectorRectShapes, LCResourceString;

function StrToArrowKind(AStr: string): TArrowKind;
var
  ak: TArrowKind;
begin
  for ak := low(TArrowKind) to high(TArrowKind) do
    if CompareText(AStr, ArrowKindToStr[ak])=0 then exit(ak);
  result := akNone;
end;

function StrToLineCap(AStr: string): TPenEndCap;
var
  ec: TPenEndCap;
begin
  for ec := low(TPenEndCap) to high(TPenEndCap) do
    if CompareText(AStr, LineCapToStr[ec])=0 then exit(ec);
  result := pecRound;
end;

procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArrowKind; ASize: TPointF);
var backOfs: single;
begin
  backOfs := 0;
  if (ASize.x = 0) or (ASize.y = 0) then AKind := akNone;
  if AKind in[akTriangleBack1,akHollowTriangleBack1] then backOfs := 0.25;
  if AKind in[akTriangleBack2,akHollowTriangleBack2] then backOfs := 0.50;
  case AKind of
  akTail: if AStart then AArrow.StartAsTail else AArrow.EndAsTail;
  akTip: if AStart then AArrow.StartAsTriangle else AArrow.EndAsTriangle;
  akNormal,akCut,akFlipped,akFlippedCut:
    if AStart then AArrow.StartAsClassic(AKind in[akFlipped,akFlippedCut], AKind in[akCut,akFlippedCut])
    else AArrow.EndAsClassic(AKind in[akFlipped,akFlippedCut], AKind in[akCut,akFlippedCut]);
  akTriangle,akTriangleBack1,akTriangleBack2:
    if AStart then AArrow.StartAsTriangle(backOfs) else AArrow.EndAsTriangle(backOfs);
  akHollowTriangle,akHollowTriangleBack1,akHollowTriangleBack2:
    if AStart then AArrow.StartAsTriangle(backOfs,False,True) else AArrow.EndAsTriangle(backOfs,False,True);
  else if AStart then AArrow.StartAsNone else AArrow.EndAsNone;
  end;
  if (AKind = akTip) and not ((ASize.x = 0) or (ASize.y = 0)) then
    ASize := ASize*(0.5/ASize.y);
  if AStart then AArrow.StartSize := ASize else AArrow.EndSize := ASize;
end;

procedure IncludePointF(var ARectF: TRectF; APointF: TPointF);
begin
  if APointF.x < ARectF.Left then ARectF.Left := APointF.x;
  if APointF.x > ARectF.Right then ARectF.Right := APointF.x;
  if APointF.y < ARectF.Top then ARectF.Top := APointF.y;
  if APointF.y > ARectF.Bottom then ARectF.Bottom := APointF.y;
end;

function GetPointsBoundsF(const APoints: array of TPointF): TRectF;
var
  i: Integer;
  firstPoint: Boolean;
begin
  result:= EmptyRectF;
  firstPoint := true;
  for i:= 0 to high(APoints) do
    if not isEmptyPointF(APoints[i]) then
    begin
      if firstPoint then
      begin
        result.TopLeft := APoints[i];
        result.BottomRight := APoints[i];
        firstPoint := false;
      end else
        IncludePointF(result, APoints[i]);
    end;
end;

{ TCurveShapeDiff }

constructor TCurveShapeDiff.Create(AStartShape: TVectorShape);
begin
  with (AStartShape as TCurveShape) do
  begin
    FStartCosineAngle:= FCosineAngle;
    FStartSplineStyle:= FSplineStyle;
  end;
end;

procedure TCurveShapeDiff.ComputeDiff(AEndShape: TVectorShape);
begin
  with (AEndShape as TCurveShape) do
  begin
    FEndCosineAngle:= FCosineAngle;
    FEndSplineStyle:= FSplineStyle;
  end;
end;

procedure TCurveShapeDiff.Apply(AStartShape: TVectorShape);
begin
  with (AStartShape as TCurveShape) do
  begin
    BeginUpdate;
    FCosineAngle := FEndCosineAngle;
    FSplineStyle := FEndSplineStyle;
    EndUpdate;
  end;
end;

procedure TCurveShapeDiff.Unapply(AEndShape: TVectorShape);
begin
  with (AEndShape as TCurveShape) do
  begin
    BeginUpdate;
    FCosineAngle := FStartCosineAngle;
    FSplineStyle := FStartSplineStyle;
    EndUpdate;
  end;
end;

procedure TCurveShapeDiff.Append(ADiff: TVectorShapeDiff);
var
  next: TCurveShapeDiff;
begin
  next := ADiff as TCurveShapeDiff;
  FEndCosineAngle:= next.FEndCosineAngle;
  FEndSplineStyle:= next.FEndSplineStyle;
end;

function TCurveShapeDiff.IsIdentity: boolean;
begin
  result := (FStartCosineAngle = FEndCosineAngle) and
    (FStartSplineStyle = FEndSplineStyle);
end;

{ TCustomPolypointShapeDiff }

constructor TCustomPolypointShapeDiff.Create(AStartShape: TVectorShape);
var
  i: Integer;
begin
  with (AStartShape as TCustomPolypointShape) do
  begin
    setlength(FStartPoints, length(FPoints));
    for i := 0 to high(FPoints) do FStartPoints[i] := FPoints[i];
    FStartClosed:= FClosed;
    FStartArrowStartKind := FArrowStartKind;
    FStartArrowEndKind:= FArrowEndKind;
    FStartArrowSize:= FArrowSize;
    FStartLineCap:= Stroker.LineCap;
  end;
end;

procedure TCustomPolypointShapeDiff.ComputeDiff(AEndShape: TVectorShape);
var
  i: Integer;
begin
  with (AEndShape as TCustomPolypointShape) do
  begin
    setlength(FEndPoints, length(FPoints));
    for i := 0 to high(FPoints) do FEndPoints[i] := FPoints[i];
    FEndClosed:= FClosed;
    FEndArrowStartKind := FArrowStartKind;
    FEndArrowEndKind:= FArrowEndKind;
    FEndArrowSize:= FArrowSize;
    FEndLineCap:= Stroker.LineCap;
  end;
end;

procedure TCustomPolypointShapeDiff.Apply(AStartShape: TVectorShape);
var
  i: Integer;
begin
  with (AStartShape as TCustomPolypointShape) do
  begin
    BeginUpdate;
    setlength(FPoints, length(FEndPoints));
    for i := 0 to high(FPoints) do FPoints[i] := FEndPoints[i];
    FClosed := FEndClosed;
    FArrowStartKind := FEndArrowStartKind;
    FArrowEndKind := FEndArrowEndKind;
    FArrowSize := FEndArrowSize;
    Stroker.LineCap:= FEndLineCap;
    EndUpdate;
  end;
end;

procedure TCustomPolypointShapeDiff.Unapply(AEndShape: TVectorShape);
var
  i: Integer;
begin
  with (AEndShape as TCustomPolypointShape) do
  begin
    BeginUpdate;
    setlength(FPoints, length(FStartPoints));
    for i := 0 to high(FPoints) do FPoints[i] := FStartPoints[i];
    FClosed := FStartClosed;
    FArrowStartKind := FStartArrowStartKind;
    FArrowEndKind := FStartArrowEndKind;
    FArrowSize := FStartArrowSize;
    Stroker.LineCap:= FStartLineCap;
    EndUpdate;
  end;
end;

procedure TCustomPolypointShapeDiff.Append(ADiff: TVectorShapeDiff);
var
  next: TCustomPolypointShapeDiff;
  i: Integer;
begin
  next := ADiff as TCustomPolypointShapeDiff;
  setlength(FEndPoints, length(next.FEndPoints));
  for i := 0 to high(FEndPoints) do FEndPoints[i] := next.FEndPoints[i];
  FEndClosed := next.FEndClosed;
  FEndArrowStartKind := next.FEndArrowStartKind;
  FEndArrowEndKind := next.FEndArrowEndKind;
  FEndArrowSize := next.FEndArrowSize;
  FEndLineCap:= next.FEndLineCap;
end;

function TCustomPolypointShapeDiff.IsIdentity: boolean;
var
  i: Integer;
begin
  result := (length(FStartPoints) = length(FEndPoints)) and
    (FStartClosed = FEndClosed) and
    (FStartArrowStartKind = FEndArrowStartKind) and
    (FStartArrowEndKind = FEndArrowEndKind) and
    (FStartArrowSize = FEndArrowSize) and
    (FStartLineCap = FEndLineCap);
  if result then
  begin
    for i := 0 to high(FStartPoints) do
      if (FStartPoints[i].coord<>FEndPoints[i].coord) or
         (FStartPoints[i].data<>FEndPoints[i].data) then
      begin
        result := false;
        break;
      end;
  end;
end;

{ TCustomPolypointShape }

function TCustomPolypointShape.GetClosed: boolean;
begin
  result := FClosed;
end;

function TCustomPolypointShape.GetPoint(AIndex: integer): TPointF;
begin
  if (AIndex < 0) or (AIndex >= length(FPoints)) then
    raise ERangeError.Create(rsIndexOutOfBounds);
  result := FPoints[AIndex].coord;
end;

function TCustomPolypointShape.GetLineCap: TPenEndCap;
begin
  result := Stroker.LineCap;
end;

function TCustomPolypointShape.GetHoverPoint: integer;
begin
  if (FHoverPoint >= 0) and (FHoverPoint < PointCount) and
     not Points[FHoverPoint].IsEmpty then
       result := FHoverPoint else result := -1;
end;

function TCustomPolypointShape.GetPointCount: integer;
begin
  result:= length(FPoints);
end;

function TCustomPolypointShape.GetValidatedPointCount: integer;
begin
  if (PointCount > 1) and FAddingPoint then
    result := PointCount - 1
  else
    result := PointCount;
end;

procedure TCustomPolypointShape.SetArrowEndKind(AValue: TArrowKind);
begin
  if FArrowEndKind=AValue then Exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  FArrowEndKind:=AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.SetArrowSize(AValue: TPointF);
begin
  if FArrowSize=AValue then Exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  FArrowSize:=AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.SetArrowStartKind(AValue: TArrowKind);
begin
  if FArrowStartKind=AValue then Exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  FArrowStartKind:=AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.SetCenterPoint(AValue: TPointF);
var
  i: Integer;
  delta: TPointF;
begin
  if FCenterPoint=AValue then Exit;

  BeginUpdate(TCustomPolypointShapeDiff);
  delta := AValue - FCenterPoint;
  for i := 0 to PointCount-1 do
    Points[i] := Points[i]+delta;
  if vsfBackFill in Fields then
    BackFill.Transform(AffineMatrixTranslation(delta.x, delta.y));
  if vsfPenFill in Fields then
    PenFill.Transform(AffineMatrixTranslation(delta.x, delta.y));
  FCenterPoint:=AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.SetHoverCenter(AValue: boolean);
begin
  if FHoverCenter=AValue then Exit;
  BeginEditingUpdate;
  if AValue then FHoverPoint := -1;
  FHoverCenter:=AValue;
  EndEditingUpdate;
end;

procedure TCustomPolypointShape.SetHoverPoint(AValue: integer);
begin
  if (AValue < 0) or (AValue >= PointCount) or
     Points[AValue].IsEmpty then AValue := -1;
  if AValue <> FHoverPoint then
  begin
    BeginEditingUpdate;
    FHoverPoint := AValue;
    if AValue <> -1 then FHoverCenter:= false;
    EndEditingUpdate;
  end;
end;

procedure TCustomPolypointShape.SetLineCap(AValue: TPenEndCap);
begin
  if Stroker.LineCap=AValue then Exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  Stroker.LineCap:=AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.SetClosed(AValue: boolean);
begin
  if AValue = FClosed then exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  FClosed := AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.SetPoint(AIndex: integer; AValue: TPointF);
begin
  if (AIndex < 0) or (AIndex > length(FPoints)) then
    raise ERangeError.Create(rsIndexOutOfBounds);
  BeginUpdate(TCustomPolypointShapeDiff);
  if AIndex = length(FPoints) then
  begin
    setlength(FPoints, length(FPoints)+1);
    FPoints[AIndex].coord := AValue;
    FPoints[AIndex].editorIndex := -1;
    FPoints[AIndex].data := 0;
  end
  else
    FPoints[AIndex].coord := AValue;
  EndUpdate;
end;

procedure TCustomPolypointShape.OnMovePoint(ASender: TObject; APrevCoord,
  ANewCoord: TPointF; AShift: TShiftState);
begin
  if FCurPoint = -1 then exit;
  Points[FCurPoint] := ANewCoord;
end;

procedure TCustomPolypointShape.OnMoveCenterPoint(ASender: TObject; APrevCoord,
  ANewCoord: TPointF; AShift: TShiftState);
begin
  Center := ANewCoord;
end;

procedure TCustomPolypointShape.OnStartMove(ASender: TObject; APointIndex: integer;
  AShift: TShiftState);
var
  i: Integer;
begin
  FCurPoint:= -1;
  for i:= 0 to PointCount-1 do
    if FPoints[i].editorIndex = APointIndex then
    begin
      FCurPoint:= i;
      break;
    end;
end;

function TCustomPolypointShape.GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF;
var
  i: Integer;
  m: TAffineMatrix;
begin
  setlength(result, PointCount);
  m:= MatrixForPixelCentered(AMatrix);
  for i := 0 to PointCount-1 do
    result[i] := m*Points[i];
end;

function TCustomPolypointShape.GetPath(const APoints: array of TPointF): TBGRAPath;
var p: TPointF;
  subPoly: boolean;
begin
  result := TBGRAPath.Create;
  subPoly := true;
  for p in APoints do
  begin
    if isEmptyPointF(p) then
    begin
      if not result.IsEmpty and Closed then result.closePath;
      subPoly := true;
    end else
    begin
      if subPoly then
      begin
        result.moveTo(p);
        subPoly := false;
      end
      else
        result.lineTo(p);
    end;
  end;
  if not result.IsEmpty and Closed then result.closePath;
end;

function TCustomPolypointShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
var
  pts: array of TPointF;
begin
  pts := GetCurve(AMatrix);
  result := GetPath(pts);
end;

class function TCustomPolypointShape.Usermodes: TVectorShapeUsermodes;
begin
  Result:= inherited Usermodes + [vsuCreate];
end;

class function TCustomPolypointShape.DefaultArrowSize: TPointF;
begin
  result := PointF(2,2);
end;

procedure TCustomPolypointShape.SetUsermode(AValue: TVectorShapeUsermode);
var
  add: Boolean;
begin
  add := AValue = vsuCreate;
  if add and (PointCount = 0) then exit;
  if FAddingPoint and not add then
  begin
    if (PointCount>1) and PointsEqual(Points[PointCount-1],Points[PointCount-2]) then
      RemovePoint(PointCount-1);
    FAddingPoint:= add;
  end else
  if not FAddingPoint and add then
  begin
    if not isEmptyPointF(FMousePos) then
      AddPoint(FMousePos)
    else
      AddPoint(Points[PointCount-1]);
    FAddingPoint:= add;
  end;
  inherited SetUsermode(AValue);
end;

function TCustomPolypointShape.PointsEqual(const APoint1, APoint2: TPointF
  ): boolean;
begin
  if isEmptyPointF(APoint1) then
    exit(isEmptyPointF(APoint2))
  else
  if isEmptyPointF(APoint2) then exit(false)
  else
    exit((APoint1.x = APoint2.x) and (APoint1.y = APoint2.y));
end;

procedure TCustomPolypointShape.OnHoverPoint(ASender: TObject;
  APointIndex: integer);
var
  i, newHoverPoint: Integer;
begin
  if APointIndex = FCenterPointEditorIndex then
  begin
    HoverCenter := true;
    exit;
  end;
  newHoverPoint:= -1;
  if APointIndex <> -1 then
  begin
    for i:= 0 to PointCount-1 do
      if FPoints[i].editorIndex = APointIndex then
      begin
        newHoverPoint:= i;
        break;
      end;
  end;
  HoverPoint := newHoverPoint;
  HoverCenter:= false;
end;

procedure TCustomPolypointShape.OnClickPoint(ASender: TObject;
  APointIndex: integer; AShift: TShiftState);
var
  i: Integer;
begin
  if APointIndex <> -1 then
  begin
    for i:= 0 to PointCount-1 do
      if FPoints[i].editorIndex = APointIndex then
      begin
        DoClickPoint(i, AShift);
        break;
      end;
  end;
end;

procedure TCustomPolypointShape.DoClickPoint(APointIndex: integer;
  AShift: TShiftState);
var
  nb: Integer;
begin
  if FAddingPoint and ((APointIndex = GetLoopStartIndex) or
     ((APointIndex = PointCount-2) and (ssRight in AShift))) then
  begin
    nb := GetLoopPointCount;
    if nb > 2 then
    begin
      BeginUpdate;
      RemovePoint(PointCount-1);
      if APointIndex < PointCount-2 then Closed := true;
      EndUpdate;
      UserMode := vsuEdit;
    end else
    begin
      if GetLoopStartIndex = 0 then
        Remove
      else
      begin
        BeginUpdate;
        while nb > 0 do
        begin
          RemovePoint(PointCount-1);
          dec(nb);
        end;
        RemovePoint(PointCount-1); //remove separator
      end;
    end;
  end;
end;

function TCustomPolypointShape.CanMovePoints: boolean;
begin
  result := true;
end;

procedure TCustomPolypointShape.InsertPointAuto(AShift: TShiftState);
var
  i,j, loopStart: Integer;
  bestSegmentIndex,bestPointIndex: integer;
  bestSegmentDist,bestPointDist, segmentLen, segmentPos: single;
  u, n, bestProjection: TPointF;
  segmentDist: single;
  isLooping: Boolean;
begin
  if isEmptyPointF(FMousePos) then exit;

  for i := 0 to PointCount-1 do
    if (Points[i] = FMousePos) and not (FAddingPoint and (i = PointCount-1)) then exit;

  bestSegmentIndex := -1;
  bestSegmentDist := MaxSingle;
  bestProjection := EmptyPointF;
  loopStart := 0;
  for i := 0 to PointCount-1 do
  if FAddingPoint and (i >= PointCount-2) then break else
  begin
    if IsEmptyPointF(Points[i]) then
    begin
      loopStart := i+1;
      continue;
    end;
    isLooping := (i = PointCount-1) or IsEmptyPointF(Points[i+1]);
    if isLooping and not Closed then break;
    if isLooping then
      j := loopStart
      else j := i+1;
    u := Points[j] - Points[i];
    segmentLen := VectLen(u);
    if segmentLen > 0 then
    begin
      u *= 1/segmentLen;
      segmentPos := (FMousePos-Points[i])*u;
      if (segmentPos > 0) and (segmentPos< segmentLen) then
      begin
        n := PointF(u.y,-u.x);
        segmentDist := abs((FMousePos-Points[i])*n);
        if segmentDist <= bestSegmentDist then
        begin
          bestSegmentDist := segmentDist;
          bestSegmentIndex := i;
          bestProjection := Points[i]+segmentPos*u;
        end;
      end;
    end;
  end;


  bestPointIndex := -1;
  bestPointDist := MaxSingle;
  if not FAddingPoint then
    for i := 0 to PointCount-1 do
      if ((i = 0) or isEmptyPointF(Points[i-1])) and
         ((i = PointCount-1) or isEmptyPointF(Points[i+1])) then
      begin
        segmentDist := VectLen(FMousePos-Points[i]);
        if segmentDist < bestPointDist then
        begin
          bestPointDist := segmentDist;
          bestPointIndex := i;
        end;
      end;

  if (bestPointIndex <> -1) and ((bestSegmentIndex = -1) or (bestPointDist < bestSegmentDist)) then
  begin
    InsertPoint(bestPointIndex+1, FMousePos);
    HoverPoint := bestPointIndex+1;
  end else
  if bestSegmentIndex <> -1 then
  begin
    if ssShift in AShift then
      InsertPoint(bestSegmentIndex+1, bestProjection)
    else
      InsertPoint(bestSegmentIndex+1, FMousePos);
    HoverPoint:= bestSegmentIndex+1;
  end;
end;

function TCustomPolypointShape.ComputeStroke(APoints: ArrayOfTPointF;
  AClosed: boolean; AStrokeMatrix: TAffineMatrix): ArrayOfTPointF;
begin
  if Stroker.Arrow = nil then
  begin
    Stroker.Arrow := TBGRAArrow.Create;
    Stroker.ArrowOwned:= true;
  end;
  Stroker.Arrow.LineCap:= LineCap;
  ApplyArrowStyle(Stroker.Arrow, true, ArrowStartKind, ArrowSize);
  ApplyArrowStyle(Stroker.Arrow, false, ArrowEndKind, ArrowSize);
  Result:=inherited ComputeStroke(APoints, AClosed, AStrokeMatrix);
  Stroker.Arrow.StartAsNone;
  Stroker.Arrow.EndAsNone;
end;

function TCustomPolypointShape.GetLoopStartIndex: integer;
var
  i: Integer;
begin
  for i := PointCount-1 downto 0 do
    if isEmptyPointF(Points[i]) then exit(i+1);
  exit(0);
end;

function TCustomPolypointShape.GetLoopPointCount: integer;
begin
  result := PointCount-GetLoopStartIndex;
end;

function TCustomPolypointShape.GetIsFollowingMouse: boolean;
begin
  Result:= Usermode = vsuCreate;
end;

constructor TCustomPolypointShape.Create(AContainer: TVectorOriginal);
begin
  inherited Create(AContainer);
  FMousePos := EmptyPointF;
  FClosed:= false;
  FHoverPoint:= -1;
  FCenterPoint := EmptyPointF;
end;

procedure TCustomPolypointShape.Clear;
begin
  RemovePointRange(0, PointCount);
end;

function TCustomPolypointShape.AddPoint(const APoint: TPointF): integer;
begin
  result := PointCount;
  Points[result] := APoint;
end;

function TCustomPolypointShape.RemovePoint(AIndex: integer): boolean;
begin
  if (AIndex < 0) or (AIndex >= PointCount) then exit(false);
  RemovePointRange(AIndex,AIndex+1);
  result := true;
end;

procedure TCustomPolypointShape.RemovePointRange(AFromIndex, AToIndexPlus1: integer);
var
  i, delCount: Integer;
begin
  if AFromIndex < 0 then AFromIndex:= 0;
  if AToIndexPlus1 > PointCount then AToIndexPlus1:= PointCount;
  if AFromIndex >= AToIndexPlus1 then exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  delCount := AToIndexPlus1-AFromIndex;
  for i := AFromIndex to PointCount-DelCount-1 do
    FPoints[i] := FPoints[i+delCount];
  setlength(FPoints, PointCount-delCount);
  if (HoverPoint >= AFromIndex) and (HoverPoint < AToIndexPlus1) then HoverPoint := -1
  else if (HoverPoint <> -1) and (HoverPoint >= AToIndexPlus1) then HoverPoint := HoverPoint - delCount;
  EndUpdate;
end;

procedure TCustomPolypointShape.InsertPoint(AIndex: integer; APoint: TPointF);
var
  i: Integer;
begin
  if (AIndex < 0) or (AIndex > PointCount) then raise exception.Create(rsIndexOutOfBounds);
  BeginUpdate(TCustomPolypointShapeDiff);
  setlength(FPoints, PointCount+1);
  for i := PointCount-1 downto AIndex+1 do
    FPoints[i] := FPoints[i-1];
  FPoints[AIndex].coord := APoint;
  FPoints[AIndex].editorIndex:= -1;
  FPoints[AIndex].data := 0;
  if (HoverPoint <> -1) and (HoverPoint >= AIndex) then HoverPoint := HoverPoint + 1;
  EndUpdate;
end;

function TCustomPolypointShape.GetPointBounds(AMatrix: TAffineMatrix): TRectF;
begin
  result := GetPointsBoundsF(GetCurve(AMatrix));
end;

procedure TCustomPolypointShape.MouseMove(Shift: TShiftState; X, Y: single; var
  ACursor: TOriginalEditorCursor; var AHandled: boolean);
begin
  FMousePos := PointF(X,Y);
  if FAddingPoint then
  begin
    BeginUpdate;
    if (PointCount = 1) and (FMousePos <> Points[PointCount-1]) then
      Points[PointCount] := FMousePos
    else
      Points[PointCount-1] := FMousePos;
    FillFit;
    EndUpdate;
    AHandled:= true;
  end;
end;

procedure TCustomPolypointShape.MouseDown(RightButton: boolean;
  ClickCount: integer; Shift: TShiftState; X, Y: single; var ACursor: TOriginalEditorCursor; var
  AHandled: boolean);
begin
  FMousePos := PointF(X,Y);
  if FAddingPoint then
  begin
    if not RightButton then
    begin
      if (PointCount>1) and not PointsEqual(FMousePos,Points[PointCount-2]) then
      begin
        BeginUpdate;
        Points[PointCount-1] := FMousePos;
        AddPoint(FMousePos);
        EndUpdate;
      end;
    end else
      Usermode := vsuEdit;
    AHandled:= true;
  end else
  begin
    if (ssShift in Shift) and (Usermode = vsuEdit) then
    begin
      BeginUpdate;
      AddPoint(EmptyPointF);
      AddPoint(FMousePos);
      FillFit;
      EndUpdate;
      UserMode := vsuCreate;
      AHandled:= true;
    end;
  end;
end;

procedure TCustomPolypointShape.KeyDown(Shift: TShiftState; Key: TSpecialKey;
  var AHandled: boolean);
var
  nb, idx: Integer;
  dx, dy, d: TPointF;
begin
  if (Key = skDelete) and (FAddingPoint or (HoverPoint <> -1)) then
  begin
    if (HoverPoint <> -1) then
    begin
      BeginUpdate(TCustomPolypointShapeDiff);
      idx := HoverPoint;
      RemovePoint(idx);
      if ((idx = PointCount) or IsEmptyPointF(Points[idx])) and
         ((idx = 0) or IsEmptyPointF(Points[idx-1])) then
      begin
        if idx < PointCount then
          RemovePoint(idx)
        else if idx > 0 then
          RemovePoint(idx-1);
      end;
      EndUpdate;
      if PointCount = 0 then self.Remove;
    end;
    AHandled:= true;
  end else
  if (Key = skBackspace) and FAddingPoint then
  begin
    nb := GetLoopPointCount;
    if nb > 2 then
      RemovePoint(PointCount-2)
    else
    begin
      if GetLoopStartIndex = 0 then self.Remove
      else
      begin
        RemovePointRange(PointCount-3, PointCount);
        Usermode:= vsuEdit;
      end;
    end;
    AHandled:= true;
  end else
  if (Key = skInsert) then
  begin
    InsertPointAuto(Shift);
    AHandled := true;
  end else
  if (Key in [skLeft,skUp,skRight,skDown]) and ((HoverPoint <> -1) or HoverCenter) then
  begin
    if ssCtrl in Shift then
    begin
      dx := PointF(FGridMatrix[1,1], FGridMatrix[2,1]);
      dy := PointF(FGridMatrix[1,2], FGridMatrix[2,2]);
    end else
    begin
      dx := PointF(FViewMatrixInverse[1,1], FViewMatrixInverse[2,1]);
      dy := PointF(FViewMatrixInverse[1,2], FViewMatrixInverse[2,2]);
    end;
    case Key of
    skLeft: d := -dx;
    skRight: d := dx;
    skUp: d := -dy;
    skDown: d := dy;
    else d := PointF(0,0);
    end;
    if HoverCenter then
      Center := Center + d
    else
      Points[HoverPoint] := Points[HoverPoint] + d;
    AHandled := true;
  end else
  if Key = skAlt then
  begin
    BeginUpdate;
    FAltPressed := true;
    EndUpdate;
    AHandled := true;
  end
  else
    inherited KeyDown(Shift, Key, AHandled);
end;

procedure TCustomPolypointShape.KeyUp(Shift: TShiftState; Key: TSpecialKey;
  var AHandled: boolean);
begin
  if Key = skAlt then
  begin
    BeginUpdate;
    FAltPressed := false;
    EndUpdate;
    AHandled := true;
  end
  else inherited KeyUp(Shift, Key, AHandled);
end;

procedure TCustomPolypointShape.QuickDefine(constref APoint1, APoint2: TPointF);
begin
  BeginUpdate(TCustomPolypointShapeDiff);
  FPoints := nil;
  AddPoint(APoint1);
  if not PointsEqual(APoint1,APoint2) then
    AddPoint(APoint2);
  EndUpdate;
  FMousePos := APoint2;
end;

procedure TCustomPolypointShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
var
  x,y: Array of Single;
  i: Integer;
begin
  BeginUpdate;
  inherited LoadFromStorage(AStorage);
  Clear;
  x := AStorage.FloatArray['x'];
  y := AStorage.FloatArray['y'];
  setlength(FPoints, max(length(x),length(y)));
  for i := 0 to high(FPoints) do
  begin
    FPoints[i].coord := PointF(x[i],y[i]);
    FPoints[i].editorIndex := -1;
    FPoints[i].data := 0;
  end;
  FClosed:= AStorage.Bool['closed'];
  if AStorage.HasAttribute('arrow-size') then
    FArrowSize := AStorage.PointF['arrow-size']
  else FArrowSize := DefaultArrowSize;
  FArrowStartKind:= StrToArrowKind(AStorage.RawString['arrow-start-kind']);
  FArrowEndKind:= StrToArrowKind(AStorage.RawString['arrow-end-kind']);
  Stroker.LineCap := StrToLineCap(AStorage.RawString['line-cap']);
  EndUpdate;
end;

procedure TCustomPolypointShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
var
  x,y: Array of Single;
  i: Integer;
begin
  inherited SaveToStorage(AStorage);
  setlength({%H-}x, PointCount);
  setlength({%H-}y, PointCount);
  for i:= 0 to PointCount-1 do
  begin
    x[i] := Points[i].x;
    y[i] := Points[i].y;
  end;
  AStorage.FloatArray['x'] := x;
  AStorage.FloatArray['y'] := y;
  AStorage.Bool['closed'] := Closed;
  if ArrowStartKind=akNone then AStorage.RemoveAttribute('arrow-start-kind')
  else AStorage.RawString['arrow-start-kind'] := ArrowKindToStr[ArrowStartKind];
  if ArrowEndKind=akNone then AStorage.RemoveAttribute('arrow-end-kind')
  else AStorage.RawString['arrow-end-kind'] := ArrowKindToStr[ArrowEndKind];
  if (ArrowStartKind=akNone) and (ArrowEndKind=akNone) then AStorage.RemoveAttribute('arrow-size')
  else AStorage.PointF['arrow-size'] := FArrowSize;
  AStorage.RawString['line-cap'] := LineCapToStr[Stroker.LineCap];
end;

procedure TCustomPolypointShape.ConfigureCustomEditor(AEditor: TBGRAOriginalEditor);
var
  i, nbTotal: Integer;
begin
  FViewMatrix := AEditor.Matrix;
  if not IsAffineMatrixInversible(FViewMatrix) then exit;
  FViewMatrixInverse := AffineMatrixInverse(FViewMatrix);
  FGridMatrix := AEditor.GridMatrix;

  AEditor.AddStartMoveHandler(@OnStartMove);
  AEditor.AddClickPointHandler(@OnClickPoint);
  AEditor.AddHoverPointHandler(@OnHoverPoint);

  FCenterPoint := PointF(0,0);
  nbTotal := 0;
  for i:= 0 to PointCount-1 do
    if isEmptyPointF(Points[i]) then
      FPoints[i].editorIndex := -1
    else if (FAddingPoint and (i = PointCount-1) and (GetLoopPointCount > 1)) then
    begin
      FPoints[i].editorIndex := -1;
      FCenterPoint += Points[i];
      inc(nbTotal);
    end
    else
    begin
      if CanMovePoints then
        FPoints[i].editorIndex := AEditor.AddPoint(Points[i], @OnMovePoint, false)
      else
        FPoints[i].editorIndex := AEditor.AddFixedPoint(Points[i], false);
      FCenterPoint += Points[i];
      if i = HoverPoint then
        AEditor.PointHighlighted[FPoints[i].editorIndex] := true;
      inc(nbTotal);
    end;

  if nbTotal > 0 then
    FCenterPoint *= 1/nbTotal
    else FCenterPoint := EmptyPointF;

  if ((FAddingPoint and (nbTotal > 2)) or (not FAddingPoint and (nbTotal > 1)))
     and not FAltPressed then
  begin
    FCenterPointEditorIndex := AEditor.AddPoint(FCenterPoint, @OnMoveCenterPoint, true);
    AEditor.PointHighlighted[FCenterPointEditorIndex] := HoverCenter;
  end else
    FCenterPointEditorIndex := -1;
end;

procedure TCustomPolypointShape.TransformFrame(const AMatrix: TAffineMatrix);
var
  i: Integer;
  m: TAffineMatrix;
begin
  BeginUpdate(TCustomPolypointShapeDiff);
  m := MatrixForPixelCentered(AMatrix);
  for i := 0 to PointCount-1 do
    FPoints[i].coord := m*FPoints[i].coord;
  EndUpdate;
end;

{ TPolylineShape }

class function TPolylineShape.Fields: TVectorShapeFields;
begin
  Result:= [vsfPenFill, vsfPenWidth, vsfPenStyle, vsfJoinStyle, vsfBackFill];
end;

procedure TPolylineShape.Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix;
  ADraft: boolean);
var
  pts: array of TPointF;
  backScan, penScan: TBGRACustomScanner;
begin
  if not GetBackVisible and not GetPenVisible then exit;
  pts := GetCurve(AMatrix);
  if GetBackVisible then
  begin
    if BackFill.FillType = vftSolid then backScan := nil
    else backScan := BackFill.CreateScanner(AMatrix, ADraft);

    if ADraft then
    begin
      if Assigned(backScan) then
        ADest.FillPoly(pts, backScan, dmDrawWithTransparency) else
        ADest.FillPoly(pts, BackFill.SolidColor, dmDrawWithTransparency);
    end
    else
    begin
      if Assigned(backScan) then
        ADest.FillPolyAntialias(pts, backScan) else
        ADest.FillPolyAntialias(pts, BackFill.SolidColor);
    end;

    backScan.Free;
  end;
  if GetPenVisible then
  begin
    if PenFill.FillType = vftSolid then penScan := nil
    else penScan := PenFill.CreateScanner(AMatrix, ADraft);

    pts := ComputeStroke(pts, Closed, AMatrix);
    if ADraft and (PenWidth > 4) then
    begin
      if Assigned(penScan) then
        ADest.FillPoly(pts, penScan, dmDrawWithTransparency) else
        ADest.FillPoly(pts, PenColor, dmDrawWithTransparency);
    end
    else
    begin
      if Assigned(penScan) then
        ADest.FillPolyAntialias(pts, penScan) else
        ADest.FillPolyAntialias(pts, PenColor);
    end;

    penScan.Free;
  end;
end;

function TPolylineShape.AppendToSVG(AContent: TSVGContent; ADefs: TSVGDefine): TSVGElement;
var
  p: TBGRAPath;
begin
  p := GetPath(AffineMatrixIdentity);
  result := AContent.AppendPath(p.SvgString);
  p.Free;
  ApplyStrokeStyleToSVG(result, ADefs);
  if PenVisible then
    result.strokeLineCapLCL := LineCap;
  ApplyFillStyleToSVG(result, ADefs);
end;

function TPolylineShape.GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions): TRectF;
var
  pts: ArrayOfTPointF;
  xMargin, yMargin: single;
  fillBounds, penBounds: TRectF;
begin
  if not (GetBackVisible or (rboAssumeBackFill in AOptions)) and not GetPenVisible(rboAssumePenFill in AOptions) then
    result:= EmptyRectF
  else
  begin
    pts := GetCurve(AMatrix);
    if GetPenVisible(rboAssumePenFill in AOptions) then
    begin
      if (JoinStyle = pjsRound) and (ArrowStartKind = akNone) and (ArrowEndKind = akNone) then
      begin
        xMargin := (abs(AMatrix[1,1])+abs(AMatrix[1,2]))*PenWidth*0.5;
        yMargin := (abs(AMatrix[2,1])+abs(AMatrix[2,2]))*PenWidth*0.5;
        if LineCap = pecSquare then
        begin
          xMargin *= sqrt(2);
          yMargin *= sqrt(2);
        end;
        result := GetPointsBoundsF(pts);
        result.Left -= xMargin;
        result.Top -= yMargin;
        result.Right += xMargin;
        result.Bottom += yMargin;
      end else
      begin
        if GetBackVisible or (rboAssumeBackFill in AOptions) then fillBounds := GetPointsBoundsF(pts)
        else fillBounds := EmptyRectF;
        pts := ComputeStroke(pts, Closed, AMatrix);
        penBounds := GetPointsBoundsF(pts);
        result := fillBounds.Union(penBounds, true);
      end;
    end
    else
      result := GetPointsBoundsF(pts);
  end;
  result.Offset(0.5,0.5);
end;

function TPolylineShape.PointInShape(APoint: TPointF): boolean;
var
  pts: ArrayOfTPointF;
begin
  if not GetBackVisible and not GetPenVisible then exit(false);
  pts := GetCurve(AffineMatrixIdentity);
  if GetBackVisible and IsPointInPolygon(pts, APoint, true) then exit(true);
  if GetPenVisible then
  begin
    pts := ComputeStroke(pts, Closed, AffineMatrixIdentity);
    if IsPointInPolygon(pts, APoint, true) then exit(true);
  end;
  result := false;
end;

function TPolylineShape.PointInShape(APoint: TPointF; ARadius: single): boolean;
var
  pts: ArrayOfTPointF;
begin
  if not GetBackVisible and not GetPenVisible then exit(false);
  pts := GetCurve(AffineMatrixIdentity);
  pts := ComputeStrokeEnvelope(pts, Closed, ARadius*2);
  result := IsPointInPolygon(pts, APoint, true);
end;

function TPolylineShape.PointInBack(APoint: TPointF): boolean;
var
  pts: ArrayOfTPointF;
  scan: TBGRACustomScanner;
begin
  if GetBackVisible then
  begin
    pts := GetCurve(AffineMatrixIdentity);
    result := IsPointInPolygon(pts, APoint, true);
    if result and (BackFill.FillType = vftTexture) then
    begin
      scan := BackFill.CreateScanner(AffineMatrixIdentity, false);
      if scan.ScanAt(APoint.X,APoint.Y).alpha = 0 then result := false;
      scan.Free;
    end;
  end else
    result := false;
end;

function TPolylineShape.PointInPen(APoint: TPointF): boolean;
var
  pts: ArrayOfTPointF;
begin
  if GetBackVisible then
  begin
    pts := GetCurve(AffineMatrixIdentity);
    pts := ComputeStroke(pts, Closed, AffineMatrixIdentity);
    result := IsPointInPolygon(pts, APoint, true);
  end else
    result := false;
end;

function TPolylineShape.GetIsSlow(const AMatrix: TAffineMatrix): boolean;
var pts: ArrayOfTPointF;
  i: Integer;
  ptsBounds: TRectF;
  backSurface: Single;
  penLength, zoomFactor, penSurface, totalSurface: single;
begin
  if not GetPenVisible and not GetBackVisible or (PointCount = 0) then exit(false);

  setlength({%H-}pts, PointCount);
  for i := 0 to high(pts) do
    pts[i] := AMatrix * Points[i];

  if GetPenVisible then
  begin
    penLength := 0;
    zoomFactor := max(VectLen(AMatrix[1,1],AMatrix[2,1]), VectLen(AMatrix[1,2],AMatrix[2,2]));
    for i := 0 to high(pts) do
      if (i > 0) then
      begin
        if pts[i-1].IsEmpty then
        begin
          if not pts[i].IsEmpty and (LineCap <> pecFlat) then penLength += penWidth/2*zoomFactor;
        end else
        if pts[i].IsEmpty then
        begin
          if not pts[i-1].IsEmpty and (LineCap <> pecFlat) then penLength += penWidth/2*zoomFactor;
        end else
          penLength += VectLen(pts[i]-pts[i-1]);
      end;
    penSurface := penLength*PenWidth*zoomFactor;
  end else penSurface := 0;

  if GetBackVisible then
  begin
    ptsBounds := GetPointsBoundsF(pts);
    backSurface := ptsBounds.Width*ptsBounds.Height;
  end else
    backSurface := 0;

  if GetPenVisible and GetBackVisible then totalSurface := backSurface+penSurface/2
  else totalSurface := backSurface+penSurface;

  Result:= (PointCount > 40) or
           ((penSurface > 320*240) and PenFill.IsSlow(AMatrix)) or
           ((backSurface > 320*240) and BackFill.IsSlow(AMatrix)) or
           (totalSurface > 640*480);
end;

class function TPolylineShape.StorageClassName: RawByteString;
begin
  result := 'polyline';
end;

{ TCurveShape }

procedure TCurveShape.SetSplineStyle(AValue: TSplineStyle);
begin
  if FSplineStyle=AValue then Exit;
  BeginUpdate(TCurveShapeDiff);
  FSplineStyle:=AValue;
  EndUpdate;
end;

function TCurveShape.GetCurveMode(AIndex: integer): TEasyBezierCurveMode;
begin
  if (AIndex < 0) or (AIndex >= PointCount) then exit(cmCurve);
  result := TEasyBezierCurveMode(FPoints[AIndex].data);
end;

procedure TCurveShape.SetCosineAngle(AValue: single);
begin
  if FCosineAngle=AValue then Exit;
  BeginUpdate(TCurveShapeDiff);
  FCosineAngle:=AValue;
  EndUpdate;
end;

procedure TCurveShape.SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode);
begin
  if (AIndex < 0) or (AIndex >= PointCount) then exit;
  if CurveMode[AIndex] = AValue then exit;
  BeginUpdate(TCustomPolypointShapeDiff);
  FPoints[AIndex].data := ord(AValue);
  EndUpdate
end;

function TCurveShape.GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF;
var
  pts: array of TPointF;
  cm: array of TEasyBezierCurveMode;
  i: Integer;
  eb: TEasyBezierCurve;
begin
  pts := inherited GetCurve(AMatrix);
  if FSplineStyle = ssEasyBezier then
  begin
    setlength({%H-}cm, PointCount);
    for i := 0 to PointCount-1 do
      cm[i] := CurveMode[i];
    eb := EasyBezierCurve(pts, Closed, cm, CosineAngle);
    result := eb.ToPoints;
  end else
  begin
    if Closed then result := ComputeClosedSpline(pts, FSplineStyle)
    else result := ComputeOpenedSpline(pts, FSplineStyle);
  end;
end;

function TCurveShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
var
  pts: array of TPointF;
  cm: array of TEasyBezierCurveMode;
  i: Integer;
  eb: TEasyBezierCurve;
begin
  pts := inherited GetCurve(AMatrix);
  if FSplineStyle = ssEasyBezier then
  begin
    setlength({%H-}cm, PointCount);
    for i := 0 to PointCount-1 do
      cm[i] := CurveMode[i];
    eb := EasyBezierCurve(pts, Closed, cm, CosineAngle);
    result := TBGRAPath.Create;
    eb.CopyToPath(result);
  end else
  begin
    if Closed then pts := ComputeClosedSpline(pts, FSplineStyle)
    else pts := ComputeOpenedSpline(pts, FSplineStyle);
    result := GetPath(pts);
  end;
end;

function TCurveShape.CanMovePoints: boolean;
begin
  Result:= Usermode in [vsuCreate,vsuEdit];
end;

procedure TCurveShape.DoClickPoint(APointIndex: integer; AShift: TShiftState);
begin
  case Usermode of
  vsuCurveSetAuto: CurveMode[APointIndex] := cmAuto;
  vsuCurveSetCurve: CurveMode[APointIndex] := cmCurve;
  vsuCurveSetAngle: CurveMode[APointIndex] := cmAngle;
  else
    inherited DoClickPoint(APointIndex, AShift);
  end;
end;

class function TCurveShape.Usermodes: TVectorShapeUsermodes;
begin
  Result:=inherited Usermodes + [vsuCurveSetAuto, vsuCurveSetCurve, vsuCurveSetAngle];
end;

constructor TCurveShape.Create(AContainer: TVectorOriginal);
begin
  inherited Create(AContainer);
  FSplineStyle:= ssEasyBezier;
end;

constructor TCurveShape.CreateFrom(AContainer: TVectorOriginal;
  AShape: TVectorShape);
var
  r: TCustomRectShape;
  u, v: TPointF;
  p: TCustomPolypointShape;
  i: Integer;
  f: TVectorShapeFields;
  sq2m1: single;
begin
  Create(AContainer);
  if AShape is TEllipseShape then
  begin
    r := AShape as TCustomRectShape;
    u := r.XAxis-r.Origin;
    v := r.YAxis-r.Origin;
    sq2m1 := sqrt(2)-1;
    AddPoint(r.Origin-v+u*sq2m1);
    AddPoint(r.Origin-v*sq2m1+u);
    AddPoint(r.Origin+v*sq2m1+u);
    AddPoint(r.Origin+v+u*sq2m1);
    AddPoint(r.Origin+v-u*sq2m1);
    AddPoint(r.Origin+v*sq2m1-u);
    AddPoint(r.Origin-v*sq2m1-u);
    AddPoint(r.Origin-v-u*sq2m1);
    Closed := true;
  end else
  if AShape is TRectShape then
  begin
    r := AShape as TCustomRectShape;
    u := r.XAxis-r.Origin;
    v := r.YAxis-r.Origin;
    AddPoint(r.Origin-v-u, cmAngle);
    AddPoint(r.Origin-v+u, cmAngle);
    AddPoint(r.Origin+v+u, cmAngle);
    AddPoint(r.Origin+v-u, cmAngle);
    Closed := true;
  end else
  if (AShape is TPolylineShape) and not
     (AShape is TCurveShape) then
  begin
    p := AShape as TCustomPolypointShape;
    for i := 0 to p.PointCount-1 do
      AddPoint(p.Points[i], cmAngle);
    Closed := p.Closed;
  end else
    raise exception.Create(errShapeNotHandled);

  f := AShape.Fields;
  if vsfPenFill in f then PenFill.Assign(AShape.PenFill);
  if vsfPenWidth in f then PenWidth := AShape.PenWidth;
  if vsfPenStyle in f then PenStyle := AShape.PenStyle;
  if vsfJoinStyle in f then JoinStyle := AShape.JoinStyle;
  if vsfBackFill in f then BackFill.Assign(AShape.BackFill);
end;

class function TCurveShape.CanCreateFrom(AShape: TVectorShape): boolean;
begin
  result := (AShape is TEllipseShape) or
    (AShape is TRectShape) or
    ((AShape is TPolylineShape) and not
     (AShape is TCurveShape));
end;

function TCurveShape.AddPoint(const APoint: TPointF): integer;
begin
  if (PointCount > 1) and (APoint = Points[PointCount-1]) then
  begin
    BeginUpdate;
    CurveMode[PointCount-1] := CurveMode[PointCount-2];
    Result:=inherited AddPoint(APoint);
    EndUpdate;
  end
  else Result:=inherited AddPoint(APoint);
end;

function TCurveShape.AddPoint(const APoint: TPointF; AMode: TEasyBezierCurveMode): integer;
begin
  result := inherited AddPoint(APoint);
  CurveMode[result] := AMode;
end;

procedure TCurveShape.KeyPress(UTF8Key: string; var AHandled: boolean);
var
  targetPoint: Integer;
begin
  if HoverPoint<>-1 then
    targetPoint := HoverPoint
  else if FAddingPoint and (PointCount > 1) then
    targetPoint := PointCount-2
  else
    targetPoint := -1;
  if (targetPoint >= 0) and (targetPoint < PointCount) then
  begin
    if (UTF8Key = 'A') or (UTF8Key = 'a') then
    begin
      CurveMode[targetPoint] := cmAuto;
      AHandled := true;
    end else
    if (UTF8Key = 'S') or (UTF8Key = 's') then
    begin
      CurveMode[targetPoint] := cmCurve;
      AHandled:= true;
    end else
    if (UTF8Key = 'X') or (UTF8Key = 'x') then
    begin
      CurveMode[targetPoint] := cmAngle;
      AHandled:= true;
    end;
  end;
  if not AHandled then
    inherited KeyPress(UTF8Key, AHandled);
end;

procedure TCurveShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
var
  i: Integer;
  cm: array of Single;
begin
  BeginUpdate;
  inherited LoadFromStorage(AStorage);
  case AStorage.RawString['spline-style'] of
  'inside': SplineStyle := ssInside;
  'inside+ends': SplineStyle := ssInsideWithEnds;
  'crossing': SplineStyle := ssCrossing;
  'crossing+ends': SplineStyle := ssCrossingWithEnds;
  'outside': SplineStyle := ssOutside;
  'round-outside': SplineStyle := ssRoundOutside;
  'vertex-to-side': SplineStyle := ssVertexToSide;
  else
    {'easy-bezier'} SplineStyle := ssEasyBezier;
  end;
  if SplineStyle = ssEasyBezier then
  begin
    cm := AStorage.FloatArray['curve-mode'];
    for i := 0 to min(high(cm),PointCount-1) do
      case round(cm[i]) of
      1: CurveMode[i] := cmCurve;
      2: CurveMode[i] := cmAngle;
      end;
    if length(cm) < PointCount then
      for i:= length(cm) to PointCount-1 do
        CurveMode[i] := cmCurve;
  end;
  CosineAngle := AStorage.FloatDef['cosine-angle', EasyBezierDefaultMinimumDotProduct];
  EndUpdate;
end;

procedure TCurveShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
var s: string;
  cm: array of single;
  i: Integer;
begin
  inherited SaveToStorage(AStorage);
  case SplineStyle of
    ssInside: s := 'inside';
    ssInsideWithEnds: s := 'inside+ends';
    ssCrossing: s := 'crossing';
    ssCrossingWithEnds: s := 'crossing+ends';
    ssOutside: s := 'outside';
    ssRoundOutside: s := 'round-outside';
    ssVertexToSide: s := 'vertex-to-side';
    ssEasyBezier: s := 'easy-bezier';
  else s := '';
  end;
  AStorage.RawString['spline-style'] := s;
  if SplineStyle = ssEasyBezier then
  begin
    setlength({%H-}cm, PointCount);
    for i := 0 to PointCount-1 do
      cm[i] := ord(CurveMode[i]);
    AStorage.FloatArray['curve-mode'] := cm;
  end;
  AStorage.Float['cosine-angle'] := CosineAngle;
end;

class function TCurveShape.StorageClassName: RawByteString;
begin
  Result:= 'curve';
end;

initialization

  RegisterVectorShape(TPolylineShape);
  RegisterVectorShape(TCurveShape);

end.