unit VisCtl2D;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Graphics, Controls,
  Forms, Direct2D, D2D1, ExtCtrls, Generics.Defaults, Generics.Collections,
  Dialogs, Menus, ASObjects, ASNum, SVG, DoublePoint, VisCtl;

type
  TSVGExportOptions = record
    Width: Single;
    Height: Single;
    LengthUnit: string;
    Stretch: Boolean;
    Title: string;
    Description: string;
    Language: string;
    procedure SetDimensionsFromText(const AWidth, AHeight: string);
    procedure Validate;
    function SpecificSize: Boolean;
    function SpecificWidth: Boolean;
    function SpecificHeight: Boolean;
    function AutomaticSize: Boolean;
    function AutomaticWidth: Boolean;
    function AutomaticHeight: Boolean;
    function AutomaticAspectRatio: Boolean;
    function SpecificAspectRatio: Boolean;
  end;

const
  DefaultSVGExportOptions: TSVGExportOptions = ();

type
  EVisCtlException = class(Exception);

  {$SCOPEDENUMS ON}
  TCartesianAxis = (X, Y);
  {$SCOPEDENUMS OFF}

  TAnchorPoint =
    (
      apTopLeft,      apTop,        apTopRight,
      apLeft,         apCenter,     apRight,
      apBottomLeft,   apBottom,     apBottomRight
    );

  TLinearAlignment = (laNegative, laMiddle, laPositive);

  TAnchorPointHelper = record helper for TAnchorPoint
  strict private const
    PointNames: array[TAnchorPoint] of string =
      (
        'top-left',     'top',        'top-right',
        'left',         'center',     'right',
        'bottom-left',  'bottom',     'bottom-right'
      );
  public
    function H: TLinearAlignment; inline;
    function V: TLinearAlignment; inline;
    function ToString: string;
    class function FromString(const S: string): TAnchorPoint; static;
  end;

procedure AlignRect(var ARect: TRect; AAnchorPoint: TAnchorPoint); overload;
procedure AlignRect(var ARect: TRectD; AAnchorPoint: TAnchorPoint); overload;

type
  TSVGBuilder_VisCtl2D = class;
  TDrawable = class;

  TDrawableOptionsFrm = class(TForm)
  protected
    FInitialized: Boolean;
    FDrawable: TDrawable;
    FOnChange: TNotifyEvent;
    procedure Initialize; virtual;
    procedure UpdateDrawable; virtual;
    property Initialized: Boolean read FInitialized;
    procedure DrawableDestroyed(Sender: TObject);
  public
    constructor Create(AOwner: TComponent; ADrawable: TDrawable); reintroduce; virtual;
    procedure Reassign(ADrawable: TDrawable);
    property Drawable: TDrawable read FDrawable;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TDrawableOptionsFrmClass = class of TDrawableOptionsFrm;

  TLineEndMarker = (lemNone, lemLineArrow, lemSolidArrow, lemSemiArrow, lemDisk,
    lemSquare, lemSquare2, lemLine, lemBroken);

  TLineEndMarkerHelper = record helper for TLineEndMarker
  strict private
    const MarkerNames: array[TLineEndMarker] of string =
      ('none', 'line arrow', 'triangle', 'semiarrow', 'disk', 'square',
      'square 2', 'bar', 'broken');
  public
    function IsFilled: Boolean;
    function ToString: string;
    class function FromString(const S: string): TLineEndMarker; static;
  end;

  TVisCtl2D = class;
  TView2D = class;

  TDrawable = class(TVisObj)
  strict private
    class var FInstances: TDictionary<TGUID, TDrawable>;
    class var FModalLevel: Integer;
    class constructor ClassCreate;
    class destructor ClassDestroy;
    class procedure InstanceListChanged(Sender: TObject; const Item: TGUID;
      Action: TCollectionNotification);
    procedure SetVisible(const Value: Boolean);
  public
    class function TryGetDrawableByGUID(const AGUID: TGUID;
      out ADrawable: TDrawable): Boolean; static;
    class property ModalLevel: Integer read FModalLevel;
    class property Instances: TDictionary<TGUID, TDrawable> read FInstances;
    class function GetRealm: string; override; final;
    class function AllowAutoNormalization: Boolean; virtual;
  protected
    FVisible: Boolean;
    FCtl: TVisCtl2D;
    FView: TView2D;
    FVertFlag: Boolean;
    FBehindAxes: Boolean;
    FOnChange: TNotifyEvent;
    FOptionsFrmClass: TDrawableOptionsFrmClass;
  private
    procedure Draw; virtual;
    procedure DrawToPrefix(ASVG: TSVGBuilder_VisCtl2D); virtual;
    procedure DrawToSuffix(ASVG: TSVGBuilder_VisCtl2D); virtual;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); virtual;
    procedure DrawTo(ASVG: TSVGBuilder_VisCtl2D);
    procedure FreeDeviceResources; virtual;
  protected
    function Canvas: TDirect2DCanvas; inline;
    function CanvasRect: TRect; inline;
    procedure DrawLine(const A, B: TPointD);
    procedure DrawLineSp(const A, B: TPointD); inline;
    procedure DrawRect(const ARect: TRectD); overload; inline;
    procedure DrawRect(const ARect: TRectD; const ARotAngle: Double); overload;
    procedure DrawRectSp(const ARect: TRectD); overload; inline;
    procedure DrawRectSp(const ARect: TRectD; const ARotAngle: Double); overload; inline;
    procedure DrawEllipse(const R: TRectD); inline;
    procedure DrawEllipseSp(const R: TRectD); inline;
    procedure DrawDisk(const P: TPointD; const R: Double); inline;
    procedure DrawDiskSp(const P: TPointD; const R: Double); inline;
    procedure DrawDiskSpPx(const P: TPointD; const R: Double); inline;
    procedure DrawLineEndMarker(AMarker: TLineEndMarker; AFilled: Boolean;
      const P: TPointD; const ASizeX, ASizeY, AAngle: Double);
    procedure DrawLineEndMarkerSp(AMarker: TLineEndMarker; AFilled: Boolean;
      const P: TPointD; const ASizeX, ASizeY, AAngle: Double); inline;
    procedure TextOut(const X, Y: Double; const Text: string);
    procedure Changed; overload; inline;
    procedure Changed(Sender: TObject); overload; inline;
    function Direction(const Angle: Double): TPointD;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); virtual;
    destructor Destroy; override;
    function amin(ALim: Boolean = False): Double; virtual;
    function amax(ALim: Boolean = False): Double; virtual;
    function aspan(ALim: Boolean = False): Double; inline;
    function AxP(const A, B: Double): TPointD; virtual;
    function AxPScr(const A, B: Double): TPointD; inline;
    function AxisScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; virtual;
    function FirstScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; virtual;
    function LastScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; virtual;
    function AxisSvgPoint(AViewBox: TViewBox; const A: Double;
      const D: Double = 0.0; const D2: Double = 0.0): TPointD; virtual;
    function SizePrimary(const S: TSize): Integer; virtual;
    function SizeSecondary(const S: TSize): Integer; virtual;
    procedure ShowOptionsForm(AParent: TCustomForm = nil); override;
    procedure Configure(ASettings: TAlgosimStructure); virtual;
    function CreateReference: TAlgosimReference; virtual;
    property BehindAxes: Boolean read FBehindAxes;
    property Control: TVisCtl2D read FCtl;
    property Visible: Boolean read FVisible write SetVisible;
    property OptionsFormClass: TDrawableOptionsFrmClass read FOptionsFrmClass write FOptionsFrmClass;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TView2D = class(TDrawable)
  strict private
  const
    TranslationAnimationDurationSec = 0.5;
    TranslationAnimationFramerateFPS = 30;
    TranslationAnimationFrameCount =
      Round(TranslationAnimationDurationSec * TranslationAnimationFramerateFPS);
    TAFC = TranslationAnimationFrameCount;
  const
    _xmin = 0;
    _xmax = 1;
    _ymin = 2;
    _ymax = 3;
  type
    TBoundsArray = array[0..3] of Double;
  const
    DefBoundsArray: TBoundsArray = (-10, 10, -10, 10);
  var
    FBounds: TBoundsArray;
    FTranslationTimer: TTimer;
    FZoomTranslationTimer: TTimer;
    FTranslationAnimationBegin: TDateTime;
    FTranslationAnimationEnd: TDateTime;
    FTranslationAnimation: array[0..TAFC - 1] of TPointD;
    FZoomTranslationAnimation: array[0..TAFC - 1] of TRectD;
    FFirstView: TBoundsArray;
    FFirstViewSet: Boolean;
    function GetBound(const Index: Integer): Double; inline;
    procedure SetBound(const Index: Integer; const Value: Double);
    function GetCenter: TPointD;
    procedure SetCenter(const Value: TPointD);
    procedure TranslationTimerTimer(Sender: TObject);
    procedure ZoomTranslationTimerTimer(Sender: TObject);
  public
    constructor Create(ACtl: TVisCtl2D); reintroduce;
    procedure Assign(Source: TPersistent); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    destructor Destroy; override;
    function XSpan: Double; inline;
    function YSpan: Double; inline;
    function Area: Double; inline;
    function TopLeft: TPointD; inline;
    function BottomRight: TPointD; inline;
    function ScaleX(const X: Double): Double; inline;
    function ScaleY(const Y: Double): Double; inline;
    function Scale(const P: TPointD): TPointD; inline;
    procedure AnimateTo(const ACenterPoint: TPointD; AMoveCursor: Boolean = False); overload;
    procedure AnimateTo(const ACorner1, ACorner2: TPointD); overload;
    procedure Normalize(AFlexibleAxis: TCartesianAxis);
    function IsNormalized: Boolean;
    function AspectDeviation: Double;
    function RestoreInitial: Boolean;
  published
    property XMin: Double index _xmin read GetBound write SetBound nodefault;
    property XMax: Double index _xmax read GetBound write SetBound nodefault;
    property YMin: Double index _ymin read GetBound write SetBound nodefault;
    property YMax: Double index _ymax read GetBound write SetBound nodefault;
    property CenterPoint: TPointD read GetCenter write SetCenter;
    function MaxDistFromZero: Double;
    function MinDistFromZero: Double;
    procedure SetX(const AFrom, ATo: Double);
    procedure SetY(const AFrom, ATo: Double);
    procedure &Set(const AXFrom, AXTo, AYFrom, AYTo: Double; APreferAxes: Boolean = False);
  end;

  TTickSide = (tsBoth, tsNegative, tsPositive);

  TAxis = class(TDrawable)
  strict private
    FAutomatic: Boolean;
    FAxisPosition: Double;
    FVisible: Boolean;
    FColor: TColor;
    FWidth: Integer; // invariant
    FMin, FMax: Double;
    FTickDistance: Double;
    FTickLength: Integer; // invariant
    FTickWidth: Integer; // invariant
    FTickColor: TColor;
    FTickSide: TTickSide;
    FTicksVisible: Boolean;
    FNumberDistance: Double;
    FNumberUnitValue: Double;
    FNumberUnitSymbol: string;
    FNumberFormat: string;
    FNumberFont: TFont; // invariant size
    FNumbersVisible: Boolean;
    FText: string;
    FTextOffset: Integer;
    FTextFont: TFont; // invariant size
    procedure SetAutomatic(const Value: Boolean);
    procedure SetPosition(const Value: Double);
    procedure SetColor(const Value: TColor);
    procedure SetMin(const Value: Double);
    procedure SetMax(const Value: Double);
    procedure SetNumberDistance(const Value: Double);
    procedure SetNumberFont(const Value: TFont);
    procedure SetNumberFormat(const Value: string);
    procedure SetNumberUnitSymbol(const Value: string);
    procedure SetNumberUnitValue(const Value: Double);
    procedure SetNumbersVisible(const Value: Boolean);
    procedure SetTickDistance(const Value: Double);
    procedure SetTickLength(const Value: Integer);
    procedure SetTickWidth(const Value: Integer);
    procedure SetTickColor(const Value: TColor);
    procedure SetTickSide(const Value: TTickSide);
    procedure SetTicksVisible(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
    procedure SetVisible(const Value: Boolean);
    procedure SetText(const Value: string);
    procedure SetTextOffset(const Value: Integer);
    procedure SetTextFont(const Value: TFont);
  strict private const
    DefaultAutomatic = True;
    DefaultColor = clBlack;
    DefaultNumberDistance = 1.0;
    DefaultNumberFormat = '';
    DefaultNumberUnitSymbol = '';
    DefaultNumberUnitValue = 0.0;
    DefaultNumbersVisible = True;
    DefaultWidth = 2; // invariant
    DefaultTickDistance = 1.0;
    DefaultTickLength = 4; // invariant
    DefaultTickWidth = 2; // invariant
    DefaultTickColor = clBlack;
    DefaultTickSide = tsBoth;
    DefaultTicksVisible = True;
    DefaultVisible = True;
    DefaultTextOffset = 10;
  private
    procedure Draw; override;
    procedure DrawToPrefix(ASVG: TSVGBuilder_VisCtl2D); override;
    procedure DrawToSuffix(ASVG: TSVGBuilder_VisCtl2D); override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  strict protected
    FNumberWidth: Integer;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function Limited: Boolean; inline;
    function AxSpan: Double; inline;
  published
    property Automatic: Boolean read FAutomatic write SetAutomatic default DefaultAutomatic;
    property Color: TColor read FColor write SetColor default DefaultColor;
    property AxMin: Double read FMin write SetMin;
    property AxMax: Double read FMax write SetMax;
    property NumberDistance: Double read FNumberDistance write SetNumberDistance nodefault;
    property NumberFont: TFont read FNumberFont write SetNumberFont; // invariant size
    property NumberFormat: string read FNumberFormat write SetNumberFormat;
    property NumberUnitSymbol: string read FNumberUnitSymbol write SetNumberUnitSymbol;
    property NumberUnitValue: Double read FNumberUnitValue write SetNumberUnitValue;
    property NumbersVisible: Boolean read FNumbersVisible write SetNumbersVisible default DefaultNumbersVisible;
    property Position: Double read FAxisPosition write SetPosition;
    property Width: Integer read FWidth write SetWidth default DefaultWidth;
    property Text: string read FText write SetText;
    property TextOffset: Integer read FTextOffset write SetTextOffset default DefaultTextOffset;
    property TextFont: TFont read FTextFont write SetTextFont; // invariant size
    property TickDistance: Double read FTickDistance write SetTickDistance nodefault;
    property TickLength: Integer read FTickLength write SetTickLength default DefaultTickLength; // invariant
    property TickWidth: Integer read FTickWidth write SetTickWidth default DefaultTickWidth; // invariant
    property TickColor: TColor read FTickColor write SetTickColor default DefaultTickColor;
    property TickSide: TTickSide read FTickSide write SetTickSide default DefaultTickSide;
    property TicksVisible: Boolean read FTicksVisible write SetTicksVisible default DefaultTicksVisible;
    property Visible: Boolean read FVisible write SetVisible default DefaultVisible;
  end;

  THorizontalAxis = class(TAxis)
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    function amin(ALim: Boolean = False): Double; override;
    function amax(ALim: Boolean = False): Double; override;
    function AxisScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function FirstScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function LastScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function AxisSvgPoint(AViewBox: TViewBox; const A: Double;
      const D: Double = 0.0; const D2: Double = 0.0): TPointD; override;
    function SizePrimary(const S: TSize): Integer; override;
    function SizeSecondary(const S: TSize): Integer; override;
  end;

  TVerticalAxis = class(TAxis)
  strict private
    FRotateAxisText: Boolean;
    procedure SetRotateAxisText(const Value: Boolean);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function amin(ALim: Boolean = False): Double; override;
    function amax(ALim: Boolean = False): Double; override;
    function AxP(const A, B: Double): TPointD; override;
    function AxisScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function FirstScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function LastScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function AxisSvgPoint(AViewBox: TViewBox; const A: Double;
      const D: Double = 0.0; const D2: Double = 0.0): TPointD; override;
    function SizePrimary(const S: TSize): Integer; override;
    function SizeSecondary(const S: TSize): Integer; override;
  published
    property RotateAxisText: Boolean read FRotateAxisText write SetRotateAxisText;
  end;

  TAxes = class(TDrawable)
  strict private
    FX: THorizontalAxis;
    FY: TVerticalAxis;
    procedure SetX(const Value: THorizontalAxis);
    procedure SetY(const Value: TVerticalAxis);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function CreateReference: TAlgosimReference; override;
  published
    property X: THorizontalAxis read FX write SetX;
    property Y: TVerticalAxis read FY write SetY;
  end;

  TGridLineFamily = class(TDrawable)
  strict private
    FMin, FMax: Double;
    FBegin, FEnd: Double;
    FDistance: Double;
    FVisible: Boolean;
    FWidth: Integer;
    FColor: TColor;
    FPenStyle: TPenStyle;
    procedure SetMin(const Value: Double);
    procedure SetMax(const Value: Double);
    procedure SetBegin(const Value: Double);
    procedure SetEnd(const Value: Double);
    procedure SetDistance(const Value: Double);
    procedure SetColor(const Value: TColor);
    procedure SetPenStyle(const Value: TPenStyle);
    procedure SetWidth(const Value: Integer);
    procedure SetVisible(const Value: Boolean);
  strict private const
    DefaultVisible = False;
    DefaultWidth = 1;
    DefaultColor = clBlack;
    DefaultPenStyle = psSolid;
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function Limited: Boolean; inline;
    function LineLimited: Boolean; inline;
  published
    property Distance: Double read FDistance write SetDistance nodefault;
    property AxMin: Double read FMin write SetMin;
    property AxMax: Double read FMax write SetMax;
    property LineBegin: Double read FBegin write SetBegin;
    property LineEnd: Double read FEnd write SetEnd;
    property Visible: Boolean read FVisible write SetVisible default DefaultVisible;
    property Width: Integer read FWidth write SetWidth default DefaultWidth;
    property Color: TColor read FColor write SetColor default DefaultColor;
    property PenStyle: TPenStyle read FPenStyle write SetPenStyle default DefaultPenStyle;
  end;

  THorizontalGridLineFamily = class(TGridLineFamily)
  public
    function amin(ALim: Boolean = False): Double; override;
    function amax(ALim: Boolean = False): Double; override;
    function AxisScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function FirstScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function LastScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function SizePrimary(const S: TSize): Integer; override;
    function SizeSecondary(const S: TSize): Integer; override;
    function AxP(const A: Double; const B: Double): TPointD; override;
  end;

  TVerticalGridLineFamily = class(TGridLineFamily)
  public
    function amin(ALim: Boolean = False): Double; override;
    function amax(ALim: Boolean = False): Double; override;
    function AxisScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function FirstScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function LastScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function SizePrimary(const S: TSize): Integer; override;
    function SizeSecondary(const S: TSize): Integer; override;
  end;

  TRadialGridLineFamily = class(TGridLineFamily)
  public
    function amin(ALim: Boolean = False): Double; override;
    function amax(ALim: Boolean = False): Double; override;
    function FirstScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function LastScrPoint(const A: Double; D: Integer = 0; D2: Integer = 0): TPointD; override;
    function AxP(const A: Double; const B: Double): TPointD; override;
  end;

  TCircularGridLineFamily = class(TGridLineFamily)
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    function amin(ALim: Boolean = False): Double; override;
    function amax(ALim: Boolean = False): Double; override;
    function AxP(const A: Double; const B: Double): TPointD; override;
  end;

  TGridLineFamilies = class(TDrawable)
  strict private
    FHorizontalPrimary, FHorizontalSecondary: THorizontalGridLineFamily;
    FVerticalPrimary, FVerticalSecondary: TVerticalGridLineFamily;
    FRadialPrimary, FRadialSecondary: TRadialGridLineFamily;
    FCircular: TCircularGridLineFamily;
    procedure SetHorizontalPrimary(const Value: THorizontalGridLineFamily);
    procedure SetHorizontalSecondary(const Value: THorizontalGridLineFamily);
    procedure SetVerticalPrimary(const Value: TVerticalGridLineFamily);
    procedure SetVerticalSecondary(const Value: TVerticalGridLineFamily);
    procedure SetRadialPrimary(const Value: TRadialGridLineFamily);
    procedure SetRadialSecondary(const Value: TRadialGridLineFamily);
    procedure SetCircular(const Value: TCircularGridLineFamily);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function CreateReference: TAlgosimReference; override;
  published
    property HorizontalPrimary: THorizontalGridLineFamily read FHorizontalPrimary write SetHorizontalPrimary;
    property HorizontalSecondary: THorizontalGridLineFamily read FHorizontalSecondary write SetHorizontalSecondary;
    property VerticalPrimary: TVerticalGridLineFamily read FVerticalPrimary write SetVerticalPrimary;
    property VerticalSecondary: TVerticalGridLineFamily read FVerticalSecondary write SetVerticalSecondary;
    property RadialPrimary: TRadialGridLineFamily read FRadialPrimary write SetRadialPrimary;
    property RadialSecondary: TRadialGridLineFamily read FRadialSecondary write SetRadialSecondary;
    property Circular: TCircularGridLineFamily read FCircular write SetCircular;
  end;

  TDiagram = class(TDrawable)
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    function CreateReference: TAlgosimReference; override;
  end;

  TDrawableList = class(TDrawable)
  strict private
    FList: TObjectList<TDrawable>;
    function GetItem(Index: Integer): TDrawable;
    procedure SetItem(Index: Integer; const Value: TDrawable);
    function GetItemCount: Integer;
    procedure ObjsNotify(Sender: TObject; const Item: TDrawable;
      Action: TCollectionNotification);
  private
    procedure Draw; overload; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); overload; override;
    procedure Draw(BottomLayer: Boolean); reintroduce; overload;
    procedure DrawTo(ASVG: TSVGBuilder_VisCtl2D; BottomLayer: Boolean); overload;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure MoveUp(ADrawable: TDrawable);
    procedure MoveDown(ADrawable: TDrawable);
    property List: TObjectList<TDrawable> read FList;
    property Items[Index: Integer]: TDrawable read GetItem write SetItem; default;
    property ItemCount: Integer read GetItemCount;
  end;

  TCoordEvent = procedure(Sender: TObject; const X, Y: Double) of object;

  TVisCtl2D = class(TVisCtl)
  public const
    CMD_SETTINGS = 10;
    CMD_CENTERATORIGIN = 11;
    CMD_NORMALIZEADJUSTHOR = 12;
    CMD_NORMALIZEADJUSTVERT = 13;
    CMD_TOGGLEAUTONORMALIZE = 14;
    CMD_SAVESVG = 15;
    CMD_COPYBMP = 16;
    CMD_SAVEBMP = 17;
    CMD_RESTOREVIEW = 18;
    CMD_COMMONVIEW = 300;
    CMDV_UNITBOX = 301;
    CMDV_UNITBOXN = 302;
    CMDV_TRIG = 303;
    CMDV_TENBOX = 304;
    CMDV_TENBOXN = 305;

    CMD_NORMALIZE = CMD_NORMALIZEADJUSTHOR;
  strict private
    FCanvas: TDirect2DCanvas;
    FDiagram: TDiagram;
    FView: TView2D;
    xmin, xmax, ymin, ymax: Double;
    FAxes: TAxes;
    FGridLines: TGridLineFamilies;
    FObjs: TDrawableList;
    FInvFS: TFormatSettings;
    FPrevMousePos: TPoint;
    FZoomCorner,
    FZoomCorner2: TPoint;
    FZoomRect: Boolean;
    FZoomRectBrush: ID2D1SolidColorBrush;
    FMenu: TPopupMenu;
    FAutoNormalize: Boolean;
    FMnuAutoNormalize: TMenuItem;
    FCustomMenuItems: TList<TMenuItem>;
    FOnBeforeContextPopup: TNotifyEvent;
    FBackgroundPaintLevel: Integer;
    FInvalidationTimer: TTimer;
    FPixelDeltaX,
    FPixelDeltaY: Double;
    FSlowPaint: Boolean;
    FCachedPainting: TBitmap;
    FLastPaintLayoutMode: Boolean;
    FLastNonLayoutPaintClientRect: TRect;
    FCachedPaintingFreer: TTimer;
    FOnHoverCoordChange: TCoordEvent;
    FOnViewChange: TNotifyEvent;
    procedure ViewChanged(Sender: TObject);
    procedure ObjChanged(Sender: TObject);
    function xspan: Double; inline;
    function yspan: Double; inline;
    procedure SetView(const Value: TView2D);
    procedure SetAxes(const Value: TAxes);
    procedure SetGridLines(const Value: TGridLineFamilies);
    procedure DrawZoomRect;
    procedure CreateDeviceResources;
    procedure FreeDeviceResources;
    function GetObjectCount: Integer;
    function GetObject(Index: Integer): TDrawable;
    procedure CreateLineEndMarkers;
    procedure CreateContextMenu;
    procedure MenuCommand(Sender: TObject);
    procedure SetAutoNormalize(const Value: Boolean);
    procedure MenuPopup(Sender: TObject);
    procedure CustomizeMenu(AMenu: TMenu);
    procedure InvalidationTimerTimer(Sender: TObject);
    procedure CachedPaintingFreerTimer(Sender: TObject);
  private
  type
    TFilledBool = type Boolean;
    TStartBool = type Boolean;
  var
    FLineEndMarkers: array[TLineEndMarker] of ID2D1PathGeometry;
    FSVGMarkers: array[TLineEndMarker] of array[TFilledBool] of array[TStartBool] of TTag;
    class function P(const X, Y: Double): TPointD; static; inline;
    class function Q(const X, Y: Double): TPointD; static; inline;
    function UnboundXMin(const APoint: TD2D1Point2F): TD2D1Point2F;
    function UnboundXMax(const APoint: TD2D1Point2F): TD2D1Point2F;
    function UnboundYMin(const APoint: TD2D1Point2F): TD2D1Point2F;
    function UnboundYMax(const APoint: TD2D1Point2F): TD2D1Point2F;
    function UnboundIdentity(const APoint: TD2D1Point2F): TD2D1Point2F; inline;
    function Scr(const X, Y: Double): TPointD; inline;
  protected
    procedure CreateWnd; override;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMDisplayChange(var Message: TWMDisplayChange); message WM_DISPLAYCHANGE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Paint; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
      override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
      override;
    procedure DblClick; override;
    function SpaceToViewbox(const AViewBox: TViewBox;
      const ASpaceCoords: TPointD; DX: Integer = 0; DY: Integer = 0): TPointD; overload;
    function SpaceToViewbox(const AViewBox: TViewBox;
      const ASpaceCoords: TRectD): TRectD; overload;
    function SpaceToViewboxX(const AViewBox: TViewBox;
      const ASpaceCoords: Double): Double;
    function SpaceToViewboxY(const AViewBox: TViewBox;
      const ASpaceCoords: Double): Double;
    procedure KeyPress(var Key: Char); override;
    procedure DoHoverCoordChange(const X, Y: Double); virtual;
    procedure DoViewChange; virtual;
    procedure ChangeScale(M: Integer; D: Integer; isDpiChange: Boolean); override;
  strict private
    const SVGFDCCTL_Title = 101;
    const SVGFDCCTL_Descr = 102;
    const SVGFDCCTL_Width = 103;
    const SVGFDCCTL_Height = 104;
    const SVGFDCCTL_Stretch = 105;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LowPriorityInvalidate;
    procedure ExecCommand(ACommand: Integer);
    property Canvas: TDirect2DCanvas read FCanvas;
    function CanvasToSpace(const ACanvasCoords: TPointD): TPointD;
    function SpaceToCanvas(const ASpaceCoords: TPointD; DX: Integer = 0;
      DY: Integer = 0): TPointD; overload;
    function SpaceToCanvas(const ASpaceCoords: TPointD;
      const DX, DY: Double): TPointD; overload;
    function SpaceToCanvas(const ASpaceCoords: TRectD;
      AFlipped: Boolean = False): TRectD; overload;
    function SpaceToCanvas(const X, Y: Double; DX: Integer = 0; DY:
      Integer = 0): TPointD; overload;
    function TrySpaceToD2d1(const ASpaceCoords: TPointD;
      out AD2d1Point: TD2D1Point2F): Boolean;
    function CanvasRect: TRect;
    function PixelsToDips(const APoint: TPoint): TPointD; overload;
    function PixelsToDips(const ARect: TRect): TRectD; overload;
    function DipsToPixels(const APoint: TPointD): TPoint; overload;
    function DipsToPixels(const ARect: TRectD): TRect; overload;
    property ObjectMgr: TDrawableList read FObjs;
    procedure Translate(const DX, DY: Double);
    procedure ZoomX(const A: Double);
    procedure ZoomY(const A: Double);
    procedure Zoom(const Factor: Double);
    procedure ZoomIn;
    procedure ZoomOut;
    property InvFS: TFormatSettings read FInvFS;
    property Diagram: TDiagram read FDiagram;
    procedure AddObject(AObject: TDrawable);
    property ObjectCount: Integer read GetObjectCount;
    property Objects[Index: Integer]: TDrawable read GetObject;
    procedure RemoveObject(AObject: TDrawable);
    procedure ClearDiagram;

    /// <summary>Adds a custom menu item to the control's main context menu.
    ///  The control doesn't take ownership of the item, and the item must not
    ///  be freed by the caller while the control has a reference to it. The
    ///  caller is allowed to change other properties of the item, except its
    ///  parent. After the item has been added to the control, the control takes
    ///  control of its parent property. Hence, if the item previously belonged
    ///  to a menu, it might be removed from that menu.</summary>
    procedure AddMenuItem(AMenuItem: TMenuItem);
    procedure AddMenuItems(AMenu: TMenuItem);
    procedure RemoveMenuItem(AMenuItem: TMenuItem);

    procedure BeginBackgroundPaint;
    procedure EndBackgroundPaint;

    function AsSVG(const ASVGExportOptions: TSVGExportOptions): string;
    procedure SaveAsSVG(const AFileName: string;
      const ASVGExportOptions: TSVGExportOptions); overload;
    procedure SaveAsSVG; overload;
    procedure SaveAsSVGFileDialogExecute(Sender: TObject);
    procedure SaveAsSVGFileDialogOKClick(Sender: TObject; var CanClose: Boolean);
    function CreateBitmap: TBitmap;
    procedure CopyToClipboard;
    procedure SaveAsBitmap;

    property PixelDeltaX: Double read FPixelDeltaX;
    property PixelDeltaY: Double read FPixelDeltaY;

    property _ContextMenu: TPopupMenu read FMenu;
  published
    property Anchors;
    property Align;
    property AlignWithMargins;
    property AutoNormalize: Boolean read FAutoNormalize write SetAutoNormalize;
    property Axes: TAxes read FAxes write SetAxes;
    property Color;
    property Cursor;
    property Enabled;
    property Font;
    property GridLines: TGridLineFamilies read FGridLines write SetGridLines;
    property TabStop default True;
    property View: TView2D read FView write SetView;
    property Visible;
    property OnBeforeContextPopup: TNotifyEvent read FOnBeforeContextPopup write FOnBeforeContextPopup;
    property OnClick;
    property OnDblClick;
    property OnHoverCoordChange: TCoordEvent read FOnHoverCoordChange write FOnHoverCoordChange;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnViewChange: TNotifyEvent read FOnViewChange write FOnViewChange;
  end;

  TElementStylePart = (espColor, espOpacity, espBorderColor, espBorderWidth,
    espDisplacement);
  TElementStyleParts = set of TElementStylePart;

  TElementStyle = class(TDrawable)
  strict private
    FColor: TColor;
    FOpacity: Byte;
    FBorderColor: TColor;
    FBorderWidth: Integer;
    FDisplacement: Double;
    FElementStyleParts: TElementStyleParts;
    procedure SetBorderColor(const Value: TColor);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetColor(const Value: TColor);
    procedure SetOpacity(const Value: Byte);
    procedure SetDisplacement(const Value: Double);
    function GetOpacityFraction: Double;
    procedure SetOpacityFraction(const Value: Double);
  strict private const
    DefaultColor = $B48246;
    DefaultOpacity = 150;
    DefaultBorderColor = $B48246;
    DefaultBorderWidth = 1;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Assign(Source: TPersistent); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Color: TColor read FColor write SetColor default DefaultColor;
    property Opacity: Byte read FOpacity write SetOpacity default DefaultOpacity;
    property OpacityFraction: Double read GetOpacityFraction write SetOpacityFraction;
    property BorderColor: TColor read FBorderColor write SetBorderColor default DefaultBorderColor;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth default DefaultBorderWidth;
    property Displacement: Double read FDisplacement write SetDisplacement;
    property Parts: TElementStyleParts read FElementStyleParts write FElementStyleParts;
  end;

  TCategoryElement = class(TDrawable)
  strict private
    FLabel: string;
    FValue: Double;
    FStyle: TElementStyle;
    procedure SetLabel(const Value: string);
    procedure SetStyle(const Value: TElementStyle);
    procedure SetValue(const Value: Double);
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property &Label: string read FLabel write SetLabel;
    property Value: Double read FValue write SetValue;
    property Style: TElementStyle read FStyle write SetStyle;
  end;

  TCategoryElements = class(TObjectList<TCategoryElement>)
    function MaxValue: Double;
    function Sum: Double;
    function RelativeValues: TArray<Double>;
  end;

  TCategoryChart = class(TDrawable)
  strict protected
    FCategories: TCategoryElements;
    FShowLegend: Boolean;
    FLegendStyle: TElementStyle;
    FLegendFont: TFont; // invariant size
    FChartTypeName: string;
    FLabelFont: TFont; // invariant size
    FLabelVisible,
    FValueLabelVisible: Boolean;
    FValueFont: TFont; // invariant size
    FValueFormat: string;
    FValueLabelPosition: Double;
    FLabelPosition: Double;
    FDetailsOptionsFrmClass: TDrawableOptionsFrmClass;
    function GetLabelFont: TFont;
    procedure SetLabelFont(const Value: TFont);
    function GetValueFont: TFont;
    procedure SetValueFont(const Value: TFont);
    procedure SetValueLabelPosition(const Value: Double);
    procedure SetValueFormat(const Value: string);
    procedure CategoriesNotify(Sender: TObject; const Item: TCategoryElement;
      Action: TCollectionNotification);
    procedure SetCategories(const Value: TCategoryElements);
    procedure SetShowLegend(const Value: Boolean);
    procedure SetLegendStyle(const Value: TElementStyle);
    function GetLegendFont: TFont;
    procedure SetLegendFont(const Value: TFont);
    procedure SetLabelVisible(const Value: Boolean);
    procedure SetValueLabelVisible(const Value: Boolean);
    procedure SetLabelPosition(const Value: Double);
  private
    procedure Draw; override;
    procedure DrawToPrefix(ASVG: TSVGBuilder_VisCtl2D); override;
    procedure DrawToSuffix(ASVG: TSVGBuilder_VisCtl2D); override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    function AddCategory(const ALabel: string; const AValue: Double): TCategoryElement; virtual;
    procedure Clear;
    procedure Assign(Source: TPersistent); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function CreateReference: TAlgosimReference; override;
    property Categories: TCategoryElements read FCategories write SetCategories;
    property ShowLegend: Boolean read FShowLegend write SetShowLegend;
    property LegendStyle: TElementStyle read FLegendStyle write SetLegendStyle;
    property LegendFont: TFont read GetLegendFont write SetLegendFont; // invariant size
    property ChartTypeName: string read FChartTypeName;
    property LabelVisible: Boolean read FLabelVisible write SetLabelVisible;
    property LabelPosition: Double read FLabelPosition write SetLabelPosition;
    property LabelFont: TFont read GetLabelFont write SetLabelFont; // invariant size
    property ValueLabelVisible: Boolean read FValueLabelVisible write SetValueLabelVisible;
    property ValueLabelPosition: Double read FValueLabelPosition write SetValueLabelPosition;
    property ValueFont: TFont read GetValueFont write SetValueFont; // invariant size
    property ValueFormat: string read FValueFormat write SetValueFormat;
    property DetailsOptionsFormClass: TDrawableOptionsFrmClass read FDetailsOptionsFrmClass;
    class function AllowAutoNormalization: Boolean; override;
  end;

  TBarChart_Bar = TCategoryElement;
  TBarChart = class(TCategoryChart)
  strict private
    FBarOffset: Double;
    FBarWidth: Double;
    FBarSpacing: Double;
    procedure SetBarOffset(const Value: Double);
    procedure SetBarSpacing(const Value: Double);
    procedure SetBarWidth(const Value: Double);
    procedure DrawBar(ABar: TCategoryElement; AIndex: Integer; const AOffset: Double);
    procedure DrawBarTo(ASVG: TSVGBuilder_VisCtl2D; ABar: TCategoryElement; AIndex: Integer;
      const AOffset: Double);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function AddBar(const ALabel: string; const AValue: Double): TCategoryElement;
    property Bars: TCategoryElements read FCategories write SetCategories;
    property BarOffset: Double read FBarOffset write SetBarOffset;
    property BarWidth: Double read FBarWidth write SetBarWidth;
    property BarSpacing: Double read FBarSpacing write SetBarSpacing;
  end;

  THistogram = class(TDrawable)
  strict private
    FStyle: TElementStyle;
    FData: TArray<Double>;
    FBinWidth: Double;
    FBinValues: TArray<Int64>;
    FMinDataValue,
    FMaxDataValue,
    FDataSpan: Double;
    FStartAt: Double;
    FActualStartAt: Double;
    procedure SetStyle(const Value: TElementStyle);
    procedure SetData(const Value: TArray<Double>);
    procedure SetBinWidth(const Value: Double);
    procedure SetStartAt(const Value: Double);
    function GetDataLength: Integer; inline;
    function GetBinIndex(const Value: Double): Integer;
    function GetMaxBinValue: Int64;
    procedure RecomputeStartAt;
    procedure Recompute;
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Style: TElementStyle read FStyle write SetStyle;
    property Data: TArray<Double> read FData write SetData;
    property BinWidth: Double read FBinWidth write SetBinWidth;
    property StartAt: Double read FStartAt write SetStartAt;
    property MinDataValue: Double read FMinDataValue;
    property MaxDataValue: Double read FMaxDataValue;
    property DataValueSpan: Double read FDataSpan;
    property DataLength: Integer read GetDataLength;
    property MaxBinValue: Int64 read GetMaxBinValue;
    class function AllowAutoNormalization: Boolean; override;
  end;

  TXYPlot = class(TDrawable)
  strict protected
    FStyle: TElementStyle;
    FData: TArray<TPointD>;
    FPointSize: Integer;
    FPoints: Boolean;
    FLines: Boolean;
    FArea: Boolean;
    FMetadata: TObject;
    procedure SetStyle(const Value: TElementStyle);
    procedure SetData(const Value: TArray<TPointD>);
    procedure SetPointSize(const Value: Integer);
    procedure SetPoints(const Value: Boolean);
    procedure SetLines(const Value: Boolean);
    procedure SetArea(const Value: Boolean);
  const
    DefaultPointSize = 2;
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Style: TElementStyle read FStyle write SetStyle;
    property Data: TArray<TPointD> read FData write SetData;
    property PointSize: Integer read FPointSize write SetPointSize default DefaultPointSize;
    property Points: Boolean read FPoints write SetPoints default True;
    property Lines: Boolean read FLines write SetLines default False;
    property Area: Boolean read FArea write SetArea default False;
    property Metadata: TObject read FMetadata write FMetadata;
  end;

  TPieChart_Slice = TCategoryElement;
  TPieChart = class(TCategoryChart)
  strict private
    FOrigin: TPointD;
    FRadius: Double;
    FStartAngle: Double;
    procedure SetStartAngle(const Value: Double);
    procedure SetOrigin(const Value: TPointD);
    procedure SetRadius(const Value: Double);
    procedure DrawSlice(ASlice: TCategoryElement; const AFraction: Double;
      AIndex: Integer; const AOffset: Double);
    procedure DrawSliceTo(ASVG: TSVGBuilder_VisCtl2D; ASlice: TCategoryElement;
      const AFraction: Double; AIndex: Integer; const AOffset: Double);
    procedure DrawSliceLabels(ASlice: TCategoryElement; const AFraction: Double;
      AIndex: Integer; const AOffset: Double);
    procedure DrawSliceLabelsTo(ASVG: TSVGBuilder_VisCtl2D; ASlice: TCategoryElement;
      const AFraction: Double; AIndex: Integer; const AOffset: Double);
  const
    DefaultLabelPosition = 0.7;
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function AddCategory(const ALabel: string; const AValue: Double): TCategoryElement; override;
    function AddSlice(const ALabel: string; const AValue: Double): TCategoryElement;
    property Slices: TCategoryElements read FCategories write SetCategories;
    property StartAngle: Double read FStartAngle write SetStartAngle;
    property Origin: TPointD read FOrigin write SetOrigin;
    property Radius: Double read FRadius write SetRadius nodefault;
  end;

  TPixmap = class(TDrawable)
  strict private
    FBitmap: TBitmap;
    FD2D1Bitmap: ID2D1Bitmap;
    FRect: TRectD;
    FStyle: TElementStyle;
    procedure SetBitmap(const Value: TBitmap);
    procedure SetRect(const Value: TRectD);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
    procedure FreeDeviceResources; override;
    procedure SetStyle(const Value: TElementStyle);
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    destructor Destroy; override;
    property Bitmap: TBitmap write SetBitmap;
    property Rect: TRectD read FRect write SetRect;
    property Style: TElementStyle read FStyle write SetStyle;
  end;

  THeatmap = class(TPixmap)
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
  end;

  TVectorField = class(TDrawable)
  strict private
  type
    TVectorFieldElement = record
      Position: TPointD;
      Vector: TVectorD;
      constructor Create(const APosition: TPointD; const AVector: TVectorD);
    end;
  var
    FArrow: ID2D1PathGeometry;
    FVectors: TList<TVectorFieldElement>;
    FMatrices: TList<TD2D1Matrix3x2F>;
    FMaxMag: Double;
    FUseMag: Boolean;
    FStyle: TElementStyle;
    FArrowScale: Double;
    procedure SetUseMag(const Value: Boolean);
    procedure CreateArrow;
    procedure CreateMatrices;
    procedure SetStyle(const Value: TElementStyle);
    procedure SetArrowScale(const Value: Double);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    procedure BeginAddVector; inline;
    procedure AddVector(const APosition: TPointD; const AVector: TVectorD);
    procedure EndAddVector; inline;
    procedure Clear;
    property UseMagnitude: Boolean read FUseMag write SetUseMag default True;
    property Style: TElementStyle read FStyle write SetStyle;
    property ArrowScale: Double read FArrowScale write SetArrowScale;
  end;

  TGeometry = class(TDrawable)
  strict private
    FStyle: TElementStyle;
    procedure SetStyle(const Value: TElementStyle);
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Style: TElementStyle read FStyle write SetStyle;
  end;

  TLine = class;

  TLineEndMarkerDrawable = class(TDrawable)
  strict private
    FLineEndMarker: TLineEndMarker;
    FFilled: Boolean;
    FPoint: TPointD;
    FAngle: Double;
    FSizeX, FSizeY: Double;
    FWidth: Integer;
    FColor: TColor;
    FLineColor: Boolean;
    FLine: TLine;
    procedure SetLineEndMarker(const Value: TLineEndMarker);
    procedure SetFilled(const Value: Boolean);
    procedure SetPoint(const Value: TPointD);
    procedure SetAngle(const Value: Double);
    procedure SetSizeX(const Value: Double);
    procedure SetSizeY(const Value: Double);
    procedure SetSize(const Value: Double);
    procedure SetColor(const Value: TColor);
    procedure SetLineColor(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
    procedure AdaptToLine;
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
    function LineDelta: Double;
    function GetSVGID(ASVG: TSVGBuilder_VisCtl2D): string;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    property Line: TLine read FLine write FLine;
    procedure Assign(Source: TPersistent); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Kind: TLineEndMarker read FLineEndMarker write SetLineEndMarker;
    property Filled: Boolean read FFilled write SetFilled;
    property Point: TPointD read FPoint write SetPoint;
    property Angle: Double read FAngle write SetAngle;
    property SizeX: Double read FSizeX write SetSizeX;
    property SizeY: Double read FSizeY write SetSizeY;
    property Size: Double read FSizeX write SetSize;
    property Width: Integer read FWidth write SetWidth;
    property Color: TColor read FColor write SetColor;
    property LineColor: Boolean read FLineColor write SetLineColor;
  end;

  TLine = class(TGeometry)
  strict private
    FStart, FEnd: TPointD;
    procedure SetEnd(const Value: TPointD);
    procedure SetStart(const Value: TPointD);
    procedure SetEndMarker(const Value: TLineEndMarkerDrawable);
    procedure SetStartMarker(const Value: TLineEndMarkerDrawable);
    procedure AdjustLineToMarkers(out AStart, AEnd: TPointD);
    procedure AdjustLineToMarkersSVG(ASVG: TSVGBuilder_VisCtl2D;
      out AStart, AEnd: TPointD);
  private
    FStartMarker, FEndMarker: TLineEndMarkerDrawable;
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    function CreateReference: TAlgosimReference; override;
    property Start: TPointD read FStart write SetStart;
    property &End: TPointD read FEnd write SetEnd;
    property StartMarker: TLineEndMarkerDrawable read FStartMarker write SetStartMarker;
    property EndMarker: TLineEndMarkerDrawable read FEndMarker write SetEndMarker;
    function DX: Double; inline;
    function DY: Double; inline;
  end;

  TRectangle = class(TGeometry)
  strict private
    FRect: TRectD;
    FRotAngle: Double;
    procedure SetRect(const Value: TRectD);
    procedure SetRotAngle(const Value: Double);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Rect: TRectD read FRect write SetRect;
    property Angle: Double read FRotAngle write SetRotAngle;
  end;

  TCircle = class(TGeometry)
  strict private
    FCenter: TPointD;
    FRadius: Double;
    procedure SetCenter(const Value: TPointD);
    procedure SetRadius(const Value: Double);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Center: TPointD read FCenter write SetCenter;
    property Radius: Double read FRadius write SetRadius;
  end;

  TPolygon = class(TGeometry)
  strict private
    FPoints: TArray<TPointD>;
    procedure SetPoints(const Value: TArray<TPointD>);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    property Points: TArray<TPointD> read FPoints write SetPoints;
    procedure Configure(ASettings: TAlgosimStructure); override;
  end;

  TText = class(TGeometry)
  strict private
    FText: string;
    FFont: TFont; // invariant size
    FBoxed: Boolean;
    FPosition: TPointD;
    FWidth,
    FHeight: Double;
    FUseRect: Boolean;
    FAnchorPoint: TAnchorPoint;
    FZoomText: Boolean;
    FZoomRect: Boolean;
    FAlign: TAlignment;
    FVertAlign: TVerticalAlignment;
    FPadding: Integer;
    procedure SetText(const Value: string);
    procedure SetFont(const Value: TFont);
    procedure SetBoxed(const Value: Boolean);
    procedure SetPosition(const Value: TPointD);
    procedure SetWidth(const Value: Double);
    procedure SetHeight(const Value: Double);
    procedure SetUseRect(const Value: Boolean);
    procedure SetAnchorPoint(const Value: TAnchorPoint);
    procedure SetZoomText(const Value: Boolean);
    procedure SetZoomRect(const Value: Boolean);
    procedure SetAlign(const Value: TAlignment);
    procedure SetVertAlign(const Value: TVerticalAlignment);
    procedure SetPadding(const Value: Integer);
    function GetTextAnchorPoint: TAnchorPoint;
    procedure SetTextAnchorPoint(const Value: TAnchorPoint);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    destructor Destroy; override;
    procedure Configure(ASettings: TAlgosimStructure); override;
    property Text: string read FText write SetText;
    property Font: TFont read FFont write SetFont; // invariant size
    property Boxed: Boolean read FBoxed write SetBoxed;
    property Position: TPointD read FPosition write SetPosition;
    property Width: Double read FWidth write SetWidth;
    property Height: Double read FHeight write SetHeight;
    property UseRect: Boolean read FUseRect write SetUseRect;
    property AnchorPoint: TAnchorPoint read FAnchorPoint write SetAnchorPoint;
    property ZoomText: Boolean read FZoomText write SetZoomText;
    property ZoomRect: Boolean read FZoomRect write SetZoomRect;
    property Align: TAlignment read FAlign write SetAlign;
    property VertAlign: TVerticalAlignment read FVertAlign write SetVertAlign;
    property Padding: Integer read FPadding write SetPadding;
    property TextAnchorPoint: TAnchorPoint read GetTextAnchorPoint write SetTextAnchorPoint;
  end;

  TSlice = record
    t, a, b: Double;
    constructor Create(const t, a, b: Double);
  end;

  TRegion = class(TXYPlot)
  strict private
    FAxis: TCartesianAxis;
    FUnboundedMin, FUnboundedMax: Boolean;
    FSliceData: TArray<TSlice>;
    FValidateRegion: Boolean;
    procedure SetAxis(const Value: TCartesianAxis);
    procedure SetSliceData(const Value: TArray<TSlice>);
    procedure SetUnboundedMax(const Value: Boolean);
    procedure SetUnboundedMin(const Value: Boolean);
    procedure SetValidateRegion(const Value: Boolean);
  private
    procedure Draw; override;
    procedure DrawToContent(ASVG: TSVGBuilder_VisCtl2D); override;
  public
    constructor Create(ACtl: TVisCtl2D; AView: TView2D); override;
    property Axis: TCartesianAxis read FAxis write SetAxis;
    property UnboundedMin: Boolean read FUnboundedMin write SetUnboundedMin;
    property UnboundedMax: Boolean read FUnboundedMax write SetUnboundedMax;
    property SliceData: TArray<TSlice> read FSliceData write SetSliceData;
    property ValidateRegion: Boolean read FValidateRegion write SetValidateRegion;
  end;

  TSVGBuilder_VisCtl2D = class(TSVGBuilder)
  private type
    TMarkerDef = packed record
    const
      SizeUnit = 0.0001;
    var
      Shape: TLineEndMarker;
      Filled: TVisCtl2D.TFilledBool;
      Start: Boolean;
      Width, Height: Integer {SizeUnit};
      LineWidth: Integer;
      Color: TColor;
      function GetName: string;
    end;
    TMarkerData = record
      Name: string;
      Marker: TTag;
    end;
    TMarkerDict = TDictionary<TMarkerDef, TMarkerData>;
  var
    FMarkerDict: TMarkerDict;
    function GetMarkerName(ACtl: TVisCtl2D; const AMarkerDef: TMarkerDef;
      const ALineDelta: Double): string;
  public
    constructor Create(AAbstract: Boolean = False); override;
    destructor Destroy; override;
  end;

procedure Register;

implementation

uses
  dlgmod, Clipbrd, Math, StrUtils, Character, DateUtils, GenHelpers, AScolors, ClientDefs,
  ASKernelDefs, ASPixmap, Vis2D_ViewSettings, Vis2D_AxisSettings, Vis2D_GridSettings,
  Vis2D_GridFamiliesSettings, Vis2D_ElementSettings, Vis2D_CategorySettings,
  Vis2D_CategoryChartSettings, Vis2D_PieChartSettings, Vis2D_BarChartSettings,
  Vis2D_HistogramSettings, Vis2D_XYPlotSettings, Vis2D_VectorFieldSettings,
  Vis2D_AxesSettings, Vis2D_TextSettings, Vis2D_LineSettings,
  Vis2D_LineEndSettings, VisCtlOptions, Vis2D_ObjMgr, ComObj, ActiveX, DxgiFormat,
  Winapi.Wincodec, IOUtils, NetEncoding, ShlObj, UxPanel, ASContours;

function idfcn(x: Integer): Integer; overload;
begin
  Result := x;
end;

function idfcn(x: Single): Single; overload;
begin
  Result := x;
end;

function idfcn(x: Double): Double; overload;
begin
  Result := x;
end;

function idfcn(x: TPoint): TPoint; overload;
begin
  Result := x;
end;

procedure Register;
begin
  RegisterComponents('Rejbrand 2020', [TVisCtl2D]);
end;

const
  LEM_CONST = 19.0 / 4;

function ASOToR2Array(Obj: TAlgosimObject): TArray<TPointD>;

  procedure Inv;
  begin
    raise Exception.Create('Invalid 2D point list.');
  end;

var
  L: TList<TPointD>;
  i: Integer;
begin
  L := TList<TPointD>.Create;
  try
    if Obj is TAlgosimArray then
    begin
      for i := 1 to Obj.ElementCount do
        if Obj.Elements[i].ValueCount = 2 then
        begin
          var v := Obj.Elements[i].AsRealVector;
          if v.Dimension = 2 then
            L.Add(TPointD.Create(v[0], v[1]))
          else
            Inv;
        end
        else
          Inv;
    end
    else if Obj is TAlgosimMatrix then
    begin
      var M := Obj.AsRealMatrix;
      if M.Size.Cols <> 2 then
        Inv;
      for i := 0 to M.Size.Rows - 1 do
        L.Add(TPointD.Create(M[i, 0], M[i, 1]));
    end
    else
      Inv;
    Result := L.ToArray;
  finally
    L.Free;
  end;
end;

function AlignmentFromString(const S: string): TAlignment;
type
  T = TAlignment;
const
  Names: array[T] of string
    = ('left', 'right', 'center');
var
  Idx: Integer;
begin
  Idx := IndexStr(S, Names);
  if InRange(Idx, Ord(Low(T)), Ord(High(T))) then
    Result := T(Idx)
  else
    raise Exception.CreateFmt('Invalid alignment: "%s".', [S]);
end;

function VerticalAlignmentFromString(const S: string): TVerticalAlignment;
type
  T = TVerticalAlignment;
const
  Names: array[T] of string
    = ('top', 'bottom', 'center');
var
  Idx: Integer;
begin
  Idx := IndexStr(S, Names);
  if InRange(Idx, Ord(Low(T)), Ord(High(T))) then
    Result := T(Idx)
  else
    raise Exception.CreateFmt('Invalid alignment: "%s".', [S]);
end;

{ TAnchorPointHelper }

class function TAnchorPointHelper.FromString(const S: string): TAnchorPoint;
begin
  for var ap := Low(TAnchorPoint) to High(TAnchorPoint) do
    if ap.ToString = S then
      Exit(ap);
  raise Exception.Create('Invalid anchor point.');
end;

function TAnchorPointHelper.H: TLinearAlignment;
begin
  case Self of
    apTopLeft,
    apLeft,
    apBottomLeft:
      Result := laNegative;
    apTop,
    apCenter,
    apBottom:
      Result := laMiddle;
    apTopRight,
    apRight,
    apBottomRight:
      Result := laPositive;
  else
    raise Exception.Create('Invalid anchor point.');
  end;
end;

function TAnchorPointHelper.ToString: string;
begin
  if InRange(Ord(Self), Ord(Low(TAnchorPoint)), Ord(High(TAnchorPoint))) then
    Result := PointNames[Self]
  else
    Result := '';
end;

function TAnchorPointHelper.V: TLinearAlignment;
begin
  case Self of
    apTopLeft,
    apTop,
    apTopRight:
      Result := laNegative;
    apLeft,
    apCenter,
    apRight:
      Result := laMiddle;
    apBottomLeft,
    apBottom,
    apBottomRight:
      Result := laPositive;
  else
    raise Exception.Create('Invalid anchor point.');
  end;
end;

procedure AlignRect(var ARect: TRect; AAnchorPoint: TAnchorPoint);
begin
  ARect.Offset(
    -Ord(AAnchorPoint.H) * ARect.Width div 2,
    -Ord(AAnchorPoint.V) * ARect.Height div 2
  );
end;

procedure AlignRect(var ARect: TRectD; AAnchorPoint: TAnchorPoint);
begin
  ARect.Offset(
    -Ord(AAnchorPoint.H) * ARect.Width / 2,
    -Ord(AAnchorPoint.V) * ARect.Height / 2
  );
end;

const
  D2d1Origin: TD2DPoint2f = (x: 0.0; y: 0.0);

function rmod2(const x, y: TASR): TASR; inline;
begin
  Result := x - TASI(Trunc(x / y)) * y;
end;

{ TVisCtl2D }

procedure TVisCtl2D.AddMenuItem(AMenuItem: TMenuItem);
begin

  if FCustomMenuItems = nil then
    Exit;

  if AMenuItem = nil then
    Exit;

  FCustomMenuItems.Add(AMenuItem);

end;

procedure TVisCtl2D.AddMenuItems(AMenu: TMenuItem);
var
  i: Integer;
begin

  if FCustomMenuItems = nil then
    Exit;

  if AMenu = nil then
    Exit;

  for i := 0 to AMenu.Count - 1 do
    AddMenuItem(AMenu[i]);

end;

procedure TVisCtl2D.AddObject(AObject: TDrawable);
begin
  if Assigned(FObjs) and Assigned(FObjs.List) and Assigned(AObject) then
  begin
    FObjs.List.Add(AObject);
    AObject.OnChange := ObjChanged;
  end;
end;

function TVisCtl2D.AsSVG(const ASVGExportOptions: TSVGExportOptions): string;
var
  SVG: TSVGBuilder_VisCtl2D;
begin

  ASVGExportOptions.Validate;

  if ((ClientWidth = 0) or (ClientHeight = 0)) and ASVGExportOptions.AutomaticAspectRatio then
    raise ESVGException.Create('Client area has no aspect ratio.');

  SVG := TSVGBuilder_VisCtl2D.Create;
  try
    SVG.DefineNamespace('asd', 'http://www.rejbrand.org/2021/algosim-diagram');
    if ASVGExportOptions.SpecificSize then
    begin
      SVG.Width := ASVGExportOptions.Width.ToString(InvFS) + ASVGExportOptions.LengthUnit;
      SVG.Height := ASVGExportOptions.Height.ToString(InvFS) + ASVGExportOptions.LengthUnit;
      SVG.Stretch := ASVGExportOptions.Stretch;
    end
    else if ASVGExportOptions.AutomaticSize then
    begin
      SVG.Width := ClientWidth.ToString + 'px';
      SVG.Height := ClientHeight.ToString + 'px';
    end
    else if ASVGExportOptions.AutomaticWidth then
    begin
      SVG.Height := ASVGExportOptions.Height.ToString(InvFS) + ASVGExportOptions.LengthUnit;
      SVG.Width := (ClientWidth / ClientHeight * ASVGExportOptions.Height).ToString(InvFS)  + ASVGExportOptions.LengthUnit;
    end
    else if ASVGExportOptions.AutomaticHeight then
    begin
      SVG.Width := ASVGExportOptions.Width.ToString(InvFS) + ASVGExportOptions.LengthUnit;
      SVG.Height := (ClientHeight / ClientWidth * ASVGExportOptions.Width).ToString(InvFS) + ASVGExportOptions.LengthUnit;
    end
    else
      raise ESVGException.Create('SVG dimension error.');
    SVG.Title := ASVGExportOptions.Title;
    SVG.Description := ASVGExportOptions.Description;
    SVG.ViewBox := TViewBox.Create(0.0, 0.0, CanvasRect.Width, CanvasRect.Height);
    SVG.Style(
      CSS.RuleSet('polyline', ['fill: none'])
         .RuleSet('polygon', ['fill-rule: evenodd'])
         .RuleSet('.X-axis .axis-labels text.neg', ['transform: translate(-0.5ch)'])
    ).Append;
    SVG.Tag('asd:view')
      .Attrib('asd:xmin', FView.XMin)
      .Attrib('asd:xmax', FView.XMax)
      .Attrib('asd:ymin', FView.YMin)
      .Attrib('asd:ymax', FView.YMax)
      .Append;
    FObjs.DrawTo(SVG, True);
    GridLines.DrawTo(SVG);
    Axes.DrawTo(SVG);
    FObjs.DrawTo(SVG, False);
    Result := SVG.AsXML;
  finally
    SVG.Free;
  end;

end;

procedure TVisCtl2D.BeginBackgroundPaint;
begin
  Inc(FBackgroundPaintLevel);
end;

procedure TVisCtl2D.CreateDeviceResources;
begin
  FreeDeviceResources;
  FCanvas := TDirect2DCanvas.Create(Handle);
  ID2D1HwndRenderTarget(FCanvas.RenderTarget).SetDpi(PixelsPerInch, PixelsPerInch);
  FCanvas.RenderTarget.CreateSolidColorBrush(D2D1ColorF(clHighlight, 0.5), nil, FZoomRectBrush);
end;

procedure TVisCtl2D.CreateLineEndMarkers;
var
  Sink: ID2D1GeometrySink;
type
  TGeometryDescription = record
    PointCount: Integer;
    BeginMode: TD2D1FigureBegin;
    EndMode: TD2D1_FigureEnd;
    Points: array[0..7] of TD2D1Point2F;
  end;
const
  {$J+}
  MarkersScaled: Boolean = False;
  pts: array[TLineEndMarker] of TGeometryDescription =
    (
      (
        {lemNone}
        PointCount: 0
      ),
      (
        {lemLineArrow}
        PointCount: 3;
        BeginMode:  D2D1_FIGURE_BEGIN_HOLLOW;
        EndMode:    D2D1_FIGURE_END_OPEN;
        Points:
          (
            (x: -0.75; y: -1),
            (x:  0;    y:  0),
            (x:  0.75; y: -1),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0)
          )
      ),
      (
        {lemSolidArrow}
        PointCount: 3;
        BeginMode:  D2D1_FIGURE_BEGIN_FILLED;
        EndMode:    D2D1_FIGURE_END_CLOSED;
        Points:
          (
            (x: -Sqrt2/2;  y: -Sqrt2),
            (x:  0;        y:  0),
            (x:  Sqrt2/2;  y: -Sqrt2),
            (x:  0;        y:  0),
            (x:  0;        y:  0),
            (x:  0;        y:  0),
            (x:  0;        y:  0),
            (x:  0;        y:  0)
          )
      ),
      (
        {lemSemiArrow}
        PointCount: 4;
        BeginMode:  D2D1_FIGURE_BEGIN_FILLED;
        EndMode:    D2D1_FIGURE_END_CLOSED;
        Points:
          (
            (x: -Sqrt2/2;  y: -Sqrt2),
            (x:  0;        y:  0),
            (x:  Sqrt2/2;  y: -Sqrt2),
            (x:  0;        y: -Sqrt2/2),
            (x:  0;        y:  0),
            (x:  0;        y:  0),
            (x:  0;        y:  0),
            (x:  0;        y:  0)
          )
      ),
      (
        {lemDisk}
        PointCount: 0
      ),
      (
        {lemSquare}
        PointCount: 4;
        BeginMode:  D2D1_FIGURE_BEGIN_FILLED;
        EndMode:    D2D1_FIGURE_END_CLOSED;
        Points:
          (
            (x: -InvSqrt2;  y:  0),
            (x:  0;         y:  InvSqrt2),
            (x:  InvSqrt2;  y:  0),
            (x:  0;         y: -InvSqrt2),
            (x:  0;         y:  0),
            (x:  0;         y:  0),
            (x:  0;         y:  0),
            (x:  0;         y:  0)
          )
      ),
      (
        {lemSquare2}
        PointCount: 4;
        BeginMode:  D2D1_FIGURE_BEGIN_FILLED;
        EndMode:    D2D1_FIGURE_END_CLOSED;
        Points:
          (
            (x: -0.5;   y: -0.5),
            (x: -0.5;   y:  0.5),
            (x:  0.5;   y:  0.5),
            (x:  0.5;   y: -0.5),
            (x:  0;     y:  0),
            (x:  0;     y:  0),
            (x:  0;     y:  0),
            (x:  0;     y:  0)
          )
      ),
      (
        {lemLine}
        PointCount: 2;
        BeginMode:  D2D1_FIGURE_BEGIN_HOLLOW;
        EndMode:    D2D1_FIGURE_END_OPEN;
        Points:
          (
            (x: -0.5;  y:  0),
            (x:  0.5;  y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0)
          )
      ),
      (
        {lemBroken}
        PointCount: 5;
        BeginMode:  D2D1_FIGURE_BEGIN_HOLLOW;
        EndMode:    D2D1_FIGURE_END_OPEN;
        Points:
          (
            (x:  0;    y:  0),
            (x: -0.5;  y:  0.25),
            (x:  0.5;  y:  0.5),
            (x:  0;    y:  0.75),
            (x:  0;    y:  1.25),
            (x:  0;    y:  0),
            (x:  0;    y:  0),
            (x:  0;    y:  0)
          )
      )
    );
  {$J-}
var
  t: TLineEndMarker;
  i: Integer;
const
  F = LEM_CONST;

  function GetPoints(ALEM: TLineEndMarker; AStart: Boolean = False): TArray<TPointD>;
  begin
    SetLength(Result, pts[ALEM].PointCount);
    for var i := 0 to High(Result) do
    begin
      Result[i].X := +pts[ALEM].Points[i].y;
      Result[i].Y := -pts[ALEM].Points[i].x;
      if AStart then
        Result[i].X := -Result[i].X;
    end;
  end;

begin

  if not MarkersScaled then
  begin
    for t := Low(TLineEndMarker) to High(TLineEndMarker) do
      for i := 0 to pts[t].PointCount - 1 do
      begin
        pts[t].Points[i].x := F * pts[t].Points[i].x;
        pts[t].Points[i].y := F * pts[t].Points[i].y;
      end;
    MarkersScaled := True;
  end;

  for t := Low(TLineEndMarker) to High(TLineEndMarker) do
  begin
    FLineEndMarkers[t] := nil;
    Sink := nil;
    if pts[t].PointCount = 0 then
      Continue;
    if Succeeded(D2DFactory.CreatePathGeometry(FLineEndMarkers[t])) then
    begin
      if Succeeded(FLineEndMarkers[t].Open(Sink)) then
      begin
        try
          Sink.BeginFigure(pts[t].Points[0], pts[t].BeginMode);
          try
            Sink.AddLines(@pts[t].Points[1], pts[t].PointCount - 1);
          finally
            Sink.EndFigure(pts[t].EndMode);
          end;
        finally
          Sink.Close;
        end;
      end;
    end;
  end;

  FLineEndMarkers[lemDisk] := nil;
  Sink := nil;
  if Succeeded(D2DFactory.CreatePathGeometry(FLineEndMarkers[lemDisk])) then
  begin
    if Succeeded(FLineEndMarkers[lemDisk].Open(Sink)) then
    begin
      try
        Sink.BeginFigure(D2D1PointF(-0.5*F, 0), D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddArc(
            D2D1ArcSegment(
              D2D1PointF(0.5*F, 0),
              D2D1SizeF(0.5*F, 0.5*F),
              0.0,
              D2D1_SWEEP_DIRECTION_CLOCKWISE,
              D2D1_ARC_SIZE_SMALL
            )
          );
          Sink.AddArc(
            D2D1ArcSegment(
              D2D1PointF(-0.5*F, 0),
              D2D1SizeF(0.5*F, 0.5*F),
              0.0,
              D2D1_SWEEP_DIRECTION_CLOCKWISE,
              D2D1_ARC_SIZE_SMALL
            )
          );
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
    end;
  end;

  var SVGBuilder := TSVGBuilder_VisCtl2D.Create(True);
  try

    for t := Low(TLineEndMarker) to High(TLineEndMarker) do
      if pts[t].PointCount > 0 then
        for var Filled := Low(TFilledBool) to High(TFilledBool) do
          for var Start := Low(TStartBool) to High(TStartBool) do
            if (pts[t].BeginMode = D2D1_FIGURE_BEGIN_FILLED) and Filled then
              FSVGMarkers[t, Filled, Start] := SVGBuilder.Polygon(GetPoints(t, Start)).Stroke('none')
            else if pts[t].EndMode = D2D1_FIGURE_END_CLOSED then
              FSVGMarkers[t, Filled, Start] := SVGBuilder.Polygon(GetPoints(t, Start)).Fill('none')
            else
              FSVGMarkers[t, Filled, Start] := SVGBuilder.PolyLine(GetPoints(t, Start));

    for var Start := Low(TStartBool) to High(TStartBool) do
    begin
      FSVGMarkers[lemDisk, False, Start] := SVGBuilder.Circle(0.5*F).Fill('none');
      FSVGMarkers[lemDisk, True, Start] := SVGBuilder.Circle(0.5*F).Stroke('none');
    end;

  finally
    SVGBuilder.Free;
  end;

end;

procedure TVisCtl2D.FreeDeviceResources;
var
  Obj: TDrawable;
begin
  if Assigned(FObjs) and Assigned(FObjs.List) then
    for Obj in FObjs.List do
      Obj.FreeDeviceResources;
  FZoomRectBrush := nil;
  FreeAndNil(FCanvas);
end;

function TVisCtl2D.GetObject(Index: Integer): TDrawable;
begin
  if FObjs = nil then
    Result := nil
  else
    Result := FObjs[Index];
end;

function TVisCtl2D.GetObjectCount: Integer;
begin
  if FObjs = nil then
    Result := 0
  else
    Result := FObjs.ItemCount;
end;

procedure TVisCtl2D.InvalidationTimerTimer(Sender: TObject);
begin
  FInvalidationTimer.Enabled := False;
  Invalidate;
end;

procedure TVisCtl2D.CachedPaintingFreerTimer(Sender: TObject);
begin
  if Assigned(FCachedPaintingFreer) then
    FCachedPaintingFreer.Enabled := False;
  if Assigned(FCachedPainting) then
  begin
    FreeAndNil(FCachedPainting);
    Invalidate;
  end;
end;

function TVisCtl2D.CanvasRect: TRect;
begin
  Result.Left := 0;
  Result.Top := 0;
  Result.Right := Width * 96 div Self.PixelsPerInch;
  Result.Bottom := Height * 96 div Self.PixelsPerInch;
end;

function TVisCtl2D.CanvasToSpace(const ACanvasCoords: TPointD): TPointD;
var
  CR: TRect;
begin
  CR := CanvasRect;
  if (CR.Right = 0) or (CR.Bottom = 0) then
    Result := TPoint.Zero
  else
  begin
    Result.X := xmin + xspan * (ACanvasCoords.x - 0) / CR.Right;
    Result.Y := ymin + yspan * (CR.Bottom - ACanvasCoords.y) / CR.Bottom;
  end;
end;

procedure TVisCtl2D.ChangeScale(M, D: Integer; isDpiChange: Boolean);
begin
  inherited;
  if Assigned(FCanvas) then
  begin
    ID2D1HwndRenderTarget(FCanvas.RenderTarget).SetDpi(PixelsPerInch, PixelsPerInch);
    Invalidate;
  end;
end;

procedure TVisCtl2D.ClearDiagram;
begin
  if Assigned(FObjs) and Assigned(FObjs.List) then
    FObjs.List.Clear;
end;

procedure TVisCtl2D.CMMouseLeave(var Message: TMessage);
begin
  DoHoverCoordChange(NaN, NaN);
end;

procedure TVisCtl2D.CopyToClipboard;
begin
  var bm := CreateBitmap;
  try
    Clipboard.Assign(bm);
  finally
    bm.Free;
  end;
end;

function SizeWidth(const S: TSize): Integer;
begin
  Result := S.Width;
end;

function SizeHeight(const S: TSize): Integer;
begin
  Result := S.Height;
end;

constructor TVisCtl2D.Create(AOwner: TComponent);
begin
  inherited;
  FPixelDeltaX := 0.01;
  FPixelDeltaY := 0.01;
  FInvalidationTimer := TTimer.Create(Self);
  FInvalidationTimer.Interval := 50;
  FInvalidationTimer.OnTimer := InvalidationTimerTimer;
  FPrevMousePos := Point(-1, -1);
  FInvFS := TFormatSettings.Invariant;
  FView := TView2D.Create(Self);
  FView.OnChange := ViewChanged;
  FAxes := TAxes.Create(Self, FView);
  FAxes.OnChange := ObjChanged;
  ViewChanged(Self); // update local cache
  FGridLines := TGridLineFamilies.Create(Self, FView);
  FGridLines.OnChange := ObjChanged;
  FDiagram := TDiagram.Create(Self, FView);
  FObjs := TDrawableList.Create(Self, FView);
  FObjs.OnChange := ObjChanged;
  TabStop := True;
  CreateLineEndMarkers;
  FCustomMenuItems := TList<TMenuItem>.Create;
  CreateContextMenu;
end;

function TVisCtl2D.CreateBitmap: TBitmap;
begin
  Result := TBitmap.Create(ClientWidth, ClientHeight);
  try
    var hdc := GetDC(Handle);
    try
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, hdc, 0, 0, SRCCOPY);
    finally
      ReleaseDC(Handle, hdc);
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TVisCtl2D.CreateContextMenu;
var
  mi, smi: TMenuItem;
begin

  if Assigned(FMenu) then
    Exit;

  FMenu := TPopupMenu.Create(Self);
  FMenu.OnPopup := MenuPopup;

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Restore initial view'#9'Ctrl+0';
  mi.Hint := 'Restores the initial view of this diagram.';
  mi.Tag := CMD_RESTOREVIEW;
  mi.OnClick := MenuCommand;
  FMenu.Items.Add(mi);

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Common views';
  mi.Hint := 'Contains presets of various common views.';
  mi.Tag := CMD_COMMONVIEW;
  FMenu.Items.Add(mi);

  const LSubCommon = mi;
  mi.AutoHotkeys := maManual;

  FMenu.Items.NewBottomLine;

  mi := TMenuItem.Create(LSubCommon);
  mi.Hint := '[−1, 1]²';
  mi.Caption := mi.Hint + #9'Ctrl+1';
  mi.Tag := CMDV_UNITBOX;
  mi.OnClick := MenuCommand;
  LSubCommon.Add(mi);

  mi := TMenuItem.Create(LSubCommon);
  mi.Hint := '[−1, 1]² normalised';
  mi.Caption := mi.Hint + #9'Ctrl+2';
  mi.Tag := CMDV_UNITBOXN;
  mi.OnClick := MenuCommand;
  LSubCommon.Add(mi);

  mi := TMenuItem.Create(LSubCommon);
  mi.Hint := '[−10, 10]²';
  mi.Caption := mi.Hint + #9'Ctrl+3';
  mi.Tag := CMDV_TENBOX;
  mi.OnClick := MenuCommand;
  LSubCommon.Add(mi);

  mi := TMenuItem.Create(LSubCommon);
  mi.Hint := '[−10, 10]² normalised';
  mi.Caption := mi.Hint + #9'Ctrl+4';
  mi.Tag := CMDV_TENBOXN;
  mi.OnClick := MenuCommand;
  LSubCommon.Add(mi);

  mi := TMenuItem.Create(LSubCommon);
  mi.Hint := '[−π, π]×[−1, 1]';
  mi.Caption := mi.Hint + #9'Ctrl+5';
  mi.Tag := CMDV_TRIG;
  mi.OnClick := MenuCommand;
  LSubCommon.Add(mi);

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Centre at origin';
  mi.Hint := 'Centres the view at (0, 0).';
  mi.Tag := CMD_CENTERATORIGIN;
  mi.OnClick := MenuCommand;
  FMenu.Items.Add(mi);

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Normalize';
  mi.Hint := 'Adjusts the view so that 1 unit step in the horizontal and vertical directions have the same on-screen size.';
  FMenu.Items.Add(mi);

  smi := TMenuItem.Create(mi);
  smi.Caption := 'Auto-normalize';
  smi.Hint := 'Automatically normalizes the view when the window is resized.';
  smi.Tag := CMD_TOGGLEAUTONORMALIZE;
  smi.OnClick := MenuCommand;
  FMnuAutoNormalize := smi;
  mi.Add(smi);

  mi.InsertNewLineAfter(smi);

  smi := TMenuItem.Create(mi);
  smi.Caption := 'Adjust horizontal';
  smi.Hint := 'Adjusts the horizontal range.';
  smi.Tag := CMD_NORMALIZEADJUSTHOR;
  smi.OnClick := MenuCommand;
  mi.Add(smi);

  smi := TMenuItem.Create(mi);
  smi.Caption := 'Adjust vertical';
  smi.Hint := 'Adjusts the vertical range.';
  smi.Tag := CMD_NORMALIZEADJUSTVERT;
  smi.OnClick := MenuCommand;
  mi.Add(smi);

  FMenu.Items.InsertNewLineAfter(mi);

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Settings';
  mi.Hint := 'Displays the Visualisation Settings dialog box.';
  mi.Tag := CMD_SETTINGS;
  mi.OnClick := MenuCommand;
  FMenu.Items.Add(mi);

  FMenu.Items.InsertNewLineAfter(mi);

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Save as SVG...'#9'Ctrl+S';
  mi.Hint := 'Saves the current view as a Scalable Vector Graphics (SVG) file.';
  mi.Tag := CMD_SAVESVG;
  mi.OnClick := MenuCommand;
  FMenu.Items.Add(mi);

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Save as bitmap...';
  mi.Hint := 'Saves the current view as a bitmap image (BMP or PNG).';
  mi.Tag := CMD_SAVEBMP;
  mi.OnClick := MenuCommand;
  FMenu.Items.Add(mi);

  FMenu.Items.NewBottomLine;

  mi := TMenuItem.Create(FMenu);
  mi.Caption := 'Copy as bitmap'#9'Ctrl+C';
  mi.Hint := 'Copies the current view to clipboard as a bitmap.';
  mi.Tag := CMD_COPYBMP;
  mi.OnClick := MenuCommand;
  FMenu.Items.Add(mi);

end;

procedure TVisCtl2D.CreateWnd;
begin
  inherited;
  CreateDeviceResources;
end;

procedure TVisCtl2D.CustomizeMenu(AMenu: TMenu);
var
  i: Integer;
begin

  if FCustomMenuItems = nil then
    Exit;

  if AMenu = nil then
    Exit;

  for i := 0 to FCustomMenuItems.Count - 1 do
  begin
    if Assigned(FCustomMenuItems[i].Parent) then
      FCustomMenuItems[i].Parent.Remove(FCustomMenuItems[i]);
    AMenu.Items.Add(FCustomMenuItems[i]);
  end;

end;

procedure TVisCtl2D.DblClick;
begin
  inherited;
  View.AnimateTo(CanvasToSpace(PixelsToDips(ScreenToClient(Mouse.CursorPos))), True);
end;

destructor TVisCtl2D.Destroy;
begin
  if Assigned(FMenu) then
    FMenu.CloseMenu;
  FreeAndNil(FCachedPainting);
  FreeAndNil(FCanvas);
  FreeAndNil(FCustomMenuItems);
  FreeAndNil(FObjs);
  FreeAndNil(FDiagram);
  FreeAndNil(FGridLines);
  FreeAndNil(FAxes);
  FreeAndNil(FView);
  inherited;
end;

function TVisCtl2D.DipsToPixels(const ARect: TRectD): TRect;
begin
  Result.TopLeft := DipsToPixels(ARect.TopLeft);
  Result.BottomRight := DipsToPixels(ARect.BottomRight);
end;

function TVisCtl2D.DipsToPixels(const APoint: TPointD): TPoint;
begin
  Result.X := Round(APoint.X * Self.PixelsPerInch / 96);
  Result.Y := Round(APoint.Y * Self.PixelsPerInch / 96);
end;

procedure TVisCtl2D.DoHoverCoordChange(const X, Y: Double);
begin
  if Assigned(FOnHoverCoordChange) then
    FOnHoverCoordChange(Self, X, Y);
end;

function TVisCtl2D.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  ZoomOut;
  Result := True;
end;

function TVisCtl2D.DoMouseWheelUp(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  ZoomIn;
  Result := True;
end;

procedure TVisCtl2D.DoViewChange;
begin
  if Assigned(FOnViewChange) then
    FOnViewChange(Self);
end;

procedure TVisCtl2D.DrawZoomRect;
var
  R: TRect;
begin

  if not FZoomRect then
    Exit;

  R.TopLeft := Point(Min(FZoomCorner.X, FZoomCorner2.X), Min(FZoomCorner.Y, FZoomCorner2.Y));
  R.BottomRight := Point(Max(FZoomCorner.X, FZoomCorner2.X), Max(FZoomCorner.Y, FZoomCorner2.Y));

  Canvas.RenderTarget.FillRectangle(PixelsToDips(R), FZoomRectBrush);

end;

procedure TVisCtl2D.EndBackgroundPaint;
begin
  Dec(FBackgroundPaintLevel);
end;

procedure TVisCtl2D.ExecCommand(ACommand: Integer);
begin

  case ACommand of
    CMD_SETTINGS:
      Diagram.ShowOptionsForm;
    CMD_RESTOREVIEW:
      begin
        AutoNormalize := False;
        View.RestoreInitial;
      end;
    CMD_CENTERATORIGIN:
      View.AnimateTo(TPoint.Zero);
    CMD_NORMALIZEADJUSTHOR:
      View.Normalize(TCartesianAxis.X);
    CMD_NORMALIZEADJUSTVERT:
      View.Normalize(TCartesianAxis.Y);
    CMD_TOGGLEAUTONORMALIZE:
      AutoNormalize := not AutoNormalize;
    CMD_SAVESVG:
      SaveAsSVG;
    CMD_COPYBMP:
      CopyToClipboard;
    CMD_SAVEBMP:
      SaveAsBitmap;
    CMDV_UNITBOX:
      begin
        AutoNormalize := False;
        View.AnimateTo(TPointD.Create(-1, +1), TPointD.Create(1, -1));
      end;
    CMDV_UNITBOXN:
      begin
        View.&Set(-1, +1, -1, +1);
        AutoNormalize := True;
      end;
    CMDV_TENBOX:
      begin
        AutoNormalize := False;
        View.AnimateTo(TPointD.Create(-10, +10), TPointD.Create(10, -10));
      end;
    CMDV_TENBOXN:
      begin
        View.&Set(-10, +10, -10, +10);
        AutoNormalize := True;
      end;
    CMDV_TRIG:
      begin
        AutoNormalize := False;
        View.AnimateTo(TPointD.Create(-Pi, +1), TPointD.Create(Pi, -1));
      end;
  end;

end;

procedure TVisCtl2D.KeyDown(var Key: Word; Shift: TShiftState);
begin

  inherited;

  var Numerator   := IfThen(ssCtrl in Shift, 1, 10);
  var Denominator := IfThen(ssCtrl in Shift, 200, 10);

  if Shift = [ssCtrl] then
  begin
    var LHandled := True;
    case Key of
      Ord('1'), VK_NUMPAD1:
        ExecCommand(CMDV_UNITBOX);
      Ord('2'), VK_NUMPAD2:
        ExecCommand(CMDV_UNITBOXN);
      Ord('3'), VK_NUMPAD3:
        ExecCommand(CMDV_TENBOX);
      Ord('4'), VK_NUMPAD4:
        ExecCommand(CMDV_TENBOXN);
      Ord('5'), VK_NUMPAD5:
        ExecCommand(CMDV_TRIG);
      Ord('0'), VK_NUMPAD0:
        ExecCommand(CMD_RESTOREVIEW);
    else
      LHandled := False;
    end;
    if LHandled then
      Exit;
  end;

  if ssShift in Shift then
    case Key of
      VK_RIGHT:
        ZoomX(-Numerator);
      VK_LEFT:
        ZoomX(Numerator);
      VK_DOWN:
        ZoomY(Numerator);
      VK_UP:
        ZoomY(-Numerator);
    end
  else
    case Key of
      VK_RIGHT:
        Translate(xspan / Denominator, 0);
      VK_LEFT:
        Translate(-xspan / Denominator, 0);
      VK_DOWN:
        Translate(0, -yspan / Denominator);
      VK_UP:
        Translate(0, yspan / Denominator);
      VK_ESCAPE:
        if FZoomRect then
        begin
          FZoomRect := False;
          ReleaseCapture;
          Invalidate;
        end;
    end;

end;

procedure TVisCtl2D.KeyPress(var Key: Char);
begin
  inherited;
  case Key of
    ^C:
      CopyToClipboard;
    ^S:
      SaveAsSVG;
  end;
end;

procedure TVisCtl2D.LowPriorityInvalidate;
begin
  if FBackgroundPaintLevel <= 0 then
    Invalidate
  else
    FInvalidationTimer.Enabled := True;
end;

procedure TVisCtl2D.MenuCommand(Sender: TObject);
begin

  if not (Sender is TMenuItem) then
    Exit;

  ExecCommand(TMenuitem(Sender).Tag);

end;

procedure TVisCtl2D.MenuPopup(Sender: TObject);
begin
  if Assigned(FMnuAutoNormalize) then
    FMnuAutoNormalize.Checked := AutoNormalize;
  if Assigned(FOnBeforeContextPopup) then
    FOnBeforeContextPopup(Self);
end;

procedure TVisCtl2D.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if CanFocus then
    SetFocus;
  if Button = mbLeft then
    FPrevMousePos := Point(X, Y);
  if (Button = mbLeft) and (ssCtrl in Shift) or (Button = mbMiddle) then
  begin
    FZoomRect := True;
    FZoomCorner := Point(X, Y);
    FZoomCorner2 := FZoomCorner;
    SetCapture(Handle);
  end;
end;

procedure TVisCtl2D.MouseMove(Shift: TShiftState; X, Y: Integer);

  procedure FixZoomAspect;
  begin
    if FAutoNormalize then
    begin
      if (ClientWidth = 0) or (ClientHeight = 0) then
        Exit;
      const AR = ClientWidth / ClientHeight;
      const LMouseRect = TRect.Create(FZoomCorner, FZoomCorner2, True);
      if (LMouseRect.Width = 0) or (LMouseRect.Height = 0) then
        Exit;
      const LMouseRectAR = LMouseRect.Width / LMouseRect.Height;
      const LDirection = FZoomCorner2 - FZoomCorner;
      if LMouseRectAR > AR then
        FZoomCorner2 := FZoomCorner + Point(LMouseRect.Width * Sign(LDirection.X), Round(LMouseRect.Width * Sign(LDirection.Y) / AR))
      else
        FZoomCorner2 := FZoomCorner + Point(Round(LMouseRect.Height * Sign(LDirection.X) * AR), LMouseRect.Height * Sign(LDirection.Y));
    end;
  end;

var
  CR: TRect;
begin
  inherited;
  if (csLButtonDown in ControlState) and (FPrevMousePos.Y <> -1) then
  begin
    if FZoomRect then
    begin
      FZoomCorner2 := Point(X, Y);
      FixZoomAspect;
      Invalidate;
    end
    else
    begin
      CR := ClientRect;
      if not CR.IsEmpty then
        Translate(
          -(X - FPrevMousePos.X) * xspan / CR.Width,
          +(Y - FPrevMousePos.Y) * yspan / CR.Height
        );
      FPrevMousePos := Point(X, Y);
    end;
  end
  else if (GetKeyState(VK_MBUTTON) < 0) and FZoomRect then
  begin
    FZoomCorner2 := Point(X, Y);
    FixZoomAspect;
    Invalidate;
  end;
  const P = CanvasToSpace(PixelsToDips(Point(X, Y)));
  DoHoverCoordChange(P.X, P.Y);
end;

procedure TVisCtl2D.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if Self = nil then
    Exit;
  inherited;
  if FZoomRect then
  begin
    FZoomRect := False;
    ReleaseCapture;
    Invalidate;
    View.AnimateTo(
      CanvasToSpace(PixelsToDips(FZoomCorner)),
      CanvasToSpace(PixelsToDips(FZoomCorner2))
    );
  end;
  FPrevMousePos := Point(-1, -1);
end;

procedure TVisCtl2D.ObjChanged(Sender: TObject);
begin
  FreeAndNil(FCachedPainting);
  LowPriorityInvalidate;
end;

class function TVisCtl2D.P(const X, Y: Double): TPointD;
begin
  Result.X := X;
  Result.Y := Y;
end;

procedure TVisCtl2D.Paint;
begin

  inherited;

  Canvas.RenderTarget.Clear(D2D1ColorF(Color));

  if Assigned(FCachedPainting) then
  begin
    Canvas.StretchDraw(CanvasRect, FCachedPainting);
    DrawZoomRect;
  end
  else
  begin

    var tc1 := GetTickCount64;

    FObjs.Draw(True);
    GridLines.Draw;
    Axes.Draw;
    FObjs.Draw(False);

    DrawZoomRect;

    var tc2 := GetTickCount64;

    FSlowPaint := UInt64(tc2 - tc1) > 250;

  end;

end;

function TVisCtl2D.PixelsToDips(const ARect: TRect): TRectD;
begin
  Result.TopLeft := PixelsToDips(ARect.TopLeft);
  Result.BottomRight := PixelsToDips(ARect.BottomRight);
end;

class function TVisCtl2D.Q(const X, Y: Double): TPointD;
begin
  Result.X := Y;
  Result.Y := X;
end;

procedure TVisCtl2D.RemoveMenuItem(AMenuItem: TMenuItem);
begin

  if FCustomMenuItems = nil then
    Exit;

  if AMenuItem = nil then
    Exit;

  FCustomMenuItems.Remove(AMenuItem);

end;

procedure TVisCtl2D.RemoveObject(AObject: TDrawable);
begin
  if Assigned(Self) and Assigned(FObjs) and Assigned(FObjs.List) then
    FObjs.List.Remove(AObject);
end;

function TVisCtl2D.PixelsToDips(const APoint: TPoint): TPointD;
begin
  Result.X := APoint.X / Self.PixelsPerInch * 96;
  Result.Y := APoint.Y / Self.PixelsPerInch * 96;
end;

procedure TVisCtl2D.SetAutoNormalize(const Value: Boolean);
begin
  if FAutoNormalize <> Value then
  begin
    FAutoNormalize := Value;
    if FAutoNormalize then
      ExecCommand(CMD_NORMALIZE);
  end;
end;

procedure TVisCtl2D.SetAxes(const Value: TAxes);
begin
  FAxes.Assign(Value);
end;

procedure TVisCtl2D.SetGridLines(const Value: TGridLineFamilies);
begin
  FGridLines.Assign(Value);
end;

procedure TVisCtl2D.SetView(const Value: TView2D);
begin
  FView.Assign(Value);
end;

function TVisCtl2D.SpaceToCanvas(const X, Y: Double; DX, DY: Integer): TPointD;
begin
  Result := SpaceToCanvas(TPointD.Create(X, Y), DX, DY);
end;

function TVisCtl2D.SpaceToCanvas(const ASpaceCoords: TPointD; const DX,
  DY: Double): TPointD;
var
  CR: TRect;
begin
  CR := CanvasRect;
  if (xspan > 0) and (yspan > 0) then
  begin
    Result.x := CR.Width * (ASpaceCoords.X - xmin) / xspan + DX;
    Result.y := CR.Height * (1 - (ASpaceCoords.Y - ymin) / yspan) + DY;
  end
  else
    Result := TPoint.Zero;
end;

function TVisCtl2D.SpaceToCanvas(const ASpaceCoords: TRectD;
  AFlipped: Boolean): TRectD;
begin
  Result.TopLeft := SpaceToCanvas(ASpaceCoords.TopLeft);
  Result.BottomRight := SpaceToCanvas(ASpaceCoords.BottomRight);
  if AFlipped then
    TSwapper<Double>.Swap(Result.Top, Result.Bottom);
end;

function TVisCtl2D.SpaceToViewbox(const AViewBox: TViewBox;
  const ASpaceCoords: TPointD; DX, DY: Integer): TPointD;
begin

  if AViewBox.Valid then
  begin
    Result.x := AViewBox.Xmin + AViewBox.Width * (ASpaceCoords.X - xmin) / xspan + DX;
    Result.y := AViewBox.Ymin + AViewBox.Height * (1 - (ASpaceCoords.Y - ymin) / yspan) + DY;
  end
  else
    Result := TPoint.Zero;

end;

function TVisCtl2D.SpaceToViewbox(const AViewBox: TViewBox;
  const ASpaceCoords: TRectD): TRectD;
begin

  if AViewBox.Valid then
  begin
    Result.TopLeft := SpaceToViewbox(AViewBox, ASpaceCoords.TopLeft);
    Result.BottomRight := SpaceToViewbox(AViewBox, ASpaceCoords.BottomRight);
  end
  else
    Result := Default(TRectD);

end;

function TVisCtl2D.SpaceToViewboxX(const AViewBox: TViewBox;
  const ASpaceCoords: Double): Double;
begin

  if AViewBox.Valid and (xspan > 0) then
    Result := ASpaceCoords * AViewBox.Width / xspan
  else
    Result := 0;

end;

function TVisCtl2D.SpaceToViewboxY(const AViewBox: TViewBox;
  const ASpaceCoords: Double): Double;
begin

  if AViewBox.Valid and (yspan > 0) then
    Result := ASpaceCoords * AViewBox.Height / yspan
  else
    Result := 0;

end;

function TVisCtl2D.SpaceToCanvas(const ASpaceCoords: TPointD;
  DX: Integer = 0; DY: Integer = 0): TPointD;
var
  CR: TRect;
begin
  CR := CanvasRect;
  if (xspan > 0) and (yspan > 0) then
  begin
    Result.x := CR.Width * (ASpaceCoords.X - xmin) / xspan + DX;
    Result.y := CR.Height * (1 - (ASpaceCoords.Y - ymin) / yspan) + DY;
  end
  else
    Result := TPoint.Zero;
end;

procedure TVisCtl2D.Translate(const DX, DY: Double);
begin
  View.&Set(View.XMin + DX, View.XMax + DX, View.YMin + DY, View.YMax + DY);
end;

function TVisCtl2D.TrySpaceToD2d1(const ASpaceCoords: TPointD;
  out AD2d1Point: TD2D1Point2F): Boolean;
var
  tmp: TPointD;
begin
  tmp := SpaceToCanvas(ASpaceCoords);
  Result :=
    InRange(tmp.X, Single.MinValue, Single.MaxValue)
      and
    InRange(tmp.Y, Single.MinValue, Single.MaxValue);
  if Result then
    AD2d1Point := tmp;
end;

function TVisCtl2D.UnboundIdentity(const APoint: TD2D1Point2F): TD2D1Point2F;
begin
  Result := APoint;
end;

function TVisCtl2D.UnboundXMax(const APoint: TD2D1Point2F): TD2D1Point2F;
begin
  Result := APoint;
  Result.x := CanvasRect.Right;
end;

function TVisCtl2D.UnboundXMin(const APoint: TD2D1Point2F): TD2D1Point2F;
begin
  Result := APoint;
  Result.x := 0;
end;

function TVisCtl2D.UnboundYMax(const APoint: TD2D1Point2F): TD2D1Point2F;
begin
  Result := APoint;
  Result.y := 0;
end;

function TVisCtl2D.UnboundYMin(const APoint: TD2D1Point2F): TD2D1Point2F;
begin
  Result := APoint;
  Result.y := CanvasRect.Bottom;
end;

procedure TVisCtl2D.SaveAsSVG(const AFileName: string;
  const ASVGExportOptions: TSVGExportOptions);
begin
  TFile.WriteAllText(AFileName, AsSVG(ASVGExportOptions), TEncoding.UTF8);
end;

type
  TSaveDialogSVGData = class
    Title,
    Description: string;
    Width, Height: string;
    DoStretch: Boolean;
    constructor Create(const ATitle, ADescription, AWidth, AHeight: string;
      ADoStretch: Boolean);
  end;

{ TSaveDialogSVGData }

constructor TSaveDialogSVGData.Create(const ATitle, ADescription,
  AWidth, AHeight: string; ADoStretch: Boolean);
begin
  Title := ATitle;
  Description := ADescription;
  Width := AWidth;
  Height := AHeight;
  DoStretch := ADoStretch;
end;

procedure TVisCtl2D.SaveAsBitmap;
begin
  var bm := CreateBitmap;
  try
    ASPixmap.SaveGraphicToFile(bm, Self, SanitizeFileName(Caption));
  finally
    bm.Free;
  end;
end;

procedure TVisCtl2D.SaveAsSVG;
var
  Dlg: TFileSaveDialog;
begin

  Dlg := TFileSaveDialog.Create(Self);
  try
    Dlg.ClientGuid := '{684BA229-52EC-4CE6-883B-B0D8374E600C}';
    Dlg.Title := 'Save as SVG';
    with Dlg.FileTypes.Add do
    begin
      DisplayName := 'SVG images';
      FileMask := '*.svg';
    end;
    Dlg.Options := [fdoOverWritePrompt, fdoPathMustExist];
    Dlg.DefaultExtension := 'svg';
    Dlg.OnExecute := SaveAsSVGFileDialogExecute;
    Dlg.OnFileOkClick := SaveAsSVGFileDialogOKClick;
    if Dlg.Execute then
    begin
      var LSVGOptions := DefaultSVGExportOptions;
      if TObject(Dlg.Tag) is TSaveDialogSVGData then
        with TSaveDialogSVGData(Dlg.Tag) do
          try
            LSVGOptions.Title := Title;
            LSVGOptions.Description := Description;
            LSVGOptions.SetDimensionsFromText(Width, Height);
            LSVGOptions.Stretch := DoStretch;
          finally
            Free;
          end;
      SaveAsSVG(Dlg.FileName, LSVGOptions);
    end;
  finally
    Dlg.Free;
  end;

end;

procedure TVisCtl2D.SaveAsSVGFileDialogExecute(Sender: TObject);
var
  FDC: IFileDialogCustomize;
begin

  try

    if
      (Sender is TFileSaveDialog)
        and
      (TFileSaveDialog(Sender).Dialog.QueryInterface(IID_IFileDialogCustomize, FDC) = S_OK)
    then
    begin

      FDC.StartVisualGroup(SVGFDCCTL_Title + 100, 'Title:');
      FDC.AddEditBox(SVGFDCCTL_Title, '');
      FDC.EndVisualGroup;

      FDC.StartVisualGroup(SVGFDCCTL_Descr + 100, 'Description:');
      FDC.AddEditBox(SVGFDCCTL_Descr, '');
      FDC.EndVisualGroup;

      FDC.AddSeparator(61);

      FDC.StartVisualGroup(SVGFDCCTL_Width + 100, 'Width:');
      FDC.AddEditBox(SVGFDCCTL_Width, PChar(CanvasRect.Width.ToString));
      FDC.EndVisualGroup;

      FDC.StartVisualGroup(SVGFDCCTL_Height + 100, 'Height:');
      FDC.AddEditBox(SVGFDCCTL_Height, PChar(CanvasRect.Height.ToString));
      FDC.EndVisualGroup;

      FDC.AddCheckButton(SVGFDCCTL_Stretch, 'Allow stretching', False);

    end;

  except
  end;

end;

procedure TVisCtl2D.SaveAsSVGFileDialogOKClick(Sender: TObject;
  var CanClose: Boolean);
var
  FDC: IFileDialogCustomize;
begin

  try

    if
      (Sender is TFileSaveDialog)
        and
      (TFileSaveDialog(Sender).Dialog.QueryInterface(IID_IFileDialogCustomize, FDC) = S_OK)
    then
    begin

      var buf: PWideChar;
      var Title, Descr, Width, Height: string;

      if Succeeded(FDC.GetEditBoxText(SVGFDCCTL_Title, buf)) then
        try
          Title := buf;
        finally
          CoTaskMemFree(buf);
        end;

      if Succeeded(FDC.GetEditBoxText(SVGFDCCTL_Descr, buf)) then
        try
          Descr := buf;
        finally
          CoTaskMemFree(buf);
        end;

      if Succeeded(FDC.GetEditBoxText(SVGFDCCTL_Width, buf)) then
        try
          Width := buf;
        finally
          CoTaskMemFree(buf);
        end;

      if Succeeded(FDC.GetEditBoxText(SVGFDCCTL_Height, buf)) then
        try
          Height := buf;
        finally
          CoTaskMemFree(buf);
        end;

      var DoStretch: LongBool := False;
      FDC.GetCheckButtonState(SVGFDCCTL_Stretch, DoStretch);

      // Validate

      begin
        var opt := DefaultSVGExportOptions;
        try
          opt.SetDimensionsFromText(Width, Height);
        except
          on E: Exception do
          begin
            MessageBox(
              TFileSaveDialog(Sender).Handle,
              PChar(E.Message),
              PChar(TFileSaveDialog(Sender).Title),
              MB_ICONERROR
            );
            CanClose := False;
            Exit;
          end;
        end;
      end;

      if CanClose then
        TFileSaveDialog(Sender).Tag :=
          NativeInt(TSaveDialogSVGData.Create(Title, Descr, Width, Height, DoStretch));

    end;

  except
  end;

end;

function TVisCtl2D.Scr(const X, Y: Double): TPointD;
begin
  Result := SpaceToCanvas(P(X, Y));
end;

procedure TVisCtl2D.ViewChanged(Sender: TObject);
begin
  xmin := FView.XMin;
  xmax := FView.XMax;
  ymin := FView.YMin;
  ymax := FView.YMax;
  FreeAndNil(FCachedPainting);
  LowPriorityInvalidate;
  if HandleAllocated and Assigned(Parent) then
  begin
    const MCP = Mouse.CursorPos;
    if ClientRect.Contains(ScreenToClient(MCP)) then
    begin
      const P = CanvasToSpace(PixelsToDips(ScreenToClient(MCP)));
      const Q = CanvasToSpace(PixelsToDips(ScreenToClient(MCP.Add(Point(1, 1)))));
      const D = Q - P;
      if D.X <> 0.0 then
        FPixelDeltaX := Abs(D.X);
      if D.Y <> 0.0 then
        FPixelDeltaY := Abs(D.Y);
      DoHoverCoordChange(P.X, P.Y);
    end
    else
      DoHoverCoordChange(NaN, NaN);
  end;
  if FAutoNormalize then
    ExecCommand(CMD_NORMALIZE);
  DoViewChange;
end;

procedure TVisCtl2D.WMContextMenu(var Message: TWMContextMenu);
var
  P: TPoint;
begin
  if Assigned(FMenu) then
  begin
    if Message.Pos = Point(-1, -1) then
      P := ClientToScreen(BoundsRect.CenterPoint)
    else
      P := Message.Pos;
    CustomizeMenu(FMenu);
    FMenu.Popup(P.X, P.Y);
  end
  else
    inherited;
end;

procedure TVisCtl2D.WMDisplayChange(var Message: TWMDisplayChange);
begin
  Message.Result := 0;
  FreeAndNil(FCachedPainting);
  Invalidate;
end;

procedure TVisCtl2D.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TVisCtl2D.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTARROWS;
end;

procedure TVisCtl2D.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
  res: HRESULT;
begin
  FLastPaintLayoutMode := TUxContainer.LayoutMode;
  if not TUxContainer.LayoutMode then
    FLastNonLayoutPaintClientRect := ClientRect;
  BeginPaint(Handle, PaintStruct);
  try
    if Assigned(FCanvas) then
    begin
      FCanvas.BeginDraw;
      try
        FSlowPaint := False;
        Paint;
        var dx, dy: Single;
        ID2D1HwndRenderTarget(FCanvas.RenderTarget).GetDpi(dx, dy);
      finally
        res := FCanvas.RenderTarget.EndDraw;
        if res = D2DERR_RECREATE_TARGET then
        begin
          FreeDeviceResources;
          CreateDeviceResources;
          var S := D2D1SizeU(ClientWidth, ClientHeight);
          ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(S);
          Invalidate;
        end;
      end;
    end;
  finally
    EndPaint(Handle, PaintStruct);
  end;
  if FSlowPaint and not FZoomRect then
  begin
    FreeAndNil(FCachedPainting);
    FCachedPainting := CreateBitmap;
  end;
end;

procedure TVisCtl2D.WMSize(var Message: TWMSize);
var
  S: TD2DSizeU;
begin
  if Assigned(FCachedPainting) then
  begin
    const
      LShouldKeepCache
        =
      (TUxContainer.LayoutMode <> FLastPaintLayoutMode)
        and
      (TUxContainer.LayoutMode or (ClientRect = FLastNonLayoutPaintClientRect));
    if not LShouldKeepCache then
    begin
      if FCachedPaintingFreer = nil then
      begin
        FCachedPaintingFreer := TTimer.Create(Self);
        FCachedPaintingFreer.Interval := 500;
        FCachedPaintingFreer.Enabled := True;
        FCachedPaintingFreer.OnTimer := CachedPaintingFreerTimer;
      end;
      RestartTimer(FCachedPaintingFreer);
    end;
  end;
  if Assigned(FCanvas) then
  begin
    S := D2D1SizeU(ClientWidth, ClientHeight);
    ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(S);
  end;
  Invalidate;
  if FAutoNormalize then
    ExecCommand(CMD_NORMALIZE);
  inherited;
end;

function TVisCtl2D.xspan: Double;
begin
  Result := xmax - xmin;
end;

function TVisCtl2D.yspan: Double;
begin
  Result := ymax - ymin;
end;

procedure TVisCtl2D.Zoom(const Factor: Double);
var
  CP: TPointD;
  fxsd2, fysd2: Double;

  function XChOK: Boolean;
  begin
    Result := ((fxsd2 > 1E-12) or (Factor > 1)) and ((fxsd2 < 1E+37) or (Factor < 1));
  end;

  function YChOK: Boolean;
  begin
    Result := ((fysd2 > 1E-12) or (Factor > 1)) and ((fysd2 < 1E+37) or (Factor < 1));
  end;

begin
  CP := View.CenterPoint;
  fxsd2 := Factor * xspan / 2;
  fysd2 := Factor * yspan / 2;
  if XChOK and YChOK then
    View.&Set(
      CP.X - fxsd2,
      CP.X + fxsd2,
      CP.Y - fysd2,
      CP.Y + fysd2
    );
end;

procedure TVisCtl2D.ZoomIn;
begin
  Zoom(0.9);
end;

procedure TVisCtl2D.ZoomOut;
begin
  Zoom(1.1);
end;

procedure TVisCtl2D.ZoomX(const A: Double);
begin
  if FAutoNormalize then
    Zoom(1 + A/100)
  else
    View.&Set(View.XMin - A * View.XSpan / 100, View.XMax + A * View.XSpan / 100,
      View.YMin, View.YMax);
end;

procedure TVisCtl2D.ZoomY(const A: Double);
begin
  if FAutoNormalize then
    Zoom(1 + A/100)
  else
    View.&Set(View.XMin, View.XMax,
      View.YMin - A * View.YSpan / 100, View.YMax + A * View.YSpan / 100);
end;

{ TView2D }

function TView2D.Scale(const P: TPointD): TPointD;
begin
  Result.X := ScaleX(P.X);
  Result.Y := -ScaleY(P.Y);
end;

function TView2D.ScaleX(const X: Double): Double;
begin
  if XSpan <> 0 then
    Result := X * FCtl.CanvasRect.Width / XSpan
  else
    Result := X;
end;

function TView2D.ScaleY(const Y: Double): Double;
begin
  if YSpan <> 0 then
    Result := Y * FCtl.CanvasRect.Height / YSpan
  else
    Result := Y;
end;

procedure TView2D.&Set(const AXFrom, AXTo, AYFrom, AYTo: Double;
  APreferAxes: Boolean);
const
  MinContentFraction = 0.5;
var
  LXFrom, LXTo,
  LYFrom, LYTo: Double;
begin

  LXFrom := AXFrom;
  LXTo := AXTo;
  LYFrom := AYFrom;
  LYTo := AYTo;

  if APreferAxes then
  begin

    if (LXTo <= LXFrom) or (LYTo <= LYFrom) then
      Exit;

    if (LXTo > 0) and (LXFrom > -LXTo/15) and (15*(LXTo - LXFrom)/(16*LXTo) >= MinContentFraction) then
      LXFrom := -LXTo/15;

    if (LYTo > 0) and (LYFrom > -LYTo/15) and (15*(LYTo - LYFrom)/(16*LYTo) >= MinContentFraction) then
      LYFrom := -LYTo/15;

    if (LXFrom < 0) and (LXTo < -LXFrom/15) and (15*(LXTo - LXFrom)/(-16*LXTo) >= MinContentFraction) then
      LXTo := -LXFrom/15;

    if (LYFrom < 0) and (LYTo < -LYFrom/15) and (15*(LYTo - LYFrom)/(-16*LYTo) >= MinContentFraction) then
      LYTo := -LYFrom/15;

  end;

  if
    (FBounds[_xmin] <> LXFrom) or (FBounds[_xmax] <> LXTo) or
    (FBounds[_ymin] <> LYFrom) or (FBounds[_ymax] <> LYTo)
  then
    if (LXTo - LXFrom > 1E-15) and (LYTo - LYFrom > 1E-15) then
    begin
      FBounds[_xmin] := LXFrom;
      FBounds[_xmax] := LXTo;
      FBounds[_ymin] := LYFrom;
      FBounds[_ymax] := LYTo;
      if not FFirstViewSet then
      begin
        FFirstView := FBounds;
        FFirstViewSet := True;
      end;
      Changed;
    end;

end;

procedure TView2D.AnimateTo(const ACenterPoint: TPointD; AMoveCursor: Boolean);
const
  Gamma = 4.0;
var
  i: Integer;
  F, t: Double;
begin

  F := 1 / ArcTan(Gamma);
  for i := 0 to High(FTranslationAnimation) do
  begin
    t := i / High(FTranslationAnimation);                                        // [0, 1]
    t := 2 * t - 1;                                                              // [-1, 1]
    t := F * ArcTan(Gamma * t);                                                  // Sigmoid transformation
    t := (t + 1) / 2;                                                            // [0, 1]
    FTranslationAnimation[i] := (1 - t) * CenterPoint + t * ACenterPoint;
  end;

  FTranslationAnimationBegin := Now;
  FTranslationAnimationEnd := IncMilliSecond(FTranslationAnimationBegin,
    Round(1000 * TranslationAnimationDurationSec));
  FTranslationTimer.Interval := 50;
  FTranslationTimer.Tag := Ord(AMoveCursor);
  FTranslationTimer.Enabled := True;

end;

procedure TView2D.AnimateTo(const ACorner1, ACorner2: TPointD);
const
  Gamma = 4.0;
var
  LTopLeft, LBottomRight: TPointD;
  R: TRectD;
  i: Integer;
  F, t: Double;
begin

  if ACorner1 = ACorner2 then
    Exit;

  LTopLeft := TPointD.Create(Min(ACorner1.X, ACorner2.X), Min(ACorner1.Y, ACorner2.Y));
  LBottomRight := TPointD.Create(Max(ACorner1.X, ACorner2.X), Max(ACorner1.Y, ACorner2.Y));

  R.TopLeft := LTopLeft;
  R.BottomRight := LBottomRight;
  if (R.Width < 1E-38) or (R.Height < 1E-38) then
    Exit;

  F := 1 / ArcTan(Gamma);
  for i := 0 to High(FZoomTranslationAnimation) do
  begin
    t := i / High(FZoomTranslationAnimation);                                    // [0, 1]
    t := 2 * t - 1;                                                              // [-1, 1]
    t := F * ArcTan(Gamma * t);                                                  // Sigmoid transformation
    t := (t + 1) / 2;                                                            // [0, 1]
    FZoomTranslationAnimation[i].TopLeft := (1 - t) * TopLeft + t * LTopLeft;
    FZoomTranslationAnimation[i].BottomRight := (1 - t) * BottomRight + t * LBottomRight;
  end;

  FTranslationAnimationBegin := Now;
  FTranslationAnimationEnd := IncMilliSecond(FTranslationAnimationBegin,
    Round(1000 * TranslationAnimationDurationSec));
  FZoomTranslationTimer.Interval := 50;
  FZoomTranslationTimer.Enabled := True;

end;

function TView2D.Area: Double;
begin
  Result := XSpan * YSpan;
end;

function TView2D.AspectDeviation: Double;
begin

  if FCtl = nil then
    Exit(NaN);

  if (yspan <= 0) or (xspan <= 0) then
    Exit(NaN);

  if not FCtl.HandleAllocated then
    Exit(NaN);

  if (FCtl.ClientHeight <= 0) or (FCtl.ClientWidth <= 0) then
    Exit(NaN);

  const SpaceAspect = xspan / yspan;
  const CanvasAspect = FCtl.ClientWidth / FCtl.ClientHeight;
  var Ratio := SpaceAspect / CanvasAspect;
  if Ratio < 1.0 then
    Ratio := 1 / Ratio;

  Result := Ratio - 1.0;

end;

procedure TView2D.Assign(Source: TPersistent);
begin
  if Source is TView2D then
  begin
    if not CompareMem(@FBounds, @TView2D(Source).FBounds, SizeOf(FBounds)) then
    begin
      FBounds := TView2D(Source).FBounds;
      if Assigned(FOnChange) then
        FOnChange(Self);
    end;
  end
  else
    inherited;
end;

function TView2D.BottomRight: TPointD;
begin
  Result := TPointD.Create(XMax, YMax);
end;

procedure TView2D.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'xmin' then
      XMin := V.ToRealNumber
    else if S = 'xmax' then
      XMax := V.ToRealNumber
    else if S = 'ymin' then
      YMin := V.ToRealNumber
    else if S = 'ymax' then
      YMax := V.ToRealNumber
    else if S = 'centerpoint' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        CenterPoint := TPointD.Create(pos[0], pos[1]);
    end;
  end;
end;

constructor TView2D.Create(ACtl: TVisCtl2D);
begin
  inherited Create(ACtl, nil);
  FCtl := ACtl;
  FBounds := DefBoundsArray;
  FTranslationTimer := TTimer.Create(nil);
  FTranslationTimer.Interval := 50;
  FTranslationTimer.Enabled := False;
  FTranslationTimer.OnTimer := TranslationTimerTimer;
  FZoomTranslationTimer := TTimer.Create(nil);
  FZoomTranslationTimer.Interval := 50;
  FZoomTranslationTimer.Enabled := False;
  FZoomTranslationTimer.OnTimer := ZoomTranslationTimerTimer;
  Name := 'View';
  OptionsFormClass := TVis2D_ViewSettingsFrm;
end;

destructor TView2D.Destroy;
begin
  FreeAndNil(FZoomTranslationTimer);
  FreeAndNil(FTranslationTimer);
  inherited;
end;

function TView2D.GetBound(const Index: Integer): Double;
begin
  Result := FBounds[Index]
end;

function TView2D.GetCenter: TPointD;
begin
  Result.X := XMin + XSpan / 2;
  Result.Y := YMin + YSpan / 2;
end;

function TView2D.IsNormalized: Boolean;
begin
  Result :=
    Assigned(FCtl)
      and
    FCtl.HandleAllocated
      and
    (FCtl.ClientWidth > 0)
      and
    (FCtl.ClientHeight > 0)
      and
    (xspan > 0)
      and
    (yspan > 0)
      and
    SameValue(xspan / yspan, FCtl.ClientWidth / FCtl.ClientHeight);
end;

function TView2D.MaxDistFromZero: Double;
begin
  Result := MaxValue(
    [
      Hypot(XMin, YMin),
      Hypot(XMax, YMin),
      Hypot(XMax, YMax),
      Hypot(XMin, YMax)
    ]
  );
end;

function TView2D.MinDistFromZero: Double;
begin
  if (Sign(XMin) <> Sign(XMax)) and (Sign(YMin) <> Sign(YMax)) then
    Result := 0.0
  else if Sign(XMin) <> Sign(XMax) then
    Result := Min(Abs(YMin), Abs(YMax))
  else if Sign(YMin) <> Sign(YMax) then
    Result := Min(Abs(XMin), Abs(XMax))
  else
    Result := MinValue(
      [
        Hypot(XMin, YMin),
        Hypot(XMax, YMin),
        Hypot(XMax, YMax),
        Hypot(XMin, YMax)
      ]
    );
end;

procedure TView2D.Normalize(AFlexibleAxis: TCartesianAxis);
var
  CP: TPointD;
  D: Double;
begin
  if FCtl = nil then
    Exit;
  if not FCtl.HandleAllocated then
    Exit;
  if (FCtl.ClientHeight < 8) or (FCtl.ClientWidth < 8) then
    Exit;
  CP := CenterPoint;
  case AFlexibleAxis of
    TCartesianAxis.X:
      begin
        D := YSpan * FCtl.ClientWidth / FCtl.ClientHeight / 2;
        SetX(CP.X - D, CP.X + D);
      end;
    TCartesianAxis.Y:
      begin
        D := XSpan * FCtl.ClientHeight / FCtl.ClientWidth / 2;
        SetY(CP.Y - D, CP.Y + D);
      end;
  end;
end;

function TView2D.RestoreInitial: Boolean;
begin
  Result := FFirstViewSet;
  if Result then
  begin
    FBounds := FFirstView;
    Changed;
  end;
end;

procedure TView2D.SetBound(const Index: Integer; const Value: Double);
begin
  if FBounds[Index] <> Value then
  begin
    FBounds[Index] := Value;
    Changed;
  end
end;

procedure TView2D.SetCenter(const Value: TPointD);
var
  xsd2, ysd2: Double;
begin
  xsd2 := XSpan / 2;
  ysd2 := YSpan / 2;
  &Set(
    Value.X - xsd2,
    Value.X + xsd2,
    Value.Y - ysd2,
    Value.Y + ysd2
  );
end;

procedure TView2D.SetX(const AFrom, ATo: Double);
begin
  if (FBounds[_xmin] <> AFrom) or (FBounds[_xmax] <> ATo) then
  begin
    FBounds[_xmin] := AFrom;
    FBounds[_xmax] := ATo;
    Changed;
  end;
end;

procedure TView2D.SetY(const AFrom, ATo: Double);
begin
  if (FBounds[_ymin] <> AFrom) or (FBounds[_ymax] <> ATo) then
  begin
    FBounds[_ymin] := AFrom;
    FBounds[_ymax] := ATo;
    Changed;
  end;
end;

function TView2D.TopLeft: TPointD;
begin
  Result := TPointD.Create(XMin, YMin);
end;

procedure TView2D.TranslationTimerTimer(Sender: TObject);
var
  f: Double;
  i: Integer;
  mt: Integer;
begin
  if CompareTime(Now, FTranslationAnimationEnd) = GreaterThanValue then
    FTranslationTimer.Enabled := False;
  f :=
    EnsureRange(
      MilliSecondsBetween(FTranslationAnimationBegin, Now) /
        MilliSecondsBetween(FTranslationAnimationBegin, FTranslationAnimationEnd),
      0,
      1
    );
  i := EnsureRange(
    Round(f * High(FTranslationAnimation)),
    Low(FTranslationAnimation),
    High(FTranslationAnimation)
  );
  CenterPoint := FTranslationAnimation[i];
  if Boolean(FTranslationTimer.Tag) then
  begin
    Mouse.CursorPos := FCtl.ClientToScreen(
      FCtl.DipsToPixels(FCtl.SpaceToCanvas(FTranslationAnimation[High(FTranslationAnimation)]))
    );
    if not FTranslationTimer.Enabled and SystemParametersInfo(SPI_GETMOUSETRAILS, 0, @mt, 0) and (mt > 1) then
    begin
      ShowCursor(False);
      ShowCursor(True);
    end;
  end;
end;

function TView2D.XSpan: Double;
begin
  Result := FBounds[_xmax] - FBounds[_xmin];
end;

function TView2D.YSpan: Double;
begin
  Result := FBounds[_ymax] - FBounds[_ymin];
end;

procedure TView2D.ZoomTranslationTimerTimer(Sender: TObject);
var
  f: Double;
  i: Integer;
begin
  if CompareTime(Now, FTranslationAnimationEnd) = GreaterThanValue then
    FZoomTranslationTimer.Enabled := False;
  f :=
    EnsureRange(
      MilliSecondsBetween(FTranslationAnimationBegin, Now) /
        MilliSecondsBetween(FTranslationAnimationBegin, FTranslationAnimationEnd),
      0,
      1
    );
  i := EnsureRange(
    Round(f * High(FZoomTranslationAnimation)),
    Low(FZoomTranslationAnimation),
    High(FZoomTranslationAnimation)
  );
  with FZoomTranslationAnimation[i] do
    &Set(Left, Right, Top, Bottom);
  if not FZoomTranslationTimer.Enabled and FCtl.AutoNormalize then
    Normalize(TCartesianAxis.X);
end;

{ TDrawable }

class function TDrawable.AllowAutoNormalization: Boolean;
begin
  Result := True;
end;

function TDrawable.amax(ALim: Boolean): Double;
begin
  Result := 0;
end;

function TDrawable.amin(ALim: Boolean): Double;
begin
  Result := 0;
end;

function TDrawable.aspan(ALim: Boolean): Double;
begin
  Result := amax(ALim) - amin(ALim);
end;

function TDrawable.AxisScrPoint(const A: Double; D, D2: Integer): TPointD;
begin
  Result := TPoint.Zero;
end;

function TDrawable.AxisSvgPoint(AViewBox: TViewBox; const A, D, D2: Double): TPointD;
begin
  Result := TPoint.Zero;
end;

function TDrawable.Canvas: TDirect2DCanvas;
begin
  Result := FCtl.Canvas;
end;

function TDrawable.CanvasRect: TRect;
begin
  Result := FCtl.CanvasRect;
end;

procedure TDrawable.Changed(Sender: TObject);
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

class constructor TDrawable.ClassCreate;
begin
  FInstances := TDictionary<TGUID, TDrawable>.Create;
  FInstances.OnKeyNotify := InstanceListChanged;
end;

class destructor TDrawable.ClassDestroy;
begin
  FreeAndNil(FInstances);
end;

procedure TDrawable.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'title' then
      Title := V.ToString
    else if S = 'description' then
      Description := V.ToString
    else if S = 'windowwidth' then
      FCtl.SetWindowWidth(V.ToInt32)
    else if S = 'windowheight' then
      FCtl.SetWindowHeight(V.ToInt32)
    else if S = 'autonormalize' then
      FCtl.AutoNormalize := V.ToBoolean
    else if S = 'detached' then
      FCtl.SetDetached(V.ToBoolean)
  end;
end;

constructor TDrawable.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  FVisible := True;
  FCtl := ACtl;
  FView := AView;
  if Succeeded(CreateGUID(FGUID)) and Assigned(FInstances) then
    FInstances.Add(FGUID, Self);
end;

function TDrawable.CreateReference: TAlgosimReference;
begin
  Result := TAlgosimReference.CreateWithValue(FGUID);
end;

procedure TDrawable.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

destructor TDrawable.Destroy;
begin
  if Assigned(FInstances) then
    FInstances.Remove(FGUID);
  inherited;
end;

function TDrawable.Direction(const Angle: Double): TPointD;
var
  S, C: Double;
begin
  SinCos(Angle, S, C);
  Result := TPointD.Create(C, S);
end;

procedure TDrawable.Draw;
begin

end;

procedure TDrawable.DrawDisk(const P: TPointD; const R: Double);
var
  Ellipse: TD2D1Ellipse;
begin
  Ellipse := D2D1Ellipse(P, R, R);
  Canvas.FillEllipse(Ellipse);
  Canvas.DrawEllipse(Ellipse);
end;

procedure TDrawable.DrawDiskSp(const P: TPointD; const R: Double);
var
  Ellipse: TD2D1Ellipse;
begin
  Ellipse := D2D1Ellipse(FCtl.SpaceToCanvas(P), FView.ScaleX(R), FView.ScaleY(R));
  Canvas.FillEllipse(Ellipse);
  Canvas.DrawEllipse(Ellipse);
end;

procedure TDrawable.DrawDiskSpPx(const P: TPointD; const R: Double);
begin
  if Math.IsNan(P.X) or Math.IsNan(P.Y) then
    Exit;
  var Ellipse := D2D1Ellipse(FCtl.SpaceToCanvas(P), R, R);
  Canvas.FillEllipse(Ellipse);
  Canvas.DrawEllipse(Ellipse);
end;

procedure TDrawable.DrawEllipse(const R: TRectD);
var
  RR: TRect;
begin
  if R.TryToInt(RR) then
    Canvas.Ellipse(RR);
end;

procedure TDrawable.DrawEllipseSp(const R: TRectD);
begin
  DrawEllipse(FCtl.SpaceToCanvas(R));
end;

procedure TDrawable.DrawLine(const A, B: TPointD);
var
  PA, PB: TPoint;
begin
  if A.TryToInt(PA) and B.TryToInt(PB) then
  begin
    Canvas.MoveTo(PA.X, PA.Y);
    Canvas.LineTo(PB.X, PB.Y);
  end;
end;

procedure TDrawable.DrawLineEndMarker(AMarker: TLineEndMarker; AFilled: Boolean;
  const P: TPointD; const ASizeX, ASizeY, AAngle: Double);
var
  D2D1Point: TD2D1Point2F;
  TransformedMarker: ID2D1TransformedGeometry;
begin

  if AMarker = lemNone then
    Exit;

  if not FCtl.TrySpaceToD2d1(P, D2D1Point) then
    Exit;

  var LAngle: Single := -90 + 180*AAngle/Pi;

  if Succeeded(D2DFactory.CreateTransformedGeometry(
    FCtl.FLineEndMarkers[AMarker],
    TD2DMatrix3x2F.Scale(ASizeX, ASizeY, D2d1Origin)
      *
    TD2DMatrix3x2F.Rotation(LAngle, D2d1Origin)
      *
    TD2DMatrix3x2F.Translation(D2D1Point),
    TransformedMarker
  )) then
    if AFilled and AMarker.IsFilled then
      Canvas.FillGeometry(TransformedMarker)
    else
      Canvas.DrawGeometry(TransformedMarker);

end;

procedure TDrawable.DrawLineEndMarkerSp(AMarker: TLineEndMarker; AFilled: Boolean;
  const P: TPointD; const ASizeX, ASizeY, AAngle: Double);
begin
  DrawLineEndMarker(AMarker, AFilled, FCtl.SpaceToCanvas(P), ASizeX, ASizeY, AAngle);
end;

procedure TDrawable.DrawLineSp(const A, B: TPointD);
begin
  DrawLine(FCtl.SpaceToCanvas(A), FCtl.SpaceToCanvas(B));
end;

procedure TDrawable.DrawRect(const ARect: TRectD);
var
  RR: TRect;
begin
  if ARect.TryToInt(RR) then
    Canvas.Rectangle(RR);
end;

procedure TDrawable.DrawRect(const ARect: TRectD; const ARotAngle: Double);
var
  RR: TRect;
begin
  if ARect.TryToInt(RR) then
  begin
    Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Rotation(-180*ARotAngle/Pi, RR.TopLeft));
    try
      Canvas.Rectangle(RR);
    finally
      Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
    end;
  end;
end;

procedure TDrawable.DrawRectSp(const ARect: TRectD; const ARotAngle: Double);
begin
  DrawRect(FCtl.SpaceToCanvas(ARect), ARotAngle);
end;

procedure TDrawable.DrawTo(ASVG: TSVGBuilder_VisCtl2D);
begin
  DrawToPrefix(ASVG);
  DrawToContent(ASVG);
  DrawToSuffix(ASVG);
end;

procedure TDrawable.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

end;

procedure TDrawable.DrawToPrefix(ASVG: TSVGBuilder_VisCtl2D);
begin

end;

procedure TDrawable.DrawToSuffix(ASVG: TSVGBuilder_VisCtl2D);
begin

end;

procedure TDrawable.DrawRectSp(const ARect: TRectD);
begin
  DrawRect(FCtl.SpaceToCanvas(ARect));
end;

function TDrawable.FirstScrPoint(const A: Double; D, D2: Integer): TPointD;
begin
  Result := TPoint.Zero;
end;

procedure TDrawable.FreeDeviceResources;
begin

end;

class function TDrawable.GetRealm: string;
begin
  Result := 'ℝ²';
end;

class procedure TDrawable.InstanceListChanged(Sender: TObject;
  const Item: TGUID; Action: TCollectionNotification);
begin
  if Assigned(VisObjListChanged) then
    VisObjListChanged(Sender);
end;

function TDrawable.LastScrPoint(const A: Double; D, D2: Integer): TPointD;
begin
  Result := TPoint.Zero;
end;

function TDrawable.AxP(const A, B: Double): TPointD;
begin
  Result.X := A;
  Result.Y := B;
end;

function TDrawable.AxPScr(const A, B: Double): TPointD;
begin
  Result := FCtl.SpaceToCanvas(AxP(A, B));
end;

procedure TDrawable.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TDrawable.ShowOptionsForm(AParent: TCustomForm);
var
  LOptionsFrm: TDrawableOptionsFrm;
begin
  if Assigned(OptionsFormClass) then
  begin
    if AParent = nil then
      AParent := GetParentFormSafe(FCtl);
    LOptionsFrm := OptionsFormClass.Create(AParent, Self);
    try
      Inc(FModalLevel);
      try
        LOptionsFrm.ShowModal;
      finally
        Dec(FModalLevel);
      end;
    finally
      LOptionsFrm.Free;
    end;
  end
  else
    ShowMessage('This object has no configurable properties.');
end;

function TDrawable.SizePrimary(const S: TSize): Integer;
begin
  Result := 0;
end;

function TDrawable.SizeSecondary(const S: TSize): Integer;
begin
  Result := 0;
end;

procedure TDrawable.TextOut(const X, Y: Double; const Text: string);
begin
  if
    InRange(X, Integer.MinValue, Integer.MaxValue)
      and
    InRange(Y, Integer.MinValue, Integer.MaxValue)
  then
    Canvas.TextOut(Round(X), Round(Y), Text);
end;

class function TDrawable.TryGetDrawableByGUID(const AGUID: TGUID;
  out ADrawable: TDrawable): Boolean;
begin
  Result := Assigned(FInstances) and FInstances.TryGetValue(AGUID, ADrawable);
end;

{ TDiagram }

constructor TDiagram.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  Name := 'Diagram';
  OptionsFormClass := TVisCtlOptionsFrm;
end;

function TDiagram.CreateReference: TAlgosimReference;
begin
  Result := inherited;
  Result.AddSubref('axes', FCtl.Axes.CreateReference);
  Result.AddSubref('grids', FCtl.GridLines.CreateReference);
  Result.AddSubref('view', FCtl.View.CreateReference);
  Result.AddSubref('objects', FCtl.ObjectMgr.CreateReference);
end;

{ TAxis }

procedure TAxis.Assign(Source: TPersistent);
begin
  if Source is TAxis then
  begin
    FAutomatic := TAxis(Source).FAutomatic;
    FVisible := TAxis(Source).FVisible;
    FColor := TAxis(Source).FColor;
    FWidth := TAxis(Source).FWidth;
    FMin := TAxis(Source).FMin;
    FMax := TAxis(Source).FMax;
    FTickDistance := TAxis(Source).FTickDistance;
    FTickLength := TAxis(Source).FTickLength;
    FTickWidth := TAxis(Source).FTickWidth;
    FTickColor := TAxis(Source).FTickColor;
    FTickSide := TAxis(Source).FTickSide;
    FTicksVisible := TAxis(Source).FTicksVisible;
    FNumberDistance := TAxis(Source).FNumberDistance;
    FNumberUnitValue := TAxis(Source).FNumberUnitValue;
    FNumberUnitSymbol := TAxis(Source).FNumberUnitSymbol;
    FNumberFormat := TAxis(Source).FNumberFormat;
    FNumberFont.Assign(TAxis(Source).FNumberFont);
    FNumbersVisible := TAxis(Source).FNumbersVisible;
    Changed;
  end
  else
    inherited;
end;

function TAxis.AxSpan: Double;
begin
  Result := AxMax - AxMin;
end;

procedure TAxis.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'automatic' then
      Automatic := V.ToBoolean
    else if S = 'color' then
      Color := V.ToColor
    else if S = 'axmin' then
      AxMin := V.ToRealNumber
    else if S = 'axmax' then
      AxMax := V.ToRealNumber
    else if S = 'numberdistance' then
      NumberDistance := V.ToRealNumber
    else if S = 'numberformat' then
      NumberFormat := V.ToString
    else if S = 'numberunitsymbol' then
      NumberUnitSymbol := V.ToString
    else if S = 'numberunitvalue' then
      NumberUnitValue := V.ToRealNumber
    else if S = 'numbersvisible' then
      NumbersVisible := V.ToBoolean
    else if S = 'position' then
      Position := V.ToRealNumber
    else if S = 'width' then
      Width := V.ToInt32
    else if S = 'textoffset' then
      TextOffset := V.ToInt32
    else if S = 'tickdistance' then
      TickDistance := V.ToRealNumber
    else if S = 'ticklength' then
      TickLength := V.ToInt32
    else if S = 'tickwidth' then
      TickWidth := V.ToInt32
    else if S = 'tickcolor' then
      TickColor := V.ToColor
    else if S = 'ticksvisible' then
      TicksVisible := V.ToBoolean
    else if S = 'visible' then
      Visible := V.ToBoolean
  end;
end;

constructor TAxis.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FNumberFont := TFont.Create;
  FNumberFont.OnChange := Changed;
  FTextFont := TFont.Create;
  FTextFont.OnChange := Changed;
  FTextOffset := DefaultTextOffset;
  FAutomatic := DefaultAutomatic;
  FColor := DefaultColor;
  FWidth := DefaultWidth;
  FTickDistance := DefaultTickDistance;
  FTickLength := DefaultTickLength;
  FTickWidth := DefaultTickWidth;
  FTickColor := DefaultTickColor;
  FTickSide := DefaultTickSide;
  FTicksVisible := DefaultTicksVisible;
  FNumberDistance := DefaultNumberDistance;
  FNumberUnitValue := DefaultNumberUnitValue;
  FNumberUnitSymbol := DefaultNumberUnitSymbol;
  FNumberFormat := DefaultNumberFormat;
  FNumbersVisible := DefaultNumbersVisible;
  FVisible := DefaultVisible;
  Name := 'Axis';
  OptionsFormClass := TVis2D_AxisSettingsFrm;
end;

destructor TAxis.Destroy;
begin
  FreeAndNil(FTextFont);
  FreeAndNil(FNumberFont);
  inherited;
end;

procedure TAxis.Draw;
var
  a: Double;
  S: string;
  Sz: TSize;
  P: TPointD;
  M: Integer;
  LNumDecimals: Integer;
  LTickDistance,
  LNumberDistance: Double;
  LExp: Boolean;
  LMinDist: Double;
  LWhileGuard: Integer;
begin

  if not Visible then
    Exit;

  if aspan <= 0 then
    Exit;

  if CanvasRect.IsEmpty then
    Exit;

  Canvas.Pen.Color := Color;
  Canvas.Pen.Width := idfcn(Width);
  Canvas.Pen.Style := psSolid;

  if Automatic then
  begin
    LNumberDistance := IntPower(10, Round(Log10(aspan / 10)));
    LTickDistance := LNumberDistance;
    if aspan / LNumberDistance < 5 then
    begin
      LNumberDistance := LNumberDistance / 2;
      LTickDistance := LNumberDistance;
    end
    else if aspan / LNumberDistance > 15 then
      LNumberDistance := LNumberDistance * 2;
  end
  else
  begin
    LTickDistance := TickDistance;
    LNumberDistance := NumberDistance;
  end;

  DrawLine(AxisScrPoint(amin(True)), AxisScrPoint(amax(True)));

  if TicksVisible and (LTickDistance > 0) and (aspan / LTickDistance < 1000) then
  begin
    a := amin(True) - rmod2(amin(True), LTickDistance);
    Canvas.Pen.Color := TickColor;
    Canvas.Pen.Width := idfcn(TickWidth);
    Canvas.Pen.Style := psSolid;
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 1000) do
    begin
      DrawLine(
        AxisScrPoint(a, -IfThen(TickSide <> tsPositive, idfcn(TickLength))),
        AxisScrPoint(a, IfThen(TickSide <> tsNegative, idfcn(TickLength)))
      );
      a := a + LTickDistance;
      Inc(LWhileGuard);
    end;
  end;

  FNumberWidth := 0;
  if NumbersVisible and (LNumberDistance > 0) and (aspan / LNumberDistance < 1000) then
  begin
    Canvas.Font.Assign(NumberFont);
    Canvas.Font.PixelsPerInch := 96;
    Canvas.Font.Size := idfcn(NumberFont.Size);
    Canvas.Brush.Style := bsClear;
    M := SizePrimary(Canvas.TextExtent('500000'));
    if Automatic and (aspan / LNumberDistance * M > SizePrimary(CanvasRect.Size)) then
    begin
      LMinDist := 1.2 * aspan * M / SizePrimary(CanvasRect.Size);
      LNumberDistance := LMinDist;
      LNumberDistance := IntPower(10, Ceil(Log10(LNumberDistance)));
      if LNumberDistance / 5 > LMinDist then
        LNumberDistance := LNumberDistance / 5
      else if LNumberDistance / 2 > LMinDist then
        LNumberDistance := LNumberDistance / 2
    end;
    LNumDecimals := Max(0, Max(-Floor(Log10(LNumberDistance)), Ceil(-Log10(aspan/4))));
    if not IsZero(amin) and not IsZero(amax) then
      LExp := not InRange(Max(Log10(Abs(amin)), Log10(Abs(amax))), -4, 7)
    else if not IsZero(amin) then
      LExp := not InRange(Log10(Abs(amin)), -4, 7)
    else
      LExp := not InRange(Log10(Abs(amax)), -4, 7);
    a := amin(True) - rmod2(amin(True), LNumberDistance);
    M := Canvas.TextWidth(MINUS_SIGN) div 2;
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 1000) do
    begin
      if Abs(a) > Max(Abs(amin), Abs(amax))/10000 then
      begin
        if NumberFormat.IsEmpty then
          if LExp then
            S := FloatToStrF(a, ffExponent, 2, 0, FCtl.InvFS)
          else
            S := FloatToStrF(a, ffFixed, 8, LNumDecimals, FCtl.InvFS)
        else
          S := FormatFloat(NumberFormat, a, FCtl.InvFS);
        S := S.Replace(HYPHEN_MINUS, MINUS_SIGN, [rfReplaceAll]);
        Sz := Canvas.TextExtent(S);
        FNumberWidth := Max(FNumberWidth, SizeSecondary(Sz));
        P := AxisScrPoint(
          a,
          -TickLength - idfcn(2) - Ord(FVertFlag) * SizeSecondary(Sz),
          -SizePrimary(Sz) div 2
        );
        if not FVertFlag and (a < 0) then
          P.X := P.X - M;
        TextOut(P.X, P.Y, S);
      end;
      a := a + LNumberDistance;
      Inc(LWhileGuard);
    end;
  end;

end;

procedure TAxis.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  a: Double;
  S: string;
  Sz: TSize;
  P: TPointD;
  M: Integer;
  LNumDecimals: Integer;
  LTickDistance,
  LNumberDistance: Double;
  LExp: Boolean;
  LMinDist: Double;
  LWhileGuard: Integer;
begin

  inherited;

  if not Visible then
    Exit;

  if aspan <= 0 then
    Exit;

  if CanvasRect.IsEmpty then
    Exit;

  if Automatic then
  begin
    LNumberDistance := IntPower(10, Round(Log10(aspan / 10)));
    LTickDistance := LNumberDistance;
    if aspan / LNumberDistance < 5 then
    begin
      LNumberDistance := LNumberDistance / 2;
      LTickDistance := LNumberDistance;
    end
    else if aspan / LNumberDistance > 15 then
      LNumberDistance := LNumberDistance * 2;
  end
  else
  begin
    LTickDistance := TickDistance;
    LNumberDistance := NumberDistance;
  end;

  ASVG
    .Line(
      AxisSvgPoint(ASVG.ViewBox, amin(True)),
      AxisSvgPoint(ASVG.ViewBox, amax(True)))
    .Stroke(Color)
    .StrokeWidthPx(Width)
    .Append;

  if TicksVisible and (LTickDistance > 0) and (aspan / LTickDistance < 1000) then
  begin
    ASVG.BeginGroup
      .&Class('ticks')
      .Stroke(TickColor)
      .StrokeWidthPx(TickWidth)
      .Append;
    a := amin(True) - rmod2(amin(True), LTickDistance);
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 1000) do
    begin
      ASVG
        .Line(
          AxisSvgPoint(ASVG.ViewBox, a, -IfThen(TickSide <> tsPositive, TickLength)),
          AxisSvgPoint(ASVG.ViewBox, a, IfThen(TickSide <> tsNegative, TickLength)))
        .Append;
      a := a + LTickDistance;
      Inc(LWhileGuard);
    end;
    ASVG.EndGroup.Append;
  end;

  FNumberWidth := 0;
  if NumbersVisible and (LNumberDistance > 0) and (aspan / LNumberDistance < 1000) then
  begin
    ASVG.BeginGroup
      .&Class('axis-labels')
      .Font(NumberFont)
      .TextAnchor(TAlignment(IfThen(FVertFlag, Ord(taRightJustify), Ord(taCenter))))
      .AttribIf('dominant-baseline', 'central', FVertFlag)
      .AttribIf('dominant-baseline', 'text-before-edge', not FVertFlag)
      .Append;
    Canvas.Font.Assign(NumberFont);
    Canvas.Brush.Style := bsClear;
    M := SizePrimary(Canvas.TextExtent('500000'));
    if Automatic and (aspan / LNumberDistance * M > SizePrimary(CanvasRect.Size)) then
    begin
      LMinDist := 1.2 * aspan * M / SizePrimary(CanvasRect.Size);
      LNumberDistance := LMinDist;
      LNumberDistance := IntPower(10, Ceil(Log10(LNumberDistance)));
      if LNumberDistance / 5 > LMinDist then
        LNumberDistance := LNumberDistance / 5
      else if LNumberDistance / 2 > LMinDist then
        LNumberDistance := LNumberDistance / 2
    end;
    LNumDecimals := Max(0, Max(-Floor(Log10(LNumberDistance)), Ceil(-Log10(aspan/4))));
    if not IsZero(amin) and not IsZero(amax) then
      LExp := not InRange(Max(Log10(Abs(amin)), Log10(Abs(amax))), -4, 7)
    else if not IsZero(amin) then
      LExp := not InRange(Log10(Abs(amin)), -4, 7)
    else
      LExp := not InRange(Log10(Abs(amax)), -4, 7);
    a := amin(True) - rmod2(amin(True), LNumberDistance);
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 1000) do
    begin
      if Abs(a) > Max(Abs(amin), Abs(amax))/10000 then
      begin
        if NumberFormat.IsEmpty then
          if LExp then
            S := FloatToStrF(a, ffExponent, 2, 0, FCtl.InvFS)
          else
            S := FloatToStrF(a, ffFixed, 8, LNumDecimals, FCtl.InvFS)
        else
          S := FormatFloat(NumberFormat, a, FCtl.InvFS);
        S := S.Replace(HYPHEN_MINUS, MINUS_SIGN, [rfReplaceAll]);
        Sz := Canvas.TextExtent(S);
        FNumberWidth := Max(FNumberWidth, SizeSecondary(Sz));
        P := AxisSvgPoint(
          ASVG.ViewBox,
          a,
          -TickLength - 2
        );
        ASVG
          .Text(P, S)
          .AttribIf('class', 'neg', a < 0)
          .AttribIf('class', 'zero', a = 0)
          .Append;
      end;
      a := a + LNumberDistance;
      Inc(LWhileGuard);
    end;
    ASVG.EndGroup.Append;
  end;

end;

procedure TAxis.DrawToPrefix(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  if not Visible then
    Exit;

  if aspan <= 0 then
    Exit;

  if CanvasRect.IsEmpty then
    Exit;

  ASVG
    .BeginGroup
    .&Class('axis')
    .&Class(Name)
    .Append('axis');

end;

procedure TAxis.DrawToSuffix(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  if ASVG.Undefine('axis') then
    ASVG.EndGroup.Append;

end;

function TAxis.Limited: Boolean;
begin
  Result := (FMin <> 0.0) or (FMax <> 0.0);
end;

procedure TAxis.SetAutomatic(const Value: Boolean);
begin
  if FAutomatic <> Value then
  begin
    FAutomatic := Value;
    Changed;
  end;
end;

procedure TAxis.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

procedure TAxis.SetMax(const Value: Double);
begin
  if FMax <> Value then
  begin
    FMax := Value;
    Changed;
  end;
end;

procedure TAxis.SetMin(const Value: Double);
begin
  if FMin <> Value then
  begin
    FMin := Value;
    Changed;
  end;
end;

procedure TAxis.SetNumberDistance(const Value: Double);
begin
  if FNumberDistance <> Value then
  begin
    FNumberDistance := Value;
    Changed;
  end;
end;

procedure TAxis.SetNumberFont(const Value: TFont);
begin
  FNumberFont.Assign(Value);
end;

procedure TAxis.SetNumberFormat(const Value: string);
begin
  if FNumberFormat <> Value then
  begin
    FNumberFormat := Value;
    Changed;
  end;
end;

procedure TAxis.SetNumbersVisible(const Value: Boolean);
begin
  if FNumbersVisible <> Value then
  begin
    FNumbersVisible := Value;
    Changed;
  end;
end;

procedure TAxis.SetNumberUnitSymbol(const Value: string);
begin
  if FNumberUnitSymbol <> Value then
  begin
    FNumberUnitSymbol := Value;
    Changed;
  end;
end;

procedure TAxis.SetNumberUnitValue(const Value: Double);
begin
  if FNumberUnitValue <> Value then
  begin
    FNumberUnitValue := Value;
    Changed;
  end;
end;

procedure TAxis.SetPosition(const Value: Double);
begin
  if FAxisPosition <> Value then
  begin
    FAxisPosition := Value;
    Changed;
  end;
end;

procedure TAxis.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Changed;
  end;
end;

procedure TAxis.SetTextFont(const Value: TFont);
begin
  FTextFont.Assign(Value);
end;

procedure TAxis.SetTextOffset(const Value: Integer);
begin
  if FTextOffset <> Value then
  begin
    FTextOffset := Value;
    Changed;
  end;
end;

procedure TAxis.SetTickColor(const Value: TColor);
begin
  if FTickColor <> Value then
  begin
    FTickColor := Value;
    Changed;
  end;
end;

procedure TAxis.SetTickDistance(const Value: Double);
begin
  if FTickDistance <> Value then
  begin
    FTickDistance := Value;
    Changed;
  end;
end;

procedure TAxis.SetTickLength(const Value: Integer);
begin
  if FTickLength <> Value then
  begin
    FTickLength := Value;
    Changed;
  end;
end;

procedure TAxis.SetTickSide(const Value: TTickSide);
begin
  if FTickSide <> Value then
  begin
    FTickSide := Value;
    Changed;
  end;
end;

procedure TAxis.SetTicksVisible(const Value: Boolean);
begin
  if FTicksVisible <> Value then
  begin
    FTicksVisible := Value;
    Changed;
  end;
end;

procedure TAxis.SetTickWidth(const Value: Integer);
begin
  if FTickWidth <> Value then
  begin
    FTickWidth := Value;
    Changed;
  end;
end;

procedure TAxis.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TAxis.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Changed;
  end;
end;

{ THorizontalAxis }

function THorizontalAxis.amax(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Min(FView.XMax, AxMax)
  else
    Result := FView.XMax;
end;

function THorizontalAxis.amin(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Max(FView.XMin, AxMin)
  else
    Result := FView.XMin
end;

function THorizontalAxis.AxisScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(A, Position);
  Result.X := Result.X + D2;
  Result.Y := Result.Y - D;
end;

function THorizontalAxis.AxisSvgPoint(AViewBox: TViewBox; const A, D, D2: Double): TPointD;
begin
  Result := FCtl.SpaceToViewbox(AViewBox, FCtl.P(A, Position));
  Result.X := Result.X + D2;
  Result.Y := Result.Y - D;
end;

procedure THorizontalAxis.Draw;
var
  P: TPointD;
  Sz: TSize;
begin
  inherited;
  if not Text.IsEmpty then
  begin
    Canvas.Font.Assign(TextFont);
    Canvas.Font.PixelsPerInch := 96;
    Canvas.Font.Size := idfcn(TextFont.Size);
    Canvas.Brush.Style := bsClear;
    Sz := Canvas.TextExtent(Text);
    if Limited then
      P := FCtl.SpaceToCanvas(
        AxMin + AxSpan / 2,
        0,
        -Sz.cx div 2,
        FNumberWidth + TextOffset
      )
    else
      P := FCtl.SpaceToCanvas(
        amin + aspan / 2,
        0,
        -Sz.cx div 2,
        FNumberWidth + TextOffset
      );
    TextOut(P.X, P.Y, Text);
  end;
end;

procedure THorizontalAxis.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  P: TPointD;
begin

  inherited;

  if not Text.IsEmpty then
  begin

    if Limited then
      P := FCtl.SpaceToViewbox(
        ASVG.ViewBox,
        FCtl.P(AxMin + AxSpan / 2, 0),
        0,
        FNumberWidth + TextOffset
      )
    else
      P := FCtl.SpaceToViewbox(
        ASVG.ViewBox,
        FCtl.P(amin + aspan / 2, 0),
        0,
        FNumberWidth + TextOffset
      );

    ASVG
      .Text(P, Text)
      .&Class('axis-text')
      .TextAnchor(taCenter)
      .DominantBaseline(taAlignTop)
      .Font(TextFont)
      .Append;

  end;

end;

function THorizontalAxis.FirstScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(A, 0);
  Result.Y := 0;
end;

function THorizontalAxis.LastScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(A, 0);
  Result.Y := FCtl.CanvasRect.Height;
end;

function THorizontalAxis.SizePrimary(const S: TSize): Integer;
begin
  Result := S.cx;
end;

function THorizontalAxis.SizeSecondary(const S: TSize): Integer;
begin
  Result := S.cy;
end;

{ TVerticalAxis }

function TVerticalAxis.amax(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Min(FView.YMax, AxMax)
  else
    Result := FView.YMax;
end;

function TVerticalAxis.amin(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Max(FView.YMin, AxMin)
  else
    Result := FView.YMin;
end;

function TVerticalAxis.AxisScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(Position, A);
  Result.X := Result.X + D;
  Result.Y := Result.Y + D2;
end;

function TVerticalAxis.AxisSvgPoint(AViewBox: TViewBox; const A, D, D2: Double): TPointD;
begin
  Result := FCtl.SpaceToViewbox(AViewBox, FCtl.P(Position, A));
  Result.X := Result.X + D;
  Result.Y := Result.Y + D2;
end;

function TVerticalAxis.AxP(const A, B: Double): TPointD;
begin
  Result := TPointD.Create(B, A);
end;

procedure TVerticalAxis.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'rotatetext' then
      RotateAxisText := V.ToBoolean
  end;
end;

constructor TVerticalAxis.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FVertFlag := True;
end;

procedure TVerticalAxis.Draw;
var
  P: TPointD;
  Sz: TSize;
begin
  inherited;
  if not Text.IsEmpty then
  begin
    Canvas.Font.Assign(TextFont);
    Canvas.Font.PixelsPerInch := 96;
    Canvas.Font.Size := idfcn(TextFont.Size);
    Canvas.Brush.Style := bsClear;
    Sz := Canvas.TextExtent(Text);
    if Limited then
      P := FCtl.SpaceToCanvas(
        0,
        AxMin + AxSpan / 2,
        -(FNumberWidth + TextOffset),
        0
      )
    else
      P := FCtl.SpaceToCanvas(
        0,
        amin + aspan / 2,
        -(FNumberWidth + TextOffset),
        0
      );
    if FRotateAxisText then
    begin
      Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Rotation(-90, P));
      try
        TextOut(P.X - Sz.cx / 2, P.Y - Sz.cy, Text);
      finally
        Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
      end;
    end
    else
      TextOut(P.X - Sz.cx, P.Y - Sz.cy / 2, Text);
  end;
end;

procedure TVerticalAxis.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  P: TPointD;
begin

  inherited;

  if not Text.IsEmpty then
  begin

    if Limited then
      P := FCtl.SpaceToViewbox(
        ASVG.ViewBox,
        FCtl.P(0, AxMin + AxSpan / 2),
        -(FNumberWidth + TextOffset)
      )
    else
      P := FCtl.SpaceToViewbox(
        ASVG.ViewBox,
        FCtl.P(0, amin + aspan / 2),
        -(FNumberWidth + TextOffset)
      );

    if FRotateAxisText then
      ASVG
        .Text(P, Text)
        .&Class('axis-text')
        .TextAnchor(taCenter)
        .Font(TextFont)
        .Transform(RotationDeg(-90, P.X, P.Y))
        .Append
    else
      ASVG
        .Text(P, Text)
        .&Class('axis-text')
        .TextAnchor(taRightJustify)
        .DominantBaseline(taVerticalCenter)
        .Font(TextFont)
        .Append;

  end;

end;

function TVerticalAxis.FirstScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(0, A);
  Result.X := 0;
end;

function TVerticalAxis.LastScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(0, A);
  Result.X := FView.FCtl.CanvasRect.Width;
end;

procedure TVerticalAxis.SetRotateAxisText(const Value: Boolean);
begin
  if FRotateAxisText <> Value then
  begin
    FRotateAxisText := Value;
    Changed;
  end;
end;

function TVerticalAxis.SizePrimary(const S: TSize): Integer;
begin
  Result := S.cy;
end;

function TVerticalAxis.SizeSecondary(const S: TSize): Integer;
begin
  Result := S.cx;
end;

{ TAxes }

procedure TAxes.Assign(Source: TPersistent);
begin
  if Source is TAxes then
  begin
    FX.Assign(TAxes(Source).FX);
    FY.Assign(TAxes(Source).FY);
  end
  else if Source is TAxis then
  begin
    FX.Assign(TAxis(Source));
    FY.Assign(TAxis(Source));
  end
  else
    inherited;
end;

constructor TAxes.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FX := THorizontalAxis.Create(ACtl, AView);
  FX.Name := 'X axis';
  FX.OnChange := Changed;
  FY := TVerticalAxis.Create(ACtl, AView);
  FY.Name := 'Y axis';
  FY.OnChange := Changed;
  Name := 'Axes';
  OptionsFormClass := TVis2D_AxesSettingsFrm;
end;

function TAxes.CreateReference: TAlgosimReference;
begin
  Result := inherited;
  Result.AddSubref('x', FX.CreateReference);
  Result.AddSubref('y', FY.CreateReference);
end;

destructor TAxes.Destroy;
begin
  FreeAndNil(FY);
  FreeAndNil(FX);
  inherited;
end;

procedure TAxes.Draw;
begin
  FX.Draw;
  FY.Draw;
end;

procedure TAxes.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin
  FX.DrawTo(ASVG);
  FY.DrawTo(ASVG);
end;

procedure TAxes.SetX(const Value: THorizontalAxis);
begin
  FX.Assign(Value);
end;

procedure TAxes.SetY(const Value: TVerticalAxis);
begin
  FY.Assign(Value);
end;

{ TGridLineFamily }

procedure TGridLineFamily.Assign(Source: TPersistent);
begin
  if Source is TGridLineFamily then
  begin
    FMin := TGridLineFamily(Source).FMin;
    FMax := TGridLineFamily(Source).FMax;
    FDistance := TGridLineFamily(Source).FDistance;
    FVisible := TGridLineFamily(Source).FVisible;
    FWidth := TGridLineFamily(Source).FWidth;
    FColor := TGridLineFamily(Source).FColor;
    FPenStyle := TGridLineFamily(Source).FPenStyle;
    Changed;
  end
  else
    inherited;
end;

procedure TGridLineFamily.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'distance' then
      Distance := V.ToRealNumber
    else if S = 'axmin' then
      AxMin := V.ToRealNumber
    else if S = 'axmax' then
      AxMax := V.ToRealNumber
    else if S = 'linestart' then
      LineBegin := V.ToRealNumber
    else if S = 'lineend' then
      LineEnd := V.ToRealNumber
    else if S = 'visible' then
      Visible := V.ToBoolean
    else if S = 'width' then
      Width := V.ToInt32
    else if S = 'color' then
      Color := V.ToColor
  end;
end;

constructor TGridLineFamily.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FDistance := 1.0;
  FVisible := DefaultVisible;
  FWidth := DefaultWidth;
  FColor := DefaultColor;
  FPenStyle := DefaultPenStyle;
  Name := 'Grid lines';
  OptionsFormClass := TVis2D_GridSettingsFrm;
end;

procedure TGridLineFamily.Draw;
var
  a: Double;
  LWhileGuard: Integer;
begin

  if Visible and (Distance > 0) and (aspan / Distance < 200) then
  begin
    a := amin(True) - rmod2(amin(True), Distance);
    Canvas.Pen.Color := Color;
    Canvas.Pen.Width := idfcn(Width);
    Canvas.Pen.Style := PenStyle;
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 200) do
    begin
      if LineLimited then
        DrawLine(
          AxPScr(a, FBegin),
          AxPScr(a, FEnd)
        )
      else
        DrawLine(
          FirstScrPoint(a),
          LastScrPoint(a)
        );
      a := a + Distance;
      Inc(LWhileGuard);
    end;
  end;

end;

procedure TGridLineFamily.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  a: Double;
  LWhileGuard: Integer;
begin

  inherited;

  if Visible and (Distance > 0) and (aspan / Distance < 200) then
  begin
    ASVG
      .BeginGroup
      .&Class('grid')
      .&Class(Name)
      .Stroke(Color)
      .StrokeWidthPx(Width)
      .Append;
    a := amin(True) - rmod2(amin(True), Distance);
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 200) do
    begin
      if LineLimited then
        ASVG
          .Line(
            AxPScr(a, FBegin),
            AxPScr(a, FEnd)
          )
          .Append
      else
        ASVG
          .Line(
            FirstScrPoint(a),
            LastScrPoint(a)
          )
          .Append;
      a := a + Distance;
      Inc(LWhileGuard);
    end;
    ASVG.EndGroup.Append;
  end;

end;

function TGridLineFamily.Limited: Boolean;
begin
  Result := (FMin <> 0.0) or (FMax <> 0.0);
end;

function TGridLineFamily.LineLimited: Boolean;
begin
  Result := (FBegin <> 0.0) or (FEnd <> 0.0);
end;

procedure TGridLineFamily.SetBegin(const Value: Double);
begin
  if FBegin <> Value then
  begin
    FBegin := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetDistance(const Value: Double);
begin
  if FDistance <> Value then
  begin
    FDistance := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetEnd(const Value: Double);
begin
  if FEnd <> Value then
  begin
    FEnd := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetMax(const Value: Double);
begin
  if FMax <> Value then
  begin
    FMax := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetMin(const Value: Double);
begin
  if FMin <> Value then
  begin
    FMin := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetPenStyle(const Value: TPenStyle);
begin
  // Drawing non-solid lines in Direct2D is *extremely* (surprisingly, exceedingly, ridiculously, unbelievably, etc.) slow
  if FPenStyle <> psSolid then
  begin
    FPenStyle := psSolid;
    Changed;
  end;
end;

procedure TGridLineFamily.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TGridLineFamily.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Changed;
  end;
end;

{ THorizontalGridLineFamily }

function THorizontalGridLineFamily.amax(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Min(FView.YMax, AxMax)
  else
    Result := FView.YMax;
end;

function THorizontalGridLineFamily.amin(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Max(FView.YMin, AxMin)
  else
    Result := FView.YMin;
end;

function THorizontalGridLineFamily.AxisScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(0, A);
  Result.X := Result.X + D;
  Result.Y := Result.Y + D2;
end;

function THorizontalGridLineFamily.AxP(const A, B: Double): TPointD;
begin
  Result.X := B;
  Result.Y := A;
end;

function THorizontalGridLineFamily.FirstScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(0, A);
  Result.X := 0;
end;

function THorizontalGridLineFamily.LastScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(0, A);
  Result.X := FView.FCtl.CanvasRect.Width;
end;

function THorizontalGridLineFamily.SizePrimary(const S: TSize): Integer;
begin
  Result := S.cy;
end;

function THorizontalGridLineFamily.SizeSecondary(const S: TSize): Integer;
begin
  Result := S.cx;
end;

{ TVerticalGridLineFamily }

function TVerticalGridLineFamily.amax(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Min(FView.XMax, AxMax)
  else
    Result := FView.XMax;
end;

function TVerticalGridLineFamily.amin(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Max(FView.XMin, AxMin)
  else
    Result := FView.XMin;
end;

function TVerticalGridLineFamily.AxisScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(A, 0);
  Result.X := Result.X + D2;
  Result.Y := Result.Y - D;
end;

function TVerticalGridLineFamily.FirstScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(A, 0);
  Result.Y := 0;
end;

function TVerticalGridLineFamily.LastScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(A, 0);
  Result.Y := FCtl.CanvasRect.Height;
end;

function TVerticalGridLineFamily.SizePrimary(const S: TSize): Integer;
begin
  Result := S.cx;
end;

function TVerticalGridLineFamily.SizeSecondary(const S: TSize): Integer;
begin
  Result := S.cy;
end;

{ TRadialGridLineFamily }

function TRadialGridLineFamily.amax(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Min(Pi, AxMax)
  else
    Result := Pi;
end;

function TRadialGridLineFamily.amin(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Max(-Pi, AxMin)
  else
    Result := -Pi;
end;

function TRadialGridLineFamily.AxP(const A, B: Double): TPointD;
var
  s, c: Double;
begin
  SinCos(A, s, c);
  Result.X := B * c;
  Result.Y := B * s;
end;

function TRadialGridLineFamily.FirstScrPoint(const A: Double; D,
  D2: Integer): TPointD;
begin
  Result := FCtl.Scr(0, 0);
end;

function TRadialGridLineFamily.LastScrPoint(const A: Double; D,
  D2: Integer): TPointD;
var
  s, c: Double;
begin
  SinCos(A, s, c);
  Result := FCtl.SpaceToCanvas(FView.MaxDistFromZero * TPointD.Create(c, s))
end;

{ TCircularGridLineFamily }

function TCircularGridLineFamily.amax(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Min(FView.MaxDistFromZero, AxMax)
  else
    Result := FView.MaxDistFromZero;
end;

function TCircularGridLineFamily.amin(ALim: Boolean): Double;
begin
  if ALim and Limited then
    Result := Max(FView.MinDistFromZero, AxMin)
  else
    Result := FView.MinDistFromZero;
end;

function TCircularGridLineFamily.AxP(const A, B: Double): TPointD;
var
  s, c: Double;
begin
  SinCos(B, s, c);
  Result.X := A * c;
  Result.Y := A * s;
end;

procedure TCircularGridLineFamily.Draw;
var
  a: Double;
  LWhileGuard: Integer;
begin

  if not Visible then
    Exit;

  if LineLimited and (LineEnd <= LineBegin) then
    Exit;

  if Visible and (Distance > 0) and (aspan / Distance < 1000) then
  begin
    a := amin(True) - rmod(amin(True), Distance);
    Canvas.Pen.Color := Color;
    Canvas.Pen.Width := idfcn(Width);
    Canvas.Pen.Style := PenStyle;
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 1000) do
    begin
      if LineLimited then
      begin
        var Geometry: ID2D1PathGeometry;
        var Sink: ID2D1GeometrySink;
        var Arc: TD2D1ArcSegment;
        if Succeeded(D2DFactory.CreatePathGeometry(Geometry)) then
        begin
          FillChar(Arc, SizeOf(Arc), 0);
          Arc.point := AxPScr(a, LineEnd);
          Arc.size := D2D1SizeF(FView.ScaleX(a), FView.ScaleY(a));
          Arc.rotationAngle := 0;
          Arc.sweepDirection := D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE;
          Arc.arcSize := D2D1_ARC_SIZE(Ord(LineEnd - LineBegin > Pi));
          if Succeeded(Geometry.Open(Sink)) then
            try
              Sink.BeginFigure(AxPScr(a, LineBegin), D2D1_FIGURE_BEGIN_HOLLOW);
              try
                Sink.AddArc(Arc);
              finally
                Sink.EndFigure(D2D1_FIGURE_END_OPEN);
              end;
            finally
              Sink.Close;
            end;
          Canvas.RenderTarget.DrawGeometry(Geometry, Canvas.Pen.Brush.Handle, Canvas.Pen.Width, Canvas.Pen.StrokeStyle);
        end;
      end
      else
        Canvas.DrawEllipse(D2D1Ellipse(FCtl.Scr(0, 0), FView.ScaleX(a), FView.ScaleY(a)));
      a := a + Distance;
      Inc(LWhileGuard);
    end;
  end;

end;

procedure TCircularGridLineFamily.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  a: Double;
  LWhileGuard: Integer;
begin

  if LineLimited and (LineEnd <= LineBegin) then
    Exit;

  if Visible and (Distance > 0) and (aspan / Distance < 1000) then
  begin

    ASVG
      .BeginGroup
      .&Class('grid')
      .&Class(Name)
      .Stroke(Color)
      .StrokeWidthPx(Width)
      .Fill('none')
      .Append;

    a := amin(True) - rmod(amin(True), Distance);
    LWhileGuard := 0;
    while (a <= amax(True)) and (LWhileGuard < 1000) do
    begin
      if LineLimited then
        ASVG
          .Arc(FCtl.SpaceToViewbox(ASVG.ViewBox, TPoint.Zero), FView.ScaleX(a), FView.ScaleY(a), LineBegin, LineEnd)
          .Append
      else
        ASVG
          .Ellipse(FCtl.SpaceToViewbox(ASVG.ViewBox, TPoint.Zero), FView.ScaleX(a), FView.ScaleY(a))
          .Append;
      a := a + Distance;
      Inc(LWhileGuard);
    end;

    ASVG.EndGroup.Append;

  end;

end;

{ TGridLineFamilies }

procedure TGridLineFamilies.Assign(Source: TPersistent);
begin
  if Source is TGridLineFamilies then
  begin
    FHorizontalPrimary.Assign(TGridLineFamilies(Source).FHorizontalPrimary);
    FHorizontalSecondary.Assign(TGridLineFamilies(Source).FHorizontalSecondary);
    FVerticalPrimary.Assign(TGridLineFamilies(Source).FVerticalPrimary);
    FVerticalSecondary.Assign(TGridLineFamilies(Source).FVerticalSecondary);
    FRadialPrimary.Assign(TGridLineFamilies(Source).FRadialPrimary);
    FRadialSecondary.Assign(TGridLineFamilies(Source).FRadialSecondary);
    FCircular.Assign(TGridLineFamilies(Source).FCircular);
  end
  else if Source is TGridLineFamily then
  begin
    FHorizontalPrimary.Assign(TGridLineFamily(Source));
    FHorizontalSecondary.Assign(TGridLineFamily(Source));
    FVerticalPrimary.Assign(TGridLineFamily(Source));
    FVerticalSecondary.Assign(TGridLineFamily(Source));
    FRadialPrimary.Assign(TGridLineFamily(Source));
    FRadialSecondary.Assign(TGridLineFamily(Source));
    FCircular.Assign(TGridLineFamily(Source));
  end
  else
    inherited;
end;

constructor TGridLineFamilies.Create(ACtl: TVisCtl2D; AView: TView2D);
begin

  inherited;

  FHorizontalPrimary := THorizontalGridLineFamily.Create(ACtl, AView);
  FHorizontalPrimary.Distance := 5;
  FHorizontalPrimary.Name := 'Primary horizontal';
  FHorizontalPrimary.OnChange := Changed;

  FHorizontalSecondary := THorizontalGridLineFamily.Create(ACtl, AView);
  FHorizontalSecondary.Distance := 1;
  FHorizontalSecondary.Name := 'Secondary horizontal';
  FHorizontalSecondary.OnChange := Changed;

  FVerticalPrimary := TVerticalGridLineFamily.Create(ACtl, AView);
  FVerticalPrimary.Distance := 5;
  FVerticalPrimary.Name := 'Primary vertical';
  FVerticalPrimary.OnChange := Changed;

  FVerticalSecondary := TVerticalGridLineFamily.Create(ACtl, AView);
  FVerticalSecondary.Distance := 1;
  FVerticalSecondary.Name := 'Secondary vertical';
  FVerticalSecondary.OnChange := Changed;

  FRadialPrimary := TRadialGridLineFamily.Create(ACtl, AView);
  FRadialPrimary.Distance := Pi/4;
  FRadialPrimary.Name := 'Primary radial';
  FRadialPrimary.OnChange := Changed;

  FRadialSecondary := TRadialGridLineFamily.Create(ACtl, AView);
  FRadialSecondary.Distance := Pi/8;
  FRadialSecondary.Name := 'Secondary radial';
  FRadialSecondary.OnChange := Changed;

  FCircular := TCircularGridLineFamily.Create(ACtl, AView);
  FCircular.Distance := 10;
  FCircular.Name := 'Primary circular';
  FCircular.OnChange := Changed;

  Name := 'Grid lines';

  OptionsFormClass := TVis2D_GridFamiliesSettingsFrm;

end;

function TGridLineFamilies.CreateReference: TAlgosimReference;
begin
  Result := inherited;
  Result.AddSubref('horizontal', FHorizontalPrimary.CreateReference);
  Result.AddSubref('horizontal2', FHorizontalSecondary.CreateReference);
  Result.AddSubref('vertical', FVerticalPrimary.CreateReference);
  Result.AddSubref('vertical2', FVerticalSecondary.CreateReference);
  Result.AddSubref('radial', FRadialPrimary.CreateReference);
  Result.AddSubref('radial2', FRadialSecondary.CreateReference);
  Result.AddSubref('circular', FCircular.CreateReference);
end;

destructor TGridLineFamilies.Destroy;
begin
  FreeAndNil(FCircular);
  FreeAndNil(FRadialSecondary);
  FreeAndNil(FRadialPrimary);
  FreeAndNil(FVerticalSecondary);
  FreeAndNil(FVerticalPrimary);
  FreeAndNil(FHorizontalSecondary);
  FreeAndNil(FHorizontalPrimary);
  inherited;
end;

procedure TGridLineFamilies.Draw;
begin

  FCircular.Draw;

  FHorizontalSecondary.Draw;
  FVerticalSecondary.Draw;
  FRadialSecondary.Draw;

  FHorizontalPrimary.Draw;
  FVerticalPrimary.Draw;
  FRadialPrimary.Draw;

end;

procedure TGridLineFamilies.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  FCircular.DrawTo(ASVG);

  FHorizontalSecondary.DrawTo(ASVG);
  FVerticalSecondary.DrawTo(ASVG);
  FRadialSecondary.DrawTo(ASVG);

  FHorizontalPrimary.DrawTo(ASVG);
  FVerticalPrimary.DrawTo(ASVG);
  FRadialPrimary.DrawTo(ASVG);

end;

procedure TGridLineFamilies.SetCircular(const Value: TCircularGridLineFamily);
begin
  FCircular.Assign(Value);
end;

procedure TGridLineFamilies.SetHorizontalPrimary(const Value: THorizontalGridLineFamily);
begin
  FHorizontalPrimary.Assign(Value);
end;

procedure TGridLineFamilies.SetHorizontalSecondary(
  const Value: THorizontalGridLineFamily);
begin
  FHorizontalSecondary.Assign(Value);
end;

procedure TGridLineFamilies.SetRadialPrimary(const Value: TRadialGridLineFamily);
begin
  FRadialPrimary.Assign(Value);
end;

procedure TGridLineFamilies.SetRadialSecondary(const Value: TRadialGridLineFamily);
begin
  FRadialSecondary.Assign(Value);
end;

procedure TGridLineFamilies.SetVerticalPrimary(const Value: TVerticalGridLineFamily);
begin
  FVerticalPrimary.Assign(Value);
end;

procedure TGridLineFamilies.SetVerticalSecondary(const Value: TVerticalGridLineFamily);
begin
  FVerticalSecondary.Assign(Value);
end;

{ TElementStyle }

procedure TElementStyle.Assign(Source: TPersistent);
begin
  if Source is TElementStyle then
  begin
    FColor := TElementStyle(Source).FColor;
    FOpacity := TElementStyle(Source).FOpacity;
    FBorderColor := TElementStyle(Source).FBorderColor;
    FBorderWidth := TElementStyle(Source).FBorderWidth;
    FDisplacement := TElementStyle(Source).FDisplacement;
    Changed;
  end
  else
    inherited;
end;

procedure TElementStyle.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'linecolor' then
      BorderColor := V.ToColor
    else if S = 'linewidth' then
      BorderWidth := V.ToInt32
    else if S = 'fillcolor' then
      Color := V.ToColor
    else if S = 'fillopacity' then
      Opacity := EnsureRange(Round(V.ToRealNumber * Opacity.MaxValue), Opacity.MinValue, Opacity.MaxValue)
    else if S = 'displacement' then
      Displacement := V.ToRealNumber
  end;
end;

constructor TElementStyle.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FColor := DefaultColor;
  FOpacity := DefaultOpacity;
  FBorderColor := DefaultBorderColor;
  FBorderWidth := DefaultBorderWidth;
  Name := 'Style';
  OptionsFormClass := TVis2D_ElementSettingsFrm;
  FElementStyleParts := [espColor, espOpacity, espBorderColor, espBorderWidth];
end;

function TElementStyle.GetOpacityFraction: Double;
begin
  Result := Opacity / Opacity.MaxValue;
end;

procedure TElementStyle.SetBorderColor(const Value: TColor);
begin
  if FBorderColor <> Value then
  begin
    FBorderColor := Value;
    Changed;
  end;
end;

procedure TElementStyle.SetBorderWidth(const Value: Integer);
begin
  if FBorderWidth <> Value then
  begin
    FBorderWidth := Value;
    Changed;
  end;
end;

procedure TElementStyle.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

procedure TElementStyle.SetDisplacement(const Value: Double);
begin
  if FDisplacement <> Value then
  begin
    FDisplacement := Value;
    Changed;
  end;
end;

procedure TElementStyle.SetOpacity(const Value: Byte);
begin
  if FOpacity <> Value then
  begin
    FOpacity := Value;
    Changed;
  end;
end;

procedure TElementStyle.SetOpacityFraction(const Value: Double);
begin
  Opacity := Round(Opacity.MaxValue * EnsureRange(Value, 0, 1));
end;

{ TCategoryElements }

function TCategoryElements.MaxValue: Double;
var
  Elem: TCategoryElement;
begin
  Result := 0;
  for Elem in Self do
    if Elem.Value > Result then
      Result := Elem.Value;
end;

function TCategoryElements.RelativeValues: TArray<Double>;
var
  LSum: Double;
  i: Integer;
begin
  SetLength(Result, Count);
  LSum := Sum;
  if LSum <> 0 then
    for i := 0 to Count - 1 do
      Result[i] := Self[i].Value / LSum;
end;

function TCategoryElements.Sum: Double;
var
  Elem: TCategoryElement;
begin
  Result := 0;
  for Elem in Self do
    Result := Result + Elem.Value;
end;

{ TCategoryElement }

procedure TCategoryElement.Assign(Source: TPersistent);
begin
  if Source is TCategoryElement then
  begin
    FLabel := TCategoryElement(Source).FLabel;
    FValue := TCategoryElement(Source).FValue;
    FStyle.Assign(TCategoryElement(Source).FStyle);
    Changed;
  end
  else
    inherited;
end;

procedure TCategoryElement.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'label' then
      &Label := V.ToString
    else if S = 'value' then
      Value := V.ToRealNumber;
  end;
  FStyle.Configure(ASettings);
end;

constructor TCategoryElement.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FStyle := TElementStyle.Create(ACtl, AView);
  FStyle.OnChange := Changed;
  Name := 'Category';
  OptionsFormClass := TVis2D_CategorySettingsFrm;
end;

destructor TCategoryElement.Destroy;
begin
  FreeAndNil(FStyle);
  inherited;
end;

procedure TCategoryElement.SetLabel(const Value: string);
begin
  if FLabel <> Value then
  begin
    FLabel := Value;
    Changed;
  end;
end;

procedure TCategoryElement.SetStyle(const Value: TElementStyle);
begin
  FStyle.Assign(Value);
end;

procedure TCategoryElement.SetValue(const Value: Double);
begin
  if FValue <> Value then
  begin
    FValue := Value;
    Changed;
  end;
end;

{ TCategoryChart }

function TCategoryChart.AddCategory(const ALabel: string;
  const AValue: Double): TCategoryElement;
begin
  Result := TCategoryElement.Create(FCtl, FView);
  FCategories.Add(Result);
  Result.&Label := ALabel;
  Result.Value := AValue;
  Result.OnChange := Changed;
end;

class function TCategoryChart.AllowAutoNormalization: Boolean;
begin
  Result := False;
end;

procedure TCategoryChart.Assign(Source: TPersistent);
var
  Cat: TCategoryElement;
begin
  if Source is TElementStyle then
  begin
    if Assigned(FCategories) then
      for Cat in FCategories do
        if Assigned(Cat) and Assigned(Cat.Style) then
          Cat.Style.Assign(Source);
  end
  else
    inherited;
end;

procedure TCategoryChart.CategoriesNotify(Sender: TObject;
  const Item: TCategoryElement; Action: TCollectionNotification);
begin
  Changed;
end;

procedure TCategoryChart.Clear;
begin
  FCategories.Clear;
end;

procedure TCategoryChart.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'legend' then
      ShowLegend := V.ToBoolean
    else if S = 'labels' then
      LabelVisible := V.ToBoolean
    else if S = 'labelposition' then
      LabelPosition := V.ToRealNumber
    else if S = 'valuelabels' then
      ValueLabelVisible := V.ToBoolean
    else if S = 'valuelabelposition' then
      ValueLabelPosition := V.ToRealNumber
    else if S = 'valueformat' then
      ValueFormat := V.ToString
  end;
end;

constructor TCategoryChart.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FCategories := TCategoryElements.Create;
  FCategories.OnNotify := CategoriesNotify;
  FLegendStyle := TElementStyle.Create(ACtl, AView);
  FLegendStyle.Name := 'Legend';
  FLegendStyle.Color := clWhite;
  FLegendStyle.OnChange := Changed;
  FChartTypeName := 'Category chart';
  Name := 'Category chart';
  OptionsFormClass := TVis2D_CategoryChartSettingsFrm;
end;

function TCategoryChart.CreateReference: TAlgosimReference;
begin
  Result := inherited;
  Result.AddSubref('legend', FLegendStyle.CreateReference);
  for var cat in FCategories do
    Result.AddSubref(cat.&Label, cat.CreateReference);
end;

destructor TCategoryChart.Destroy;
begin
  FreeAndNil(FLabelFont);
  FreeAndNil(FValueFont);
  FreeAndNil(FLegendFont);
  FreeAndNil(FLegendStyle);
  FreeAndNil(FCategories);
  inherited;
end;

procedure TCategoryChart.Draw;
var
  CR: TRect;
  Cat: TCategoryElement;
  W, H, LH: Double;
  x, y: Double;
  R: TRect;
  M: TSize;
  Ms: Integer;
begin

  inherited;

  if FShowLegend then
  begin

    Canvas.Brush.Color := FLegendStyle.Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Handle.SetOpacity(FLegendStyle.Opacity / FLegendStyle.Opacity.MaxValue);
    Canvas.Pen.Color := FLegendStyle.BorderColor;
    Canvas.Pen.Width := idfcn(FLegendStyle.BorderWidth);
    Canvas.Pen.Style := psSolid;

    if Assigned(FLegendFont) then
    begin
      Canvas.Font.Assign(FLegendFont);
      Canvas.Font.PixelsPerInch := 96;
      Canvas.Font.Size := idfcn(FLegendFont.Size);
    end
    else
    begin
      Canvas.Font.Assign(FCtl.Font);
      Canvas.Font.PixelsPerInch := 96;
      Canvas.Font.Size := 9; // invariant
    end;

    M := Canvas.TextExtent('M');
    Ms := Max(M.cx, M.cy);

    W := 0.0;
    LH := 0.0;
    H := 0.0;

    CR := CanvasRect;

    for Cat in FCategories do
      with Canvas.TextExtent(Cat.&Label) do
      begin
        if cx > W then
          W := cx;
        if (H = 0.0) and (cy <> 0.0) then
          LH := cy;
      end;

    W := W + 2*Ms;

    H := FCategories.Count * LH + (FCategories.Count - 1) * 0.25 * LH;

    if W > CR.Width div 2 then
      W := CR.Width div 2;

    if H > CR.Height then
      H := CR.Height;

    if (H <= 0) or (W <= 0) then
      Exit;

    if not TRectD.Create(CR.Width - W - 20*3, 20, CR.Width - 20, 20*3 + H).TryToInt(R) then
      Exit;

    Canvas.Rectangle(R);

    x := R.Left + 20;
    y := R.Top + 20;

    for Cat in FCategories do
    begin
      Canvas.Brush.Color := Cat.Style.Color;
      Canvas.Brush.Style := bsSolid;
      Canvas.Brush.Handle.SetOpacity(Cat.Style.Opacity / Cat.Style.Opacity.MaxValue);
      Canvas.FillRect(Rect(Round(x), Round(y), Round(x + Ms), Round(y + Ms)));
      Canvas.Brush.Style := bsClear;
      TextOut(x + 2*Ms, y, Cat.&Label);
      y := y + 1.25*LH;
    end;

  end;

end;

procedure TCategoryChart.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  CR: TRect;
  Cat: TCategoryElement;
  W, H, LH: Double;
  x, y: Double;
  R: TRect;
  M: TSize;
  Ms: Integer;
begin

  inherited;

  if FShowLegend then
  begin

    if Assigned(FLegendFont) then
    begin
      Canvas.Font.Assign(FLegendFont);
      Canvas.Font.Size := idfcn(FLegendFont.Size);
    end
    else
    begin
      Canvas.Font.Assign(FCtl.Font);
      Canvas.Font.Size := 9; // invariant
    end;

    M := Canvas.TextExtent('M');
    Ms := Max(M.cx, M.cy);

    W := 0.0;
    LH := 0.0;
    H := 0.0;

    CR := CanvasRect;

    for Cat in FCategories do
      with Canvas.TextExtent(Cat.&Label) do
      begin
        if cx > W then
          W := cx;
        if (H = 0.0) and (cy <> 0.0) then
          LH := cy;
      end;

    W := W + 2*Ms;

    H := FCategories.Count * LH + (FCategories.Count - 1) * 0.25 * LH;

    if W > CR.Width div 2 then
      W := CR.Width div 2;

    if H > CR.Height then
      H := CR.Height;

    if (H <= 0) or (W <= 0) then
      Exit;

    if not TRectD.Create(CR.Width - W - 20*3, 20, CR.Width - 20, 20*3 + H).TryToInt(R) then
      Exit;

    ASVG
      .BeginGroup
      .&Class('legend')
      .Append;

    ASVG
      .Rect(R)
      .Fill(FLegendStyle.Color)
      .FillOpacity(FLegendStyle.OpacityFraction)
      .Stroke(FLegendStyle.BorderColor)
      .StrokeWidthPx(FLegendStyle.BorderWidth)
      .Append;

    x := R.Left + 20;
    y := R.Top + 20;

    for Cat in FCategories do
    begin
      ASVG
        .BeginGroup
        .Append;
      ASVG
        .Rect(x, y, Ms, Ms)
        .&Class('category-icon')
        .Fill(Cat.Style.Color)
        .FillOpacity(Cat.Style.OpacityFraction)
        .Append;
      ASVG
        .Text(x + 2*Ms, y + 0.5*Ms, Cat.&Label)
        .Font(FLegendFont)
        .DominantBaseline(taVerticalCenter)
        .Append;
      ASVG.EndGroup.Append;
      y := y + 1.25*LH;
    end;

    ASVG.EndGroup.Append;

  end;

end;

procedure TCategoryChart.DrawToPrefix(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  ASVG
    .BeginGroup
    .&Class('category-chart')
    .&Class(ChartTypeName.ToLower)
    .Append;

  ASVG.GroupTitle(Title).Append;
  ASVG.GroupDescription(Description).Append;

end;

procedure TCategoryChart.DrawToSuffix(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  ASVG.EndGroup.Append;

end;

function TCategoryChart.GetLabelFont: TFont;
begin
  if FLabelFont = nil then
  begin
    FLabelFont := TFont.Create;
    if Assigned(FCtl) and Assigned(FCtl.Font) then
    begin
      FLabelFont.Assign(FCtl.Font);
      FLabelFont.Size := 9; // invariant
    end;
    FLabelFont.OnChange := Changed;
  end;
  Result := FLabelFont;
end;

function TCategoryChart.GetLegendFont: TFont;
begin
  if FLegendFont = nil then
  begin
    FLegendFont := TFont.Create;
    if Assigned(FCtl) and Assigned(FCtl.Font) then
    begin
      FLegendFont.Assign(FCtl.Font);
      FLegendFont.Size := 9; // invariant
    end;
    FLegendFont.OnChange := Changed;
  end;
  Result := FLegendFont;
end;

function TCategoryChart.GetValueFont: TFont;
begin
  if FValueFont = nil then
  begin
    FValueFont := TFont.Create;
    if Assigned(FCtl) and Assigned(FCtl.Font) then
    begin
      FValueFont.Assign(FCtl.Font);
      FValueFont.Size := 9; // invariant
    end;
    FValueFont.OnChange := Changed;
  end;
  Result := FValueFont;
end;

procedure TCategoryChart.SetCategories(const Value: TCategoryElements);
var
  i: Integer;
  Cat: TCategoryElement;
begin
  FCategories.Clear;
  if Assigned(Value) then
    for i := 0 to Value.Count - 1 do
    begin
      Cat := TCategoryElement.Create(FCtl, FView);
      FCategories.Add(Cat);
      Cat.Assign(Value[i]);
      Cat.OnChange := Changed;
    end;
end;

procedure TCategoryChart.SetLabelFont(const Value: TFont);
begin
  if FLabelFont = nil then
  begin
    FLabelFont := TFont.Create;
    FLabelFont.OnChange := Changed;
  end;
  FLabelFont.Assign(Value);
end;

procedure TCategoryChart.SetLabelPosition(const Value: Double);
begin
  if FLabelPosition <> Value then
  begin
    FLabelPosition := Value;
    Changed;
  end;
end;

procedure TCategoryChart.SetLabelVisible(const Value: Boolean);
begin
  if FLabelVisible <> Value then
  begin
    FLabelVisible := Value;
    Changed;
  end;
end;

procedure TCategoryChart.SetLegendFont(const Value: TFont);
begin
  if FLegendFont = nil then
  begin
    FLegendFont := TFont.Create;
    FLegendFont.OnChange := Changed;
  end;
  FLegendFont.Assign(Value);
end;

procedure TCategoryChart.SetLegendStyle(const Value: TElementStyle);
begin
  FLegendStyle.Assign(Value);
end;

procedure TCategoryChart.SetShowLegend(const Value: Boolean);
begin
  if FShowLegend <> Value then
  begin
    FShowLegend := Value;
    Changed;
  end;
end;

procedure TCategoryChart.SetValueFont(const Value: TFont);
begin
  if FValueFont = nil then
  begin
    FValueFont := TFont.Create;
    FValueFont.OnChange := Changed;
  end;
  FValueFont.Assign(Value);
end;

procedure TCategoryChart.SetValueFormat(const Value: string);
begin
  if FValueFormat <> Value then
  begin
    FValueFormat := Value;
    Changed;
  end;
end;

procedure TCategoryChart.SetValueLabelPosition(const Value: Double);
begin
  if FValueLabelPosition <> Value then
  begin
    FValueLabelPosition := Value;
    Changed;
  end;
end;

procedure TCategoryChart.SetValueLabelVisible(const Value: Boolean);
begin
  if FValueLabelVisible <> Value then
  begin
    FValueLabelVisible := Value;
    Changed;
  end;
end;

{ TBarChart }

function TBarChart.AddBar(const ALabel: string; const AValue: Double): TCategoryElement;
begin
  Result := AddCategory(ALabel, AValue);
end;

procedure TBarChart.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'baroffset' then
      BarOffset := V.ToRealNumber
    else if S = 'barwidth' then
      BarWidth := V.ToRealNumber
    else if S = 'barspacing' then
      BarSpacing := V.ToRealNumber
  end;
end;

constructor TBarChart.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FBarOffset := 0.5;
  FBarWidth := 1;
  FBarSpacing := 0.25;
  FChartTypeName := 'Bar chart';
  FLabelVisible := True;
  FValueLabelVisible := False;
  FLabelPosition := -8;
  FValueLabelPosition := 8;
  Name := 'Bar chart';
  FDetailsOptionsFrmClass := TVis2D_BarChartSettingsFrm;
end;

procedure TBarChart.Draw;
var
  i: Integer;
  x: Double;
begin

  if Bars = nil then
    Exit;

  x := FBarOffset;
  for i := 0 to Bars.Count - 1 do
  begin
    DrawBar(Bars[i], i, x);
    x := x + FBarWidth + FBarSpacing;
  end;

  inherited;

end;

procedure TBarChart.DrawBar(ABar: TCategoryElement; AIndex: Integer;
  const AOffset: Double);
var
  R: TRect;
  S: string;
begin

  Canvas.Brush.Color := ABar.Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(ABar.Style.Opacity / ABar.Style.Opacity.MaxValue);
  Canvas.Pen.Color := ABar.Style.BorderColor;
  Canvas.Pen.Width := idfcn(ABar.Style.BorderWidth);
  Canvas.Pen.Style := psSolid;
  DrawRectSp(TRectD.Create(AOffset, ABar.Value, AOffset + FBarWidth, 0));

  if Assigned(FLabelFont) then
  begin
    Canvas.Font.Assign(FLabelFont);
    Canvas.Font.PixelsPerInch := 96;
    Canvas.Font.Size := idfcn(FLabelFont.Size);
  end
  else
  begin
    Canvas.Font.Assign(FCtl.Font);
    Canvas.Font.PixelsPerInch := 96;
    Canvas.Font.Size := 9; // invariant
  end;

  Canvas.Brush.Style := bsClear;

  if FLabelVisible and FCtl.SpaceToCanvas(TRectD.Create(AOffset, 0, AOffset + FBarWidth, 0)).TryToInt(R) then
  begin

    S := ABar.&Label;

    var Sz := Canvas.TextExtent(S);

    if InRange(FLabelPosition, 0, 1) then
    begin

      with
        FCtl.SpaceToCanvas(
          AOffset + FBarWidth / 2,
          FLabelPosition * ABar.Value,
          -Sz.cx div 2,
          -Sz.cy div 2)
      do
        TextOut(X, Y, S);

    end
    else if FLabelPosition > 1 then
    begin

      with
        FCtl.SpaceToCanvas(
          AOffset + FBarWidth / 2,
          ABar.Value,
          -Sz.cx div 2,
          IfThen(ABar.Value >= 0, -Sz.cy) - Sign(ABar.Value) * Round(FLabelPosition))
      do
        TextOut(X, Y, S);

    end
    else {if FLabelPosition < 0 then}
    begin

      with
        FCtl.SpaceToCanvas(
          AOffset + FBarWidth / 2,
          0,
          -Sz.cx div 2,
          IfThen(ABar.Value < 0, -Sz.cy) - Sign(ABar.Value) * Round(FLabelPosition))
      do
        TextOut(X, Y, S);

    end;


  end;

  if FValueLabelVisible then
  begin

    if Assigned(FValueFont) then
    begin
      Canvas.Font.Assign(FValueFont);
      Canvas.Font.PixelsPerInch := 96;
      Canvas.Font.Size := idfcn(FValueFont.Size);
    end;

    var LValueFormat := FValueFormat;
    if LValueFormat.IsEmpty then
      if IsInteger(ABar.Value) then
        LValueFormat := '#'
      else
        LValueFormat := '#.00';

    S := FormatFloat(LValueFormat, ABar.Value, FCtl.InvFS).Replace(HYPHEN_MINUS, MINUS_SIGN);

    var Sz := Canvas.TextExtent(S);

    if InRange(FValueLabelPosition, 0, 1) then
    begin

      with
        FCtl.SpaceToCanvas(
          AOffset + FBarWidth / 2,
          FValueLabelPosition * ABar.Value,
          -Sz.cx div 2,
          -Sz.cy div 2)
      do
        TextOut(X, Y, S);

    end
    else if FValueLabelPosition > 1 then
    begin

      with
        FCtl.SpaceToCanvas(
          AOffset + FBarWidth / 2,
          ABar.Value,
          -Sz.cx div 2,
          IfThen(ABar.Value >= 0, -Sz.cy) - Sign(ABar.Value) * Round(FValueLabelPosition))
      do
        TextOut(X, Y, S);

    end
    else {if FValueLabelPosition < 0 then}
    begin

      with
        FCtl.SpaceToCanvas(
          AOffset + FBarWidth / 2,
          0,
          -Sz.cx div 2,
          IfThen(ABar.Value < 0, -Sz.cy) - Sign(ABar.Value) * Round(FValueLabelPosition))
      do
        TextOut(X, Y, S);

    end;

  end;

end;

procedure TBarChart.DrawBarTo(ASVG: TSVGBuilder_VisCtl2D; ABar: TCategoryElement;
  AIndex: Integer; const AOffset: Double);
begin

  ASVG
    .BeginGroup
    .&Class('bar')
    .Append;

  ASVG
    .Rect(FCtl.SpaceToCanvas(
      TRectD.Create(AOffset, Max(0, ABar.Value), AOffset + FBarWidth, Min(0, ABar.Value))
    ))
    .Fill(ABar.Style.Color)
    .FillOpacity(ABar.Style.OpacityFraction)
    .Stroke(ABar.Style.BorderColor)
    .StrokeWidthPx(ABar.Style.BorderWidth)
    .Append;

  if FLabelVisible then
  begin

    if InRange(FLabelPosition, 0, 1) then
      ASVG
        .Text(
          FCtl.SpaceToViewbox(ASVG.ViewBox,
            TPointD.Create(
              AOffset + FBarWidth / 2,
              FLabelPosition * ABar.Value
            )
          ),
          ABar.&Label
        )
        .&Class('category-label')
        .TextAnchor(taCenter)
        .DominantBaseline(taVerticalCenter)
        .Font(FLabelFont)
        .Append
    else if FLabelPosition > 1 then
      ASVG
        .Text(
          FCtl.SpaceToViewbox(ASVG.ViewBox,
            TPointD.Create(
              AOffset + FBarWidth / 2,
              ABar.Value
            ),
            0,
            -Sign(ABar.Value) * Round(FLabelPosition)
          ),
          ABar.&Label
        )
        .&Class('category-label')
        .TextAnchor(taCenter)
        .AttribIf('dominant-baseline', 'text-before-edge', ABar.Value < 0)
        .Font(FLabelFont)
        .Append
    else {if FLabelPosition < 0 then}
      ASVG
        .Text(
          FCtl.SpaceToViewbox(ASVG.ViewBox,
            TPointD.Create(
              AOffset + FBarWidth / 2,
              0
            ),
            0,
            -Sign(ABar.Value) * Round(FLabelPosition)),
          ABar.&Label
        )
        .&Class('category-label')
        .TextAnchor(taCenter)
        .AttribIf('dominant-baseline', 'text-before-edge', ABar.Value >= 0)
        .Font(FLabelFont)
        .Append;

  end;

  if FValueLabelVisible then
  begin

    var LValueFormat := FValueFormat;
    if LValueFormat.IsEmpty then
      if IsInteger(ABar.Value) then
        LValueFormat := '#'
      else
        LValueFormat := '#.00';

    var S := FormatFloat(LValueFormat, ABar.Value, FCtl.InvFS).Replace(HYPHEN_MINUS, MINUS_SIGN);

    if InRange(FValueLabelPosition, 0, 1) then
      ASVG
        .Text(
          FCtl.SpaceToViewbox(ASVG.ViewBox,
            TPointD.Create(
              AOffset + FBarWidth / 2,
              FValueLabelPosition * ABar.Value
            )
          ),
          S
        )
        .&Class('value-label')
        .TextAnchor(taCenter)
        .DominantBaseline(taVerticalCenter)
        .Font(FValueFont)
        .Append
    else if FValueLabelPosition > 1 then
      ASVG
        .Text(
          FCtl.SpaceToViewbox(ASVG.ViewBox,
            TPointD.Create(
              AOffset + FBarWidth / 2,
              ABar.Value
            ),
            0,
            -Sign(ABar.Value) * Round(FValueLabelPosition)
          ),
          S
        )
        .&Class('value-label')
        .TextAnchor(taCenter)
        .AttribIf('dominant-baseline', 'text-before-edge', ABar.Value < 0)
        .Font(FValueFont)
        .Append
    else {if FValueLabelPosition < 0 then}
      ASVG
        .Text(
          FCtl.SpaceToViewbox(ASVG.ViewBox,
            TPointD.Create(
              AOffset + FBarWidth / 2,
              0
            ),
            0,
            -Sign(ABar.Value) * Round(FValueLabelPosition)),
          S
        )
        .&Class('value-label')
        .TextAnchor(taCenter)
        .AttribIf('dominant-baseline', 'text-before-edge', ABar.Value >= 0)
        .Font(FValueFont)
        .Append;

  end;

  ASVG.EndGroup.Append;

end;

procedure TBarChart.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  i: Integer;
  x: Double;
begin

  if Bars = nil then
    Exit;

  x := FBarOffset;
  for i := 0 to Bars.Count - 1 do
  begin
    DrawBarTo(ASVG, Bars[i], i, x);
    x := x + FBarWidth + FBarSpacing;
  end;

  inherited;

end;

procedure TBarChart.SetBarOffset(const Value: Double);
begin
  if FBarOffset <> Value then
  begin
    FBarOffset := Value;
    Changed;
  end;
end;

procedure TBarChart.SetBarSpacing(const Value: Double);
begin
  if FBarSpacing <> Value then
  begin
    FBarSpacing := Value;
    Changed;
  end;
end;

procedure TBarChart.SetBarWidth(const Value: Double);
begin
  if FBarWidth <> Value then
  begin
    FBarWidth := Value;
    Changed;
  end;
end;

{ TDrawableList }

constructor TDrawableList.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FList := TObjectList<TDrawable>.Create;
  FList.OnNotify := ObjsNotify;
  OptionsFormClass := TVis2D_ObjMgrFrm;
end;

destructor TDrawableList.Destroy;
begin
  FreeAndNil(FList);
  inherited;
end;

procedure TDrawableList.Draw(BottomLayer: Boolean);
begin
  if Assigned(FList) then
    for var obj in FList do
      if Assigned(obj) and obj.Visible and (obj.BehindAxes = BottomLayer) then
      begin
        const tc1 = GetTickCount64;
        obj.Draw;
        const tc2 = GetTickCount64;
        obj.FLastDrawTime := UInt64(tc2 - tc1);
      end;
end;

procedure TDrawableList.Draw;
begin
  if Assigned(FList) then
    for var obj in FList do
      if Assigned(obj) and obj.Visible then
        obj.Draw;
end;

procedure TDrawableList.DrawTo(ASVG: TSVGBuilder_VisCtl2D; BottomLayer: Boolean);
begin
  if Assigned(FList) then
    for var obj in FList do
      if Assigned(obj) and obj.Visible and (obj.BehindAxes = BottomLayer) then
        obj.DrawTo(ASVG);
end;

procedure TDrawableList.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin
  if Assigned(FList) then
    for var obj in FList do
      if Assigned(obj) and obj.Visible then
        obj.DrawTo(ASVG);
end;

function TDrawableList.GetItem(Index: Integer): TDrawable;
begin
  Result := FList[Index];
end;

function TDrawableList.GetItemCount: Integer;
begin
  if Assigned(FList) then
    Result := FList.Count
  else
    Result := 0;
end;

procedure TDrawableList.MoveDown(ADrawable: TDrawable);
begin
  var Idx := FList.IndexOf(ADrawable);
  if Idx <> -1 then
  begin
    FList.Move(Idx, Succ(Idx));
    Changed;
  end;
end;

procedure TDrawableList.MoveUp(ADrawable: TDrawable);
begin
  var Idx := FList.IndexOf(ADrawable);
  if Idx <> -1 then
  begin
    FList.Move(Idx, Pred(Idx));
    Changed;
  end;
end;

procedure TDrawableList.ObjsNotify(Sender: TObject; const Item: TDrawable;
  Action: TCollectionNotification);
begin
  Changed;
end;

procedure TDrawableList.SetItem(Index: Integer; const Value: TDrawable);
begin
  FList[Index] := Value;
end;

{ THistogram }

class function THistogram.AllowAutoNormalization: Boolean;
begin
  Result := False;
end;

procedure THistogram.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'binwidth' then
      BinWidth := V.ToRealNumber
    else if S = 'startat' then
      StartAt := V.ToRealNumber
  end;
  FStyle.Configure(ASettings);
end;

constructor THistogram.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FStyle := TElementStyle.Create(ACtl, AView);
  FStyle.OnChange := Changed;
  FBinWidth := 1;
  Name := 'Histogram';
  OptionsFormClass := TVis2D_HistogramSettingsFrm;
end;

destructor THistogram.Destroy;
begin
  FreeAndNil(FStyle);
  inherited;
end;

procedure THistogram.Draw;
begin

  Canvas.Brush.Color := Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;

  for var i := 0 to High(FBinValues) do
    DrawRectSp(
      TRectD.Create(
        FActualStartAt + FBinWidth * i,
        FBinValues[i],
        FActualStartAt + FBinWidth * Succ(i),
        0
      )
    );

end;

procedure THistogram.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  ASVG
    .BeginGroup
    .&Class('histogram')
    .Fill(Style.Color)
    .FillOpacity(Style.OpacityFraction)
    .Stroke(Style.BorderColor)
    .StrokeWidthPx(Style.BorderWidth)
    .Append;

  ASVG.GroupTitle(Title).Append;
  ASVG.GroupDescription(Description).Append;

  for var i := 0 to High(FBinValues) do
    ASVG
      .Rect(
        FCtl.SpaceToCanvas(
          TRectD.Create(
            FActualStartAt + FBinWidth * i,
            FBinValues[i],
            FActualStartAt + FBinWidth * Succ(i),
            0
          )
        )
      )
      .Append;

  ASVG.EndGroup.Append;

end;

function THistogram.GetBinIndex(const Value: Double): Integer;
begin
  Result := EnsureRange(
      Floor((Value - FActualStartAt) / FBinWidth),
      0,
      High(FBinValues)
    );
end;

function THistogram.GetDataLength: Integer;
begin
  Result := Length(FData);
end;

function THistogram.GetMaxBinValue: Int64;
var
  i: Integer;
begin

  if Length(FBinValues) = 0 then
    Exit(0);

  Result := FBinValues[0];
  for i := 1 to High(FBinValues) do
    if FBinValues[i] > Result then
      Result := FBinValues[i];

end;

procedure THistogram.Recompute;
var
  BinCountFlt: Double;
  BinCount: Integer;
  x: Double;
begin

  FBinValues := nil;

  if FBinWidth <= 0 then
    Exit;

  RecomputeStartAt;

  BinCountFlt := (FMaxDataValue - FActualStartAt) / FBinWidth;
  if BinCountFlt > 10000000 then
    Exit;
  BinCount := Trunc(BinCountFlt + 1);

  if BinCount = 0 then
    BinCount := 1;

  SetLength(FBinValues, BinCount);

  for x in FData do
    Inc(FBinValues[GetBinIndex(x)]);

end;

procedure THistogram.RecomputeStartAt;
begin
  if FStartAt > FMinDataValue then
    FActualStartAt := FStartAt - FBinWidth * Ceil((FStartAt - FMinDataValue) / FBinWidth)
  else
    FActualStartAt := FStartAt;
end;

procedure THistogram.SetBinWidth(const Value: Double);
begin
  if Value <= 0 then
    Exit;
  if FBinWidth <> Value then
  begin
    FBinWidth := Value;
    RecomputeStartAt;
    Recompute;
    Changed;
  end;
end;

procedure THistogram.SetData(const Value: TArray<Double>);
begin
  FData := Copy(Value);
  if Length(FData) > 0 then
  begin
    FMinDataValue := MinValue(FData);
    FMaxDataValue := MaxValue(FData)
  end
  else
  begin
    FMinDataValue := 0.0;
    FMaxDataValue := 0.0
  end;
  FDataSpan := FMaxDataValue - FMinDataValue;
  FStartAt := FMinDataValue;
  RecomputeStartAt;
  Recompute;
  Changed;
end;

procedure THistogram.SetStartAt(const Value: Double);
begin
  if FStartAt <> Value then
  begin
    FStartAt := Value;
    RecomputeStartAt;
    Recompute;
    Changed;
  end;
end;

procedure THistogram.SetStyle(const Value: TElementStyle);
begin
  FStyle.Assign(Value);
end;

{ TXYPlot }

procedure TXYPlot.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'pointsize' then
      PointSize := V.ToInt32
    else if S = 'points' then
      Points := V.ToBoolean
    else if S = 'lines' then
      Lines := V.ToBoolean
    else if S = 'area' then
      Area := V.ToBoolean
  end;
  FStyle.Configure(ASettings);
end;

constructor TXYPlot.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FStyle := TElementStyle.Create(ACtl, AView);
  FStyle.OnChange := Changed;
  FPointSize := DefaultPointSize;
  FPoints := True;
  Name := 'XY plot';
  OptionsFormClass := TVis2D_XYPlotSettingsFrm;
end;

destructor TXYPlot.Destroy;
begin
  FreeAndNil(FMetadata);
  FreeAndNil(FStyle);
  inherited;
end;

procedure TXYPlot.Draw;
var
  i: Integer;
  Trapezoid: ID2D1PathGeometry;
  Sink: ID2D1GeometrySink;
  D2d1Point: TD2D1Point2F;
begin

  Canvas.Brush.Color := Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;

  var FPointSizeDiv2 := FPointSize / 2;

  if Assigned(FData) then
  begin
    if FArea and (Length(FData) >= 2) then
    begin
      if Succeeded(D2DFactory.CreatePathGeometry(Trapezoid)) then
      begin
        if Succeeded(Trapezoid.Open(Sink)) then
        begin
          try
            if Math.IsNan(FData[0].X) or not FCtl.TrySpaceToD2d1(FCtl.P(FData[0].X, 0), D2d1Point) then
              Exit;
            Sink.BeginFigure(D2d1Point, D2D1_FIGURE_BEGIN_FILLED);
            try
              for i := 0 to High(FData) do
              begin
                if not FCtl.TrySpaceToD2d1(FData[i], D2d1Point) then
                  Exit;
                Sink.AddLine(D2d1Point);
              end;
              if not FCtl.TrySpaceToD2d1(FCtl.P(FData[High(FData)].X, 0), D2d1Point) then
                Exit;
              Sink.AddLine(D2d1Point);
            finally
              Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
            end;
          finally
            Sink.Close;
          end;
          Canvas.FillGeometry(Trapezoid);
        end;
      end;
    end;
    if FLines and (Length(FData) >= 2) then
    begin
      if Succeeded(D2DFactory.CreatePathGeometry(Trapezoid)) then
      begin
        if Succeeded(Trapezoid.Open(Sink)) then
        begin
          try
            if FData[0].X.IsNan then
            begin // multiple curves
              var LInCurve := False;
              for i := 1 to High(FData) + 1 do
              begin
                if (i = Length(FData)) or FData[i].X.IsNan then
                begin
                  if LInCurve then
                  begin
                    Sink.EndFigure(D2D1_FIGURE_END_OPEN);
                    LInCurve := False;
                  end;
                end
                else
                begin
                  if not FCtl.TrySpaceToD2d1(FData[i], D2d1Point) then
                    Exit;
                  if not LInCurve then
                  begin
                    Sink.BeginFigure(D2d1Point, D2D1_FIGURE_BEGIN_HOLLOW);
                    LInCurve := True;
                  end
                  else
                    Sink.AddLine(D2d1Point);
                end;
              end;
            end
            else
            begin // single curve
              if not FCtl.TrySpaceToD2d1(FData[0], D2d1Point) then
                Exit;
              Sink.BeginFigure(D2d1Point, D2D1_FIGURE_BEGIN_HOLLOW);
              try
                for i := 1 to High(FData) do
                begin
                  if not FCtl.TrySpaceToD2d1(FData[i], D2d1Point) then
                    Exit;
                  Sink.AddLine(D2d1Point);
                end;
                Sink.AddLine(D2d1Point);
              finally
                Sink.EndFigure(D2D1_FIGURE_END_OPEN);
              end;
            end;
          finally
            Sink.Close;
          end;
          Canvas.DrawGeometry(Trapezoid);
        end;
      end;
    end;
    if FPoints then
      for i := Low(FData) to High(FData) do
        DrawDiskSpPx(FData[i], FPointSizeDiv2);
  end;

end;

procedure TXYPlot.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  var FPointSizeDiv2 := FPointSize / 2;

  if Assigned(FData) and (FArea or FLines or FPoints) then
  begin

    ASVG
      .BeginGroup
      .&Class('xy-plot')
      .Append;

    ASVG.GroupTitle(Title).Append;
    ASVG.GroupDescription(Description).Append;

    if FArea and (Length(FData) >= 2) then
    begin

      var Vertices: TArray<TPointD>;
      SetLength(Vertices, Length(FData) + 2);
      Vertices[0] := FCtl.SpaceToViewbox(ASVG.ViewBox, FCtl.P(FData[0].X, 0));
      for var i := 0 to High(FData) do
        Vertices[i + 1] := FCtl.SpaceToViewbox(ASVG.ViewBox, FData[i]);
      Vertices[High(Vertices)] := FCtl.SpaceToViewbox(ASVG.ViewBox, FCtl.P(FData[High(FData)].X, 0));

      ASVG
        .Polygon(Vertices)
        .Fill(Style.Color)
        .FillOpacity(Style.OpacityFraction)
        .Stroke('none')
        .Append;

    end;

    if FLines and (Length(FData) >= 2) then
    begin

      var Vertices: TArray<TPointD>;

      if FData[0].X.IsNan then
      begin
        var LActualLength := 0;
        var LInCurve := False;
        var LCurveIndex := -1;
        var LCircleRec := Default(TCircleRec);
        for var i := 0 to High(FData) + 1 do
        begin
          if (i = Length(FData)) or FData[i].X.IsNan then
          begin
            if LInCurve then
            begin
              if
                Assigned(FCtl)
                  and
                Assigned(FView)
                  and
                (FMetadata is TDictionary<Integer, TCircleRec>)
                  and
                FView.IsNormalized
                  and
                TDictionary<Integer, TCircleRec>(FMetadata).TryGetValue(LCurveIndex, LCircleRec)
                  and
                (LCircleRec.r > 0)
                  and
                not LCircleRec.P.IsNAN
              then
              begin
                ASVG
                  .Circle(FCtl.SpaceToViewbox(ASVG.ViewBox, LCircleRec.P), FCtl.SpaceToViewboxX(ASVG.ViewBox, LCircleRec.r))
                  .Stroke(Style.BorderColor)
                  .StrokeWidthPx(Style.BorderWidth)
                  .Fill('none')
                  .Append;
              end
              else
              begin
                SetLength(Vertices, LActualLength);
                ASVG
                  .PolyLine(Vertices)
                  .Stroke(Style.BorderColor)
                  .StrokeWidthPx(Style.BorderWidth)
                  .Append;
              end;
              LInCurve := False;
              Vertices := nil;
              LActualLength := 0;
            end
          end
          else
          begin
            if not LInCurve then
            begin
              SetLength(Vertices, Length(FData));
              LActualLength := 0;
              LInCurve := True;
              Inc(LCurveIndex);
            end;
            Vertices[LActualLength] := FCtl.SpaceToViewbox(ASVG.ViewBox, FData[i]);
            Inc(LActualLength);
          end;
        end;
      end
      else
      begin
        SetLength(Vertices, Length(FData));
        for var i := 0 to High(FData) do
          Vertices[i] := FCtl.SpaceToViewbox(ASVG.ViewBox, FData[i]);
        ASVG
          .PolyLine(Vertices)
          .Stroke(Style.BorderColor)
          .StrokeWidthPx(Style.BorderWidth)
          .Append;
      end;

    end;

    if FPoints then
    begin
      ASVG
        .BeginGroup
        .Fill(Style.Color)
        .FillOpacity(Style.OpacityFraction)
        .Stroke(Style.BorderColor)
        .StrokeWidthPx(Style.BorderWidth)
        .Append;
      for var i := 0 to High(FData) do
        if not FData[i].X.IsNan and not FData[i].Y.IsNan then
          with FCtl.SpaceToViewbox(ASVG.ViewBox, FData[i]) do
            if
              (x + FPointSizeDiv2 >= ASVG.ViewBox.Xmin)
                and
              (x - FPointSizeDiv2 <= ASVG.ViewBox.Xmax)
                and
              (y + FPointSizeDiv2 >= ASVG.ViewBox.Ymin)
                and
              (y - FPointSizeDiv2 <= ASVG.ViewBox.Ymax)
            then
              ASVG
                .Circle(x, y, px(FPointSizeDiv2))
                .Append;
      ASVG.EndGroup.Append;
    end;

    ASVG.EndGroup.Append;

  end;

end;

procedure TXYPlot.SetLines(const Value: Boolean);
begin
  if FLines <> Value then
  begin
    FLines := Value;
    Changed;
  end;
end;

procedure TXYPlot.SetArea(const Value: Boolean);
begin
  if FArea <> Value then
  begin
    FArea := Value;
    Changed;
  end;
end;

procedure TXYPlot.SetData(const Value: TArray<TPointD>);
begin
  FData := Copy(Value);
  Changed;
end;

procedure TXYPlot.SetPoints(const Value: Boolean);
begin
  if FPoints <> Value then
  begin
    FPoints := Value;
    Changed;
  end;
end;

procedure TXYPlot.SetPointSize(const Value: Integer);
begin
  if FPointSize <> Value then
  begin
    FPointSize := Value;
    Changed;
  end;
end;

procedure TXYPlot.SetStyle(const Value: TElementStyle);
begin
  FStyle.Assign(Value);
end;

{ TPieChart }

function TPieChart.AddCategory(const ALabel: string;
  const AValue: Double): TCategoryElement;
begin
  Result := inherited;
  Result.Style.Color := THSV.Create(rmod(120 + 30 * FCategories.Count, 360), 0.28, 0.88);
end;

function TPieChart.AddSlice(const ALabel: string;
  const AValue: Double): TCategoryElement;
begin
  Result := AddCategory(ALabel, AValue)
end;

procedure TPieChart.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'startangle' then
      StartAngle := V.ToRealNumber
    else if S = 'x' then
      Origin := TPointD.Create(V.ToRealNumber, Origin.Y)
    else if S = 'y' then
      Origin := TPointD.Create(Origin.X, V.ToRealNumber)
    else if S = 'position' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        Origin := TPointD.Create(pos[0], pos[1]);
    end
    else if S = 'radius' then
      Radius := V.ToRealNumber
  end;
end;

constructor TPieChart.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FRadius := 1;
  FLabelVisible := True;
  FValueLabelVisible := True;
  FLabelPosition := DefaultLabelPosition;
  FValueLabelPosition := 10;
  FChartTypeName := 'Pie chart';
  Name := 'Pie chart';
  FDetailsOptionsFrmClass := TVis2D_PieChartSettingsFrm;
end;

procedure TPieChart.Draw;
var
  i: Integer;
  x: Double;
  R: TArray<Double>;
begin

  if Slices = nil then
    Exit;

  R := Slices.RelativeValues;

  x := FStartAngle;
  for i := 0 to Slices.Count - 1 do
  begin
    DrawSlice(Slices[i], R[i], i, x);
    x := x + R[i];
  end;

  x := FStartAngle;
  for i := 0 to Slices.Count - 1 do
  begin
    DrawSliceLabels(Slices[i], R[i], i, x);
    x := x + R[i];
  end;

  inherited;

end;

procedure TPieChart.DrawSlice(ASlice: TCategoryElement; const AFraction: Double;
  AIndex: Integer; const AOffset: Double);
const
  GreaterThanOrEqualTo180: array[Boolean] of TD2D1ArcSize = (D2D1_ARC_SIZE_SMALL, D2D1_ARC_SIZE_LARGE);
var
  Pie: ID2D1PathGeometry;
  Sink: ID2D1GeometrySink;
  Arc: TD2D1ArcSegment;
  D2d1Point: TD2D1Point2F;
begin

  Canvas.Brush.Color := ASlice.Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(ASlice.Style.Opacity / ASlice.Style.Opacity.MaxValue);
  Canvas.Pen.Color := ASlice.Style.BorderColor;
  Canvas.Pen.Width := idfcn(ASlice.Style.BorderWidth);
  Canvas.Pen.Style := psSolid;

  if AFraction > 0 then
    if Succeeded(D2DFactory.CreatePathGeometry(Pie)) then
    begin
      if Succeeded(Pie.Open(Sink)) then
      begin

        try
          if not FCtl.TrySpaceToD2d1(FOrigin, D2d1Point) then
            Exit;
          Sink.BeginFigure(D2d1Point, D2D1_FIGURE_BEGIN_FILLED);
          try
            if not FCtl.TrySpaceToD2d1(FOrigin + FRadius * Direction(2*Pi*AOffset), D2d1Point) then
              Exit;
            Sink.AddLine(D2d1Point);
            if not FCtl.TrySpaceToD2d1(FOrigin + FRadius * Direction(2*Pi*(AOffset + AFraction)), D2d1Point) then
              Exit;
            Arc.point := D2d1Point;
            Arc.size := D2D1SizeF(FView.ScaleX(FRadius), FView.ScaleY(FRadius));
            Arc.rotationAngle := 0.0;
            Arc.sweepDirection := D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE;
            Arc.arcSize := GreaterThanOrEqualTo180[AFraction >= 0.5];
            Sink.AddArc(Arc);
          finally
            Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
          end;
        finally
          Sink.Close;
        end;

        if ASlice.Style.Displacement <> 0 then
          Canvas.RenderTarget.SetTransform(
            TD2DMatrix3x2F.Translation(
              FView.Scale(
                ASlice.Style.Displacement * FRadius * Direction(2*Pi*(AOffset + AFraction / 2))
              )
            )
          );
        try
          Canvas.FillGeometry(Pie);
          Canvas.DrawGeometry(Pie);
        finally
          Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
        end;

      end;
    end;

end;

procedure TPieChart.DrawSliceLabels(ASlice: TCategoryElement;
  const AFraction: Double; AIndex: Integer; const AOffset: Double);
var
  Sz: TSize;
  S: string;
begin

  if AFraction <= 0 then
    Exit;

  if not FLabelVisible and not FValueLabelVisible then
    Exit;

  if ASlice.Style.Displacement <> 0 then
    Canvas.RenderTarget.SetTransform(
      TD2DMatrix3x2F.Translation(
        FView.Scale(
          ASlice.Style.Displacement * FRadius * Direction(2*Pi*(AOffset + AFraction / 2))
        )
      )
    );
  try

    if Assigned(FLabelFont) then
    begin
      Canvas.Font.Assign(FLabelFont);
      Canvas.Font.PixelsPerInch := 96;
      Canvas.Font.Size := idfcn(FLabelFont.Size);
    end
    else
    begin
      Canvas.Font.Assign(FCtl.Font);
      Canvas.Font.PixelsPerInch := 96;
      Canvas.Font.Size := 9; // invariant
    end;

    Canvas.Brush.Style := bsClear;

    if FLabelVisible then
    begin

      S := ASlice.&Label;
      Sz := Canvas.TextExtent(S);

      if Sz.cx > 2 * FView.ScaleX(FRadius) then
        Exit;

      if Sz.cy > 2 * FView.ScaleY(FRadius) then
        Exit;

      if FLabelPosition < 1 then
      begin
        with FCtl.SpaceToCanvas(FRadius * FLabelPosition * Direction(2*Pi*(AOffset + AFraction / 2))) do
          TextOut(X - Sz.Width / 2, Y - Sz.Height / 2, S);
      end
      else
      begin
        with
          FCtl.SpaceToCanvas(
            FRadius * Direction(2*Pi*(AOffset + AFraction / 2)),
            Round(-Sz.cx / 2 + (FLabelPosition + Sz.cx / 2) * Cos(2*Pi*(AOffset + AFraction / 2))),
            Round(-Sz.cy / 2 - (FLabelPosition + Sz.cy / 2) * Sin(2*Pi*(AOffset + AFraction / 2)))
          )
        do
          TextOut(X, Y, S);
      end;

    end;

    if FValueLabelVisible then
    begin

      if Assigned(FValueFont) then
      begin
        Canvas.Font.Assign(FValueFont);
        Canvas.Font.PixelsPerInch := 96;
        Canvas.Font.Size := idfcn(FValueFont.Size);
      end;

      var LValueFormat := FValueFormat;
      if LValueFormat.IsEmpty then
        if IsInteger(ASlice.Value) then
          LValueFormat := '#'
        else
          LValueFormat := '#.00';

      S := FormatFloat(LValueFormat, ASlice.Value, FCtl.InvFS).Replace(HYPHEN_MINUS, MINUS_SIGN);

      Sz := Canvas.TextExtent(S);

      if Sz.cx > 2 * FView.ScaleX(FRadius) then
        Exit;

      if Sz.cy > 2 * FView.ScaleY(FRadius) then
        Exit;

      if FValueLabelPosition < 1 then
      begin
        with FCtl.SpaceToCanvas(FRadius * FValueLabelPosition * Direction(2*Pi*(AOffset + AFraction / 2))) do
          TextOut(X - Sz.Width / 2, Y - Sz.Height / 2, S);
      end
      else
      begin
        with
          FCtl.SpaceToCanvas(
            FRadius * Direction(2*Pi*(AOffset + AFraction / 2)),
            Round(-Sz.cx / 2 + (FValueLabelPosition + Sz.cx / 2) * Cos(2*Pi*(AOffset + AFraction / 2))),
            Round(-Sz.cy / 2 - (FValueLabelPosition + Sz.cy / 2) * Sin(2*Pi*(AOffset + AFraction / 2)))
          )
        do
          TextOut(X, Y, S);
      end;

    end;

  finally
    Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
  end;

end;

procedure TPieChart.DrawSliceLabelsTo(ASVG: TSVGBuilder_VisCtl2D;
  ASlice: TCategoryElement; const AFraction: Double; AIndex: Integer;
  const AOffset: Double);
begin

  if AFraction <= 0 then
    Exit;

  if not FLabelVisible and not FValueLabelVisible then
    Exit;

  if ASlice.Style.Displacement <> 0 then
    ASVG
      .BeginGroup
      .Transform(
        Translation(
          FView.Scale(
            ASlice.Style.Displacement * FRadius * Direction(TwoPi * (AOffset + AFraction / 2))
          )
        )
      )
      .Append('pie slice transform');

  if FLabelVisible then
    if FLabelPosition < 1 then
      ASVG
        .Text(
          FCtl.SpaceToCanvas(FLabelPosition * FRadius * Direction(TwoPi * (AOffset + AFraction / 2))),
          ASlice.&Label
        )
        .&Class('category-label')
        .Font(FLabelFont)
        .TextAnchor(taCenter)
        .DominantBaseline(taVerticalCenter)
        .Append
    else
    begin
      if Assigned(FLabelFont) then
        Canvas.Font.Assign(FLabelFont)
      else
      begin
        Canvas.Font.Assign(FCtl.Font);
        Canvas.Font.Size := 9; // invariant
      end;
      var Sz := Canvas.TextExtent(ASlice.&Label);
      ASVG
        .Text(
          FCtl.SpaceToCanvas(
            FRadius * Direction(TwoPi * (AOffset + AFraction / 2)),
            (FLabelPosition + Sz.cx / 2) * Cos(2*Pi*(AOffset + AFraction / 2)),
           -(FLabelPosition + Sz.cy / 2) * Sin(2*Pi*(AOffset + AFraction / 2))
          ),
          ASlice.&Label
        )
        .&Class('category-label')
        .Font(FLabelFont)
        .TextAnchor(taCenter)
        .DominantBaseline(taVerticalCenter)
        .Append
    end;

  if FValueLabelVisible then
  begin

    var LValueFormat := FValueFormat;
    if LValueFormat.IsEmpty then
      if IsInteger(ASlice.Value) then
        LValueFormat := '#'
      else
        LValueFormat := '#.00';

    var S := FormatFloat(LValueFormat, ASlice.Value, FCtl.InvFS).Replace(HYPHEN_MINUS, MINUS_SIGN);

    if FValueLabelPosition < 1 then
      ASVG
        .Text(
          FCtl.SpaceToCanvas(FValueLabelPosition * FRadius * Direction(TwoPi * (AOffset + AFraction / 2))),
          S
        )
        .&Class('value-label')
        .Font(FValueFont)
        .TextAnchor(taCenter)
        .DominantBaseline(taVerticalCenter)
        .Append
    else
    begin
      if Assigned(FValueFont) then
        Canvas.Font.Assign(FValueFont)
      else
      begin
        Canvas.Font.Assign(FCtl.Font);
        Canvas.Font.Size := 9; // invariant
      end;
      var Sz := Canvas.TextExtent(S);
      ASVG
        .Text(
          FCtl.SpaceToCanvas(
            FRadius * Direction(TwoPi * (AOffset + AFraction / 2)),
            (FValueLabelPosition + Sz.cx / 2) * Cos(2*Pi*(AOffset + AFraction / 2)),
           -(FValueLabelPosition + Sz.cy / 2) * Sin(2*Pi*(AOffset + AFraction / 2))
          ),
          S
        )
        .&Class('value-label')
        .Font(FValueFont)
        .TextAnchor(taCenter)
        .DominantBaseline(taVerticalCenter)
        .Append
    end;
  end;

  if ASVG.Undefine('pie slice transform') then
    ASVG.EndGroup.Append;

end;

procedure TPieChart.DrawSliceTo(ASVG: TSVGBuilder_VisCtl2D; ASlice: TCategoryElement;
  const AFraction: Double; AIndex: Integer; const AOffset: Double);
begin

  if AFraction <= 0 then
    Exit;

  ASVG
    .Sector(
      FCtl.SpaceToCanvas(0, 0),
      FView.ScaleX(FRadius),
      FView.ScaleY(FRadius),
      TwoPi * AOffset,
      TwoPi * (AOffset + AFraction)
    )
    .&Class('slice')
    .Fill(ASlice.Style.Color)
    .FillOpacity(ASlice.Style.OpacityFraction)
    .Stroke(ASlice.Style.BorderColor)
    .Stroke(ASlice.Style.BorderWidth)
    .TransformIf(
      Translation(
        FView.Scale(
          ASlice.Style.Displacement * FRadius * Direction(TwoPi * (AOffset + AFraction / 2))
        )
      ),
      ASlice.Style.Displacement <> 0.0)
    .Append;

end;

procedure TPieChart.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  i: Integer;
  x: Double;
  R: TArray<Double>;
begin

  if Slices = nil then
    Exit;

  R := Slices.RelativeValues;

  x := FStartAngle;
  for i := 0 to Slices.Count - 1 do
  begin
    DrawSliceTo(ASVG, Slices[i], R[i], i, x);
    x := x + R[i];
  end;

  x := FStartAngle;
  for i := 0 to Slices.Count - 1 do
  begin
    DrawSliceLabelsTo(ASVG, Slices[i], R[i], i, x);
    x := x + R[i];
  end;

  inherited;

end;

procedure TPieChart.SetOrigin(const Value: TPointD);
begin
  if FOrigin <> Value then
  begin
    FOrigin := Value;
    Changed;
  end;
end;

procedure TPieChart.SetRadius(const Value: Double);
begin
  if FRadius <> Value then
  begin
    FRadius := Value;
    Changed;
  end;
end;

procedure TPieChart.SetStartAngle(const Value: Double);
begin
  if FStartAngle <> Value then
  begin
    FStartAngle := Value;
    Changed;
  end;
end;

{ TPixmap }

procedure TPixmap.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'pixmap' then
    begin
      var bm := (V as TAlgosimPixmap).Value.CreateGDIBitmap;
      try
        Bitmap := bm;
      finally
        bm.Free;
      end;
    end
    else if S = 'x' then
      Rect := TRectD.Create(V.ToRealNumber, Rect.Top, V.ToRealNumber + Rect.Width, Rect.Bottom)
    else if S = 'y' then
      Rect := TRectD.Create(Rect.Left, V.ToRealNumber, Rect.Right, V.ToRealNumber + Rect.Height)
    else if S = 'width' then
      Rect := TRectD.Create(Rect.Left, Rect.Top, Rect.Left + V.ToRealNumber, Rect.Bottom)
    else if S = 'height' then
      Rect := TRectD.Create(Rect.Left, Rect.Top, Rect.Right, Rect.Top + V.ToRealNumber)
    else if S = 'position' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        Rect := TRectD.Create(pos[0], pos[1], pos[0] + Rect.Width, pos[1] + Rect.Height);
    end;
  end;
  FStyle.Configure(ASettings);
end;

constructor TPixmap.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FBehindAxes := True;
  FStyle := TElementStyle.Create(ACtl, AView);
  FStyle.Parts := [espOpacity, espBorderColor, espBorderWidth];
  FStyle.BorderWidth := 0;
  FStyle.OnChange := Changed;
  FStyle.Name := 'Pixmap';
  OptionsFormClass := TVis2D_ElementSettingsFrm;
  Name := 'Pixmap';
end;

destructor TPixmap.Destroy;
begin
  FD2D1Bitmap := nil;
  FreeAndNil(FBitmap);
  FreeAndNil(FStyle);
  inherited;
end;

procedure TPixmap.Draw;
var
  R: TRectD;
  RR: TD2DRectF;
  RRR: TRect;
begin

  if FBitmap = nil then
    Exit;

  if FD2D1Bitmap = nil then
    FD2D1Bitmap := Canvas.CreateBitmap(FBitmap);

  R := FCtl.SpaceToCanvas(FRect);
  RR := R;
  Canvas.RenderTarget.DrawBitmap(FD2D1Bitmap, @RR, FStyle.Opacity / FStyle.Opacity.MaxValue);
  if Style.BorderWidth > 0 then
  begin
    Canvas.Pen.Color := Style.BorderColor;
    Canvas.Pen.Width := idfcn(Style.BorderWidth);
    Canvas.Pen.Style := psSolid;
    if R.TryToInt(RRR) then
      Canvas.Rectangle(RRR);
  end;

end;

procedure TPixmap.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  if FBitmap = nil then
    Exit;

  var R := FCtl.SpaceToCanvas(FRect, FRect.Top < FRect.Bottom);

  var MS := TMemoryStream.Create;
  var d: string;
  try
    FBitmap.SaveToStream(MS);
    d := TNetEncoding.Base64.EncodeBytesToString(MS.Memory, MS.Size);
  finally
    MS.Free;
  end;

  if not Title.IsEmpty or not Description.IsEmpty then
  begin
    ASVG.BeginGroup.Append('implicit image group');
    ASVG.GroupTitle(Title).Append;
    ASVG.GroupDescription(Description).Append;
  end;

  ASVG
    .Image(R, 'data:image/png;base64,' + d)
    .Attrib('preserveAspectRatio', 'none')
    .Opacity(Style.OpacityFraction)
    .Append;

  if Style.BorderWidth <> 0 then
    ASVG
      .Rect(R)
      .&Class('image-frame')
      .Fill('none')
      .Stroke(Style.BorderColor)
      .StrokeWidthPx(Style.BorderWidth)
      .Append;


  if ASVG.Undefine('implicit image group') then
    ASVG.EndGroup.Append;

end;

procedure TPixmap.FreeDeviceResources;
begin
  FD2D1Bitmap := nil;
  inherited;
end;

procedure TPixmap.SetBitmap(const Value: TBitmap);
begin
  if FBitmap = nil then
    FBitmap := TBitmap.Create;
  FBitmap.Assign(Value);
  FD2D1Bitmap := nil;
end;

procedure TPixmap.SetRect(const Value: TRectD);
begin
  if FRect <> Value then
  begin
    FRect := Value;
    Changed;
  end;
end;

procedure TPixmap.SetStyle(const Value: TElementStyle);
begin
  FStyle.Assign(Value);
end;

{ THeatmap }

constructor THeatmap.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  Style.Name := 'Heatmap';
  Name := 'Heatmap';
end;

{ TVectorField }

procedure TVectorField.AddVector(const APosition: TPointD;
  const AVector: TVectorD);
var
  M: Double;
begin
  if IsZero(AVector.Norm) then
    Exit;
  FVectors.Add(TVectorFieldElement.Create(APosition, AVector));
  M := AVector.Norm;
  if M > FMaxMag then
    FMaxMag := M;
end;

procedure TVectorField.BeginAddVector;
begin

end;

procedure TVectorField.Clear;
begin
  FMaxMag := 0.0;
  if FVectors.Count > 0 then
  begin
    FVectors.Clear;
    CreateMatrices;
    Changed;
  end;
end;

procedure TVectorField.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'arrowscale' then
      ArrowScale := V.ToRealNumber
    else if S = 'usemagnitude' then
      UseMagnitude := V.ToBoolean
  end;
  FStyle.Configure(ASettings);
end;

constructor TVectorField.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FVectors := TList<TVectorFieldElement>.Create;
  FMatrices := TList<TD2D1Matrix3x2F>.Create;
  FStyle := TElementStyle.Create(ACtl, AView);
  FStyle.BorderWidth := 0;
  FStyle.OnChange := Changed;
  FUseMag :=  True;
  FBehindAxes := True;
  FArrowScale := 1.0;
  Name := 'Vector field';
  OptionsFormClass := TVis2D_VectorFieldSettingsFrm;
end;

procedure TVectorField.CreateArrow;
var
  Sink: ID2D1GeometrySink;
const
  f = 1;
  a = f*1.0;
  b = f*10.0;
  c = 0.5;
  d = f*2.0;
  pts: array[0..6] of TD2D1Point2F =
    (
      (x: a;      y: b),
      (x: a;      y: -(1 - c) * b),
      (x: a + d;  y: -(1 - c) * b),
      (x: 0;      y: -b),
      (x: -a - d; y: -(1 - c) * b),
      (x: -a;     y: -(1 - c) * b),
      (x: -a;     y: b)
    );
begin

  FArrow := nil;
  if Succeeded(D2DFactory.CreatePathGeometry(FArrow)) then
  begin
    if Succeeded(FArrow.Open(Sink)) then
    begin
      try
        Sink.BeginFigure(pts[0], D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddLines(@pts[1], Length(pts) - 1);
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
    end;
  end;

end;

procedure TVectorField.CreateMatrices;
var
  q: Double;
  S: TD2DMatrix3x2F;
const
  F = 180.0 / Pi;
begin

  FMatrices.Clear;
  FMatrices.Capacity := FVectors.Count;

  S := TD2DMatrix3x2F.Scale(FArrowScale, FArrowScale, D2d1Origin);

  for var v in FVectors do
  begin

    if FUseMag then
    begin
      q := FArrowScale * v.Vector.Norm / FMaxMag;
      FMatrices.Add(
        TD2DMatrix3x2F.Scale(q, q, D2d1Origin)
          *
        TD2DMatrix3x2F.Rotation(90 - F*ArcTan2(v.Vector.Y, v.Vector.X), D2d1Origin)
      )
    end
    else
      FMatrices.Add(
        S
          *
        TD2DMatrix3x2F.Rotation(90 - F*ArcTan2(v.Vector.Y, v.Vector.X), D2d1Origin)
      );

  end;

end;

destructor TVectorField.Destroy;
begin
  FreeAndNil(FStyle);
  FreeAndNil(FMatrices);
  FreeAndNil(FVectors);
  inherited;
end;

procedure TVectorField.Draw;
var
  p: TD2D1Point2F;
begin

  if FArrow = nil then
    CreateArrow;

  Canvas.Brush.Color := FStyle.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(FStyle.Opacity / FStyle.Opacity.MaxValue);
  Canvas.Pen.Color := FStyle.BorderColor;
  Canvas.Pen.Width := idfcn(FStyle.BorderWidth);

  if Assigned(FArrow) and Assigned(FMatrices) and (FVectors.Count = FMatrices.Count) then
    try
      for var i := 0 to FVectors.Count - 1 do
      begin
        if not FCtl.TrySpaceToD2d1(FVectors[i].Position, p) then
          Continue;
        Canvas.RenderTarget.SetTransform(FMatrices[i] * TD2DMatrix3x2F.Translation(p));
        Canvas.FillGeometry(FArrow);
        if Canvas.Pen.Width > 0 then
          Canvas.DrawGeometry(FArrow);
      end;
    finally
      Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity)
    end;

end;

procedure TVectorField.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  if (FVectors = nil) or (FVectors.Count = 0) then
    Exit;

  if not ASVG.HasID('vf-arrow') then
  begin
    ASVG
      .DefSymbol('vf-arrow', '-6 -20 12 40')
      .Append;
    ASVG.GroupDescription('The arrow used for vector fields.').Append;
    ASVG
      .Polygon(
        [
          Point( 1,  10),
          Point( 1,  -5),
          Point( 3,  -5),
          Point( 0, -10),
          Point(-3,  -5),
          Point(-1,  -5),
          Point(-1,  10)
        ]
      )
      .Append;
    ASVG.EndDefSymbol;
  end;

  var LMaxMag := IfThen(FMaxMag > 0, FMaxMag, 1);

  ASVG
    .BeginGroup
    .&Class('vector-field')
    .Fill(FStyle.Color)
    .FillOpacity(FStyle.OpacityFraction)
    .Stroke(FStyle.BorderColor)
    .StrokeWidthPx(FStyle.BorderWidth)
    .Append;

  ASVG.GroupTitle(Title).Append;
  ASVG.GroupDescription(Description).Append;

  for var i := 0 to FVectors.Count - 1 do
    ASVG
      .Use('#vf-arrow')
      .Transform(
        Translation(FCtl.SpaceToCanvas(FVectors[i].Position))
          *
        RotationRad(PiDiv2 - ArcTan2(FVectors[i].Vector.Y, FVectors[i].Vector.X))
          *
        Scaling(FArrowScale * IfThen(FUseMag, FVectors[i].Vector.Norm / LMaxMag, 1))
          *
        Translation(TVectorD.Create(-6, -20))
      )
      .Width(12)
      .Height(40)
      .Append;

  ASVG.EndGroup.Append;

end;

procedure TVectorField.EndAddVector;
begin
  CreateMatrices;
  Changed;
end;

procedure TVectorField.SetArrowScale(const Value: Double);
begin
  if Value < 0 then
    Exit;
  if FArrowScale <> Value then
  begin
    FArrowScale := Value;
    CreateMatrices;
    Changed;
  end;
end;

procedure TVectorField.SetStyle(const Value: TElementStyle);
begin
  FStyle.Assign(Value);
end;

procedure TVectorField.SetUseMag(const Value: Boolean);
begin
  if FUseMag <> Value then
  begin
    FUseMag := Value;
    CreateMatrices;
    Changed;
  end;
end;

{ TVectorField.TVectorFieldElement }

constructor TVectorField.TVectorFieldElement.Create(const APosition: TPointD;
  const AVector: TVectorD);
begin
  Position := APosition;
  Vector := AVector;
end;

{ TDrawableOptionsFrm }

constructor TDrawableOptionsFrm.Create(AOwner: TComponent;
  ADrawable: TDrawable);
begin
  FDrawable := ADrawable;
  inherited Create(AOwner);
  Initialize;
  FInitialized := True;
end;

procedure TDrawableOptionsFrm.DrawableDestroyed(Sender: TObject);
begin

end;

procedure TDrawableOptionsFrm.Initialize;
begin

end;

procedure TDrawableOptionsFrm.Reassign(ADrawable: TDrawable);
begin
  if Assigned(FDrawable) and Initialized then
    UpdateDrawable;
  FDrawable := ADrawable;
  FInitialized := False;
  Initialize;
  FInitialized := True;
end;

procedure TDrawableOptionsFrm.UpdateDrawable;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{ TGeometry }

procedure TGeometry.Configure(ASettings: TAlgosimStructure);
begin
  inherited;
  FStyle.Configure(ASettings);
end;

constructor TGeometry.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FStyle := TElementStyle.Create(ACtl, AView);
  FStyle.OnChange := Changed;
  Name := 'Geometry';
  FStyle.Name := 'Geometry';
  OptionsFormClass := TVis2D_ElementSettingsFrm;
end;

destructor TGeometry.Destroy;
begin
  FreeAndNil(FStyle);
  inherited;
end;

procedure TGeometry.SetStyle(const Value: TElementStyle);
begin
  FStyle.Assign(Value);
end;

{ TLine }

procedure TLine.AdjustLineToMarkers(out AStart, AEnd: TPointD);
var
  P, D, v: TPointD;
  L, La, Lb: Double;
begin

  // AStart and AEnd are the *screen* coordinates of the adjusted endpoints.

  AStart := FCtl.SpaceToCanvas(FStart);
  AEnd := FCtl.SpaceToCanvas(FEnd);

  P := (AStart + AEnd) / 2;
  D := AEnd - AStart;
  L := D.Norm;

  if IsZero(L) then
    Exit;

  v := D / L;

  La := TPointD.Distance(AStart, p);
  Lb := TPointD.Distance(AEnd, p);

  AStart := P - Max(0, La - FStartMarker.LineDelta) * v;
  AEnd := P + Max(0, Lb - FEndMarker.LineDelta) * v;

end;

procedure TLine.AdjustLineToMarkersSVG(ASVG: TSVGBuilder_VisCtl2D; out AStart,
  AEnd: TPointD);
var
  P, D, v: TPointD;
  L, La, Lb: Double;
begin

  // AStart and AEnd are the *screen* coordinates of the adjusted endpoints.

  AStart := FCtl.SpaceToViewbox(ASVG.ViewBox, FStart);
  AEnd := FCtl.SpaceToViewbox(ASVG.ViewBox, FEnd);

  P := (AStart + AEnd) / 2;
  D := AEnd - AStart;
  L := D.Norm;

  if IsZero(L) then
    Exit;

  v := D / L;

  La := TPointD.Distance(AStart, p);
  Lb := TPointD.Distance(AEnd, p);

  AStart := P - Max(0, La - FStartMarker.LineDelta) * v;
  AEnd := P + Max(0, Lb - FEndMarker.LineDelta) * v;

end;

procedure TLine.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'start' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        Start := TPointD.Create(pos[0], pos[1]);
    end
    else if S = 'end' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        &End := TPointD.Create(pos[0], pos[1]);
    end
  end;
end;

constructor TLine.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  Name := 'Line';
  Style.Name := Name;
  Style.Parts := [espBorderColor, espBorderWidth];
  FStartMarker := TLineEndMarkerDrawable.Create(ACtl, AView);
  FStartMarker.OnChange := Changed;
  FStartMarker.Line := Self;
  FStartMarker.Name := 'Start';
  FEndMarker := TLineEndMarkerDrawable.Create(ACtl, AView);
  FEndMarker.OnChange := Changed;
  FEndMarker.Line := Self;
  FEndMarker.Name := 'End';
  OptionsFormClass := TVis2D_LineSettingsFrm;
end;

function TLine.CreateReference: TAlgosimReference;
begin
  Result := inherited;
  Result.AddSubref('start', FStartMarker.CreateReference);
  Result.AddSubref('end', FEndMarker.CreateReference);
end;

destructor TLine.Destroy;
begin
  FreeAndNil(FEndMarker);
  FreeAndNil(FStartMarker);
  inherited;
end;

procedure TLine.Draw;
var
  LStart, LEnd: TPointD;
begin
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;
  AdjustLineToMarkers(LStart, LEnd);
  DrawLine(LStart, LEnd);
  FStartMarker.Draw;
  FEndMarker.Draw;
end;

procedure TLine.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  LStart, LEnd: TPointD;
begin

  inherited;

  var LActualStart := FCtl.SpaceToViewbox(ASVG.ViewBox, FStart);
  var LActualEnd := FCtl.SpaceToViewbox(ASVG.ViewBox, FEnd);
  AdjustLineToMarkersSVG(ASVG, LStart, LEnd);

  ASVG
    .Line(LStart, LEnd)
    .Stroke(Style.BorderColor)
    .StrokeWidthPx(Style.BorderWidth)
    .MarkerStart(FStartMarker.GetSVGID(ASVG))
    .MarkerEnd(FEndMarker.GetSVGID(ASVG))
    .AttribIf('asd:x1', LActualStart.X, not SameValue(LStart.X, LActualStart.X))
    .AttribIf('asd:y1', LActualStart.Y, not SameValue(LStart.Y, LActualStart.Y))
    .AttribIf('asd:x2', LActualEnd.X, not SameValue(LEnd.X, LActualEnd.X))
    .AttribIf('asd:y2', LActualEnd.Y, not SameValue(LEnd.Y, LActualEnd.Y))
    .Append;

end;

function TLine.DX: Double;
begin
  Result := FEnd.X - FStart.X;
end;

function TLine.DY: Double;
begin
  Result := FEnd.Y - FStart.Y;
end;

procedure TLine.SetEnd(const Value: TPointD);
begin
  if FEnd <> Value then
  begin
    FEnd := Value;
    Changed;
  end;
end;

procedure TLine.SetEndMarker(const Value: TLineEndMarkerDrawable);
begin
  FEndMarker.Assign(Value);
end;

procedure TLine.SetStart(const Value: TPointD);
begin
  if FStart <> Value then
  begin
    FStart := Value;
    Changed;
  end;
end;

procedure TLine.SetStartMarker(const Value: TLineEndMarkerDrawable);
begin
  FStartMarker.Assign(Value);
end;

{ TRectangle }

procedure TRectangle.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'top' then
      Rect := TRectD.Create(Rect.Left, V.ToRealNumber, Rect.Right, Rect.Bottom)
    else if S = 'left' then
      Rect := TRectD.Create(V.ToRealNumber, Rect.Top, Rect.Right, Rect.Bottom)
    else if S = 'right' then
      Rect := TRectD.Create(Rect.Left, Rect.Top, V.ToRealNumber, Rect.Bottom)
    else if S = 'bottom' then
      Rect := TRectD.Create(Rect.Left, Rect.Top, Rect.Right, V.ToRealNumber)
    else if S = 'rotation' then
      Angle := V.ToRealNumber
  end;
end;

constructor TRectangle.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  Name := 'Rectangle';
  Style.Name := Name;
  Style.Parts := [espColor, espOpacity, espBorderColor, espBorderWidth];
end;

procedure TRectangle.Draw;
begin
  Canvas.Brush.Color := Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;
  if FRotAngle = 0.0 then
    DrawRectSp(FRect)
  else
    DrawRectSp(FRect, FRotAngle);
end;

procedure TRectangle.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  var R := FCtl.SpaceToViewbox(ASVG.ViewBox, FRect.SwapTopBottom);

  ASVG
    .Rect(R)
    .Fill(Style.Color)
    .FillOpacity(Style.OpacityFraction)
    .Stroke(Style.BorderColor)
    .StrokeWidthPx(Style.BorderWidth)
    .TransformIf(RotationRad(-FRotAngle, R.Left, R.Bottom), FRotAngle <> 0.0)
    .Append;

end;

procedure TRectangle.SetRect(const Value: TRectD);
begin
  if FRect <> Value then
  begin
    FRect := Value;
    Changed;
  end;
end;

procedure TRectangle.SetRotAngle(const Value: Double);
begin
  if FRotAngle <> Value then
  begin
    FRotAngle := Value;
    Changed;
  end;
end;

{ TCircle }

procedure TCircle.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'position' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        Center := TPointD.Create(pos[0], pos[1]);
    end
    else if S = 'radius' then
      Radius := V.ToRealNumber
  end;
end;

constructor TCircle.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  Name := 'Circle';
  FRadius := 1.0;
  Style.Name := Name;
  Style.Parts := [espColor, espOpacity, espBorderColor, espBorderWidth];
end;

procedure TCircle.Draw;
begin
  Canvas.Brush.Color := Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;
  DrawDiskSp(FCenter, FRadius);
end;

procedure TCircle.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  ASVG
    .Ellipse2(
      FCtl.SpaceToViewbox(ASVG.ViewBox, FCenter),
      FCtl.SpaceToViewboxX(ASVG.ViewBox, FRadius),
      FCtl.SpaceToViewboxY(ASVG.ViewBox, FRadius)
    )
    .Fill(Style.Color)
    .FillOpacity(Style.OpacityFraction)
    .Stroke(Style.BorderColor)
    .StrokeWidthPx(Style.BorderWidth)
    .Append;

end;

procedure TCircle.SetCenter(const Value: TPointD);
begin
  if FCenter <> Value then
  begin
    FCenter := Value;
    Changed;
  end;
end;

procedure TCircle.SetRadius(const Value: Double);
begin
  if FRadius <> Value then
  begin
    FRadius := Value;
    Changed;
  end;
end;

{ TPolygon }

procedure TPolygon.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'vertices' then
      Points := ASOToR2Array(V)
  end;
end;

constructor TPolygon.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  Name := 'Polygon';
  Style.Name := Name;
  Style.Parts := [espColor, espOpacity, espBorderColor, espBorderWidth];
end;

procedure TPolygon.Draw;
var
  Polygon: ID2D1PathGeometry;
  Sink: ID2D1GeometrySink;
  pts: TArray<TD2D1Point2F>;
  i: Integer;
begin

  if (Style.Opacity <> 0) or (Style.BorderWidth > 0) then
  begin

    if Length(FPoints) < 3 then
      Exit;

    SetLength(pts, Length(FPoints));
    for i := 0 to High(FPoints) do
      if not FCtl.TrySpaceToD2d1(FPoints[i], pts[i]) then
        Exit;

    if Succeeded(D2DFactory.CreatePathGeometry(Polygon)) then
    begin
      if Succeeded(Polygon.Open(Sink)) then
      begin
        try
          Sink.BeginFigure(pts[0], D2D1_FIGURE_BEGIN_FILLED);
          try
            Sink.AddLines(@pts[1], Length(pts) - 1);
          finally
            Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
          end;
        finally
          Sink.Close;
        end;
      end;
    end;

    Canvas.Brush.Color := Style.Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
    Canvas.Pen.Color := Style.BorderColor;
    Canvas.Pen.Width := idfcn(Style.BorderWidth);
    Canvas.Pen.Style := psSolid;

    if Style.Opacity <> 0 then
      Canvas.FillGeometry(Polygon);

    if Style.BorderWidth > 0 then
      Canvas.DrawGeometry(Polygon);

  end;

end;

procedure TPolygon.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  var LPoints: TArray<TPointD>;
  SetLength(LPoints, Length(FPoints));
  for var i := 0 to High(FPoints) do
    LPoints[i] := FCtl.SpaceToViewbox(ASVG.ViewBox, FPoints[i]);

  ASVG
    .Polygon(LPoints)
    .Fill(Style.Color)
    .FillOpacity(Style.OpacityFraction)
    .Stroke(Style.BorderColor)
    .StrokeWidthPx(Style.BorderWidth)
    .Append;

end;

procedure TPolygon.SetPoints(const Value: TArray<TPointD>);
begin
  FPoints := Copy(Value);
  Changed;
end;

{ TText }

procedure TText.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'text' then
      Text := V.ToString
    else if S = 'fontname' then
      Font.Name := V.ToString
    else if S = 'fontsize' then
      Font.Size := V.ToInt32
    else if S = 'bold' then
      if V.ToBoolean then
        Font.Style := Font.Style + [fsBold]
      else
        Font.Style := Font.Style - [fsBold]
    else if S = 'italic' then
      if V.ToBoolean then
        Font.Style := Font.Style + [fsItalic]
      else
        Font.Style := Font.Style - [fsItalic]
    else if S = 'underline' then
      if V.ToBoolean then
        Font.Style := Font.Style + [fsUnderline]
      else
        Font.Style := Font.Style - [fsUnderline]
    else if S = 'strikethrough' then
      if V.ToBoolean then
        Font.Style := Font.Style + [fsStrikeout]
      else
        Font.Style := Font.Style - [fsStrikeout]
    else if S = 'textcolor' then
      Font.Color := V.ToColor
    else if S = 'boxed' then
      Boxed := V.ToBoolean
    else if S = 'position' then
    begin
      var pos := V.AsRealVector;
      if pos.Dimension = 2 then
        Position := TPointD.Create(pos[0], pos[1]);
    end
    else if S = 'width' then
      Width := V.ToRealNumber
    else if S = 'height' then
      Height := V.ToRealNumber
    else if S = 'userect' then
      UseRect := V.ToBoolean
    else if S = 'anchorpoint' then
      AnchorPoint := TAnchorPoint.FromString(V.ToString)
    else if S = 'zoomtext' then
      ZoomText := V.ToBoolean
    else if S = 'zoomrect' then
      ZoomRect := V.ToBoolean
    else if S = 'alignment' then
      Align := AlignmentFromString(V.ToString)
    else if S = 'verticalalignment' then
      VertAlign := VerticalAlignmentFromString(V.ToString)
    else if S = 'padding' then
      Padding := V.ToInt32
    else if S = 'textanchorpoint' then
      TextAnchorPoint := TAnchorPoint.FromString(V.ToString)
  end;
end;

constructor TText.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FFont := TFont.Create;
  FFont.Assign(ACtl.Font);
  FFont.Size := 9; // invariant
  FFont.OnChange := Changed;
  FText := 'Text';
  Name := 'Text';
  Style.Name := Name;
  Style.Parts := [espColor, espOpacity, espBorderColor, espBorderWidth];
  Style.Opacity := 64;
  FPadding := 4;
  FAlign := taCenter;
  FVertAlign := taVerticalCenter;
  OptionsFormClass := TVis2D_TextSettingsFrm;
end;

destructor TText.Destroy;
begin
  FreeAndNil(FFont);
  inherited;
end;

procedure TText.Draw;
const
  HorizontalAlignments: array[TAlignment] of TTextFormats =
    (tfLeft, tfRight, tfCenter);
  VerticalAlignments: array[TVerticalAlignment] of TTextFormats =
    (tfTop, tfBottom, tfVerticalCenter);
var
  R: TRect;
  S: string;
  Sz: TSize;
  W, H: Double;
begin

  inherited;

  Canvas.Brush.Color := Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;
  Canvas.Font.Assign(FFont);
  Canvas.Font.PixelsPerInch := 96;
  Canvas.Font.Size := idfcn(FFont.Size);

  S := FText;
  Sz := Canvas.TextExtent(S);

  if not FCtl.SpaceToCanvas(FPosition).TryToInt(R.TopLeft) then
    Exit;

  if FUseRect then
  begin

    if FZoomRect then
    begin
      W := FView.ScaleX(FWidth);
      H := FView.ScaleY(FHeight)
    end
    else
    begin
      W := FWidth;
      H := FHeight
    end;

    if not InRange(W, 0, Integer.MaxValue) or not InRange(H, 0, Integer.MaxValue) then
      Exit;

    R.Width := Round(W);
    R.Height := Round(H);

  end
  else
  begin

    R.Width := Sz.cx + 2*FPadding;
    R.Height := Sz.cy + 2*FPadding;

  end;

  AlignRect(R, FAnchorPoint);

  if FBoxed then
    Canvas.Rectangle(R);

  Canvas.Brush.Style := bsClear;

  if FZoomText then
    Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Scale(10 / FView.XSpan, 10 / FView.YSpan, R.CenterPoint));
  try
    if FUseRect then
      Canvas.TextRect(R, S,
        [tfSingleLine, HorizontalAlignments[FAlign], VerticalAlignments[FVertAlign]])
    else
      Canvas.TextOut(R.Left + FPadding, R.Top + FPadding, S);
  finally
    if FZoomText then
      Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
  end;

end;

procedure TText.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin

  inherited;

  Canvas.Font.Assign(FFont);
  var Sz := Canvas.TextExtent(FText);

  var R: TRectD;
  R.TopLeft := FCtl.SpaceToViewbox(ASVG.ViewBox, FPosition);

  if FUseRect then
  begin

    var W, H: Double;

    if FZoomRect then
    begin
      W := FView.ScaleX(FWidth);
      H := FView.ScaleY(FHeight)
    end
    else
    begin
      W := FWidth;
      H := FHeight
    end;

    R.Width := W;
    R.Height := H;

  end
  else
  begin

    R.Width := Sz.cx + 2*FPadding;
    R.Height := Sz.cy + 2*FPadding;

  end;

  AlignRect(R, FAnchorPoint);

  if FBoxed then
    ASVG
      .Rect(R)
      .&Class('text-frame')
      .Fill(Style.Color)
      .FillOpacity(Style.OpacityFraction)
      .Stroke(Style.BorderColor)
      .StrokeWidthPx(Style.BorderWidth)
      .Append;

  var P := R.TopLeft;

  if FUseRect then
  begin
    case FAlign of
      taLeftJustify:
        P.X := R.Left;
      taCenter:
        P.X := R.MidPoint.X;
      taRightJustify:
        P.X := R.Right;
    end;
    case FVertAlign of
      taAlignTop:
        P.Y := R.Top;
      taVerticalCenter:
        P.Y := R.MidPoint.Y;
      taAlignBottom:
        P.Y := R.Bottom;
    end;
  end
  else
    P := R.TopLeft + TVectorD.Create(FPadding, FPadding);

  var txt :=
    ASVG
      .Text(P, FText)
      .Font(FFont);

  if FUseRect then
    txt := txt
      .TextAnchor(FAlign)
      .DominantBaseline(FVertAlign)
  else
    txt := txt
      .DominantBaseline(taAlignTop);

  txt.Append;

end;

function TText.GetTextAnchorPoint: TAnchorPoint;
const
  AnchorPoints: array[TAlignment, TVerticalAlignment] of TAnchorPoint =
    (          {top}         {bottom}          {centre}
      {left}   (apTopLeft,    apBottomLeft,     apLeft),
      {right}  (apTopRight,   apBottomRight,    apRight),
      {centre} (apTop,        apBottom,         apCenter)
    );
begin
  Result := AnchorPoints[FAlign, FVertAlign];
end;

procedure TText.SetAlign(const Value: TAlignment);
begin
  if FAlign <> Value then
  begin
    FAlign := Value;
    Changed;
  end;
end;

procedure TText.SetAnchorPoint(const Value: TAnchorPoint);
begin
  if FAnchorPoint <> Value then
  begin
    FAnchorPoint := Value;
    Changed;
  end;
end;

procedure TText.SetBoxed(const Value: Boolean);
begin
  if FBoxed <> Value then
  begin
    FBoxed := Value;
    Changed;
  end;
end;

procedure TText.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TText.SetHeight(const Value: Double);
begin
  if FHeight <> Value then
  begin
    FHeight := Value;
    Changed;
  end;
end;

procedure TText.SetPadding(const Value: Integer);
begin
  if FPadding <> Value then
  begin
    FPadding := Value;
    Changed;
  end;
end;

procedure TText.SetPosition(const Value: TPointD);
begin
  if FPosition <> Value then
  begin
    FPosition := Value;
    Changed;
  end;
end;

procedure TText.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Changed;
  end;
end;

procedure TText.SetTextAnchorPoint(const Value: TAnchorPoint);
begin
  case Value of
    apTopLeft,
    apTop,
    apTopRight:
      VertAlign := taAlignTop;
    apLeft,
    apCenter,
    apRight:
      VertAlign := taVerticalCenter;
    apBottomLeft,
    apBottom,
    apBottomRight:
      VertAlign := taAlignBottom;
  end;
  case Value of
    apTopLeft,
    apLeft,
    apBottomLeft:
      Align := taLeftJustify;
    apTop,
    apCenter,
    apBottom:
      Align := taCenter;
    apTopRight,
    apRight,
    apBottomRight:
      Align := taRightJustify;
  end;
end;

procedure TText.SetUseRect(const Value: Boolean);
begin
  if FUseRect <> Value then
  begin
    FUseRect := Value;
    Changed;
  end;
end;

procedure TText.SetVertAlign(const Value: TVerticalAlignment);
begin
  if FVertAlign <> Value then
  begin
    FVertAlign := Value;
    Changed;
  end;
end;

procedure TText.SetWidth(const Value: Double);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Changed;
  end;
end;

procedure TText.SetZoomRect(const Value: Boolean);
begin
  if FZoomRect <> Value then
  begin
    FZoomRect := Value;
    Changed;
  end;
end;

procedure TText.SetZoomText(const Value: Boolean);
begin
  if FZoomText <> Value then
  begin
    FZoomText := Value;
    Changed;
  end;
end;

{ TLineEndMarkerHelper }

class function TLineEndMarkerHelper.FromString(const S: string): TLineEndMarker;
begin
  for var lem := Low(TLineEndMarker) to High(TLineEndMarker) do
    if lem.ToString = S then
      Exit(lem);
  raise Exception.CreateFmt('Unknown line end marker: "%s"', [S]);
end;

function TLineEndMarkerHelper.IsFilled: Boolean;
begin
  Result := Self in [lemSolidArrow, lemSemiArrow, lemDisk, lemSquare, lemSquare2];
end;

function TLineEndMarkerHelper.ToString: string;
begin
  if InRange(Ord(Self), Ord(Low(TLineEndMarker)), Ord(High(TLineEndMarker))) then
    Result := MarkerNames[Self]
  else
    Result := '';
end;

{ TLineEndMarkerDrawable }

procedure TLineEndMarkerDrawable.AdaptToLine;
begin

  if FLine = nil then
    Exit;

  FWidth := FLine.Style.BorderWidth;
  if FLine.FEndMarker = Self then
  begin
    FPoint := FLine.&End;
    FAngle := ArcTan2(-FView.ScaleY(FLine.DY), FView.ScaleX(FLine.DX));
  end
  else
  begin
    FPoint := FLine.Start;
    FAngle := Pi + ArcTan2(-FView.ScaleY(FLine.DY), FView.ScaleX(FLine.DX));
  end

end;

procedure TLineEndMarkerDrawable.Assign(Source: TPersistent);
begin
  if Source is TLineEndMarkerDrawable then
  begin
    FLineEndMarker := TLineEndMarkerDrawable(Source).FLineEndMarker;
    FPoint := TLineEndMarkerDrawable(Source).FPoint;
    FAngle := TLineEndMarkerDrawable(Source).FAngle;
    FSizeX := TLineEndMarkerDrawable(Source).FSizeX;
    FSizeY := TLineEndMarkerDrawable(Source).FSizeY;
    FWidth := TLineEndMarkerDrawable(Source).FWidth;
    FColor := TLineEndMarkerDrawable(Source).FColor;
  end
  else
    inherited;
end;

procedure TLineEndMarkerDrawable.Configure(ASettings: TAlgosimStructure);
var
  i: Integer;
  S: string;
  V: TAlgosimObject;
begin
  inherited;
  for i := 1 to ASettings.MemberCount do
  begin
    S := ASettings.Members[i].Name;
    V := ASettings.Members[i].Value;
    if S = 'shape' then
      Kind := TLineEndMarker.FromString(V.ToString)
    else if S = 'filled' then
      Filled := V.ToBoolean
    else if S = 'sizex' then
      SizeX := V.ToRealNumber
    else if S = 'sizey' then
      SizeY := V.ToRealNumber
    else if S = 'size' then
      Size := V.ToRealNumber
    else if S = 'linewidth' then
      Width := V.ToInt32
    else if S = 'color' then
      Color := V.ToColor
    else if S = 'linecolor' then
      LineColor := V.ToBoolean
  end;
end;

constructor TLineEndMarkerDrawable.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FFilled := True;
  FSizeX := 4.0;
  FSizeY := 4.0;
  FWidth := 1;
  FColor := clNavy;
  FLineColor := True;
  FName := 'Line ending';
  OptionsFormClass := TVis2D_LineEndSettingsFrm;
end;

procedure TLineEndMarkerDrawable.Draw;
var
  LColor: TColor;
begin

  inherited;

  if FLineEndMarker = lemNone then
    Exit;

  if Assigned(FLine) then
    AdaptToLine
  else
    Exit;

  if Assigned(FLine) and FLineColor then
    LColor := FLine.Style.BorderColor
  else
    LColor := FColor;

  Canvas.Brush.Color := LColor;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Color := LColor;
  Canvas.Pen.Width := idfcn(FWidth);
  Canvas.Pen.Style := psSolid;
  DrawLineEndMarker(FLineEndMarker, FFilled, FPoint, FSizeX, FSizeY, FAngle);

end;

procedure TLineEndMarkerDrawable.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
begin
  inherited;
end;

function TLineEndMarkerDrawable.GetSVGID(ASVG: TSVGBuilder_VisCtl2D): string;
var
  LColor: TColor;
begin

  Result := '';

  if FLineEndMarker = lemNone then
    Exit;

  if Assigned(FLine) then
    AdaptToLine
  else
    Exit;

  if FLineColor then
    LColor := FLine.Style.BorderColor
  else
    LColor := FColor;

  var LMarkerDef := Default(TSVGBuilder_VisCtl2D.TMarkerDef);
  LMarkerDef.Shape := FLineEndMarker;
  LMarkerDef.Filled := FFilled;
  LMarkerDef.Start := FLine.FStartMarker = Self;
  LMarkerDef.Width := Round(FSizeX / LMarkerDef.SizeUnit);
  LMarkerDef.Height := Round(FSizeY / LMarkerDef.SizeUnit);
  LMarkerDef.LineWidth := FLine.Style.BorderWidth;
  LMarkerDef.Color := LColor;

  Result := ASVG.GetMarkerName(FCtl, LMarkerDef, LineDelta);

end;

function TLineEndMarkerDrawable.LineDelta: Double;
begin
  case Kind of
    lemNone:
      Result := 0.0;
    lemLineArrow:
      if Assigned(FLine) then
        Result := FLine.Style.BorderWidth
      else
        Result := FWidth;
    lemSolidArrow:
      Result := FSizeY * LEM_CONST * Sqrt2;
    lemSemiArrow:
      Result := FSizeY * LEM_CONST * InvSqrt2;
    lemDisk:
      if FFilled then
        Result := 0.0
      else
        Result := FSizeY * LEM_CONST / 2;
    lemSquare:
      if FFilled then
        Result := 0.0
      else
        Result := FSizeY * LEM_CONST * InvSqrt2;
    lemSquare2:
      if FFilled then
        Result := 0.0
      else
        Result := FSizeY * LEM_CONST / 2;
    lemLine:
      Result := 0.0;
    lemBroken:
      if Assigned(FLine) then
        Result := -FLine.Style.BorderWidth / 2
      else
        Result := -FWidth / 2;
  else
    Result := 0.0;
  end;
end;

procedure TLineEndMarkerDrawable.SetAngle(const Value: Double);
begin
  if FAngle <> Value then
  begin
    FAngle := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetFilled(const Value: Boolean);
begin
  if FFilled <> Value then
  begin
    FFilled := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetLineColor(const Value: Boolean);
begin
  if FLineColor <> Value then
  begin
    FLineColor := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetLineEndMarker(const Value: TLineEndMarker);
begin
  if FLineEndMarker <> Value then
  begin
    FLineEndMarker := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetPoint(const Value: TPointD);
begin
  if FPoint <> Value then
  begin
    FPoint := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetSize(const Value: Double);
begin
  if (FSizeX <> Value) or (FSizeY <> Value) then
  begin
    FSizeX := Value;
    FSizeY := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetSizeX(const Value: Double);
begin
  if FSizeX <> Value then
  begin
    FSizeX := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetSizeY(const Value: Double);
begin
  if FSizeY <> Value then
  begin
    FSizeY := Value;
    Changed;
  end;
end;

procedure TLineEndMarkerDrawable.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Changed;
  end;
end;

{ TRegion }

constructor TRegion.Create(ACtl: TVisCtl2D; AView: TView2D);
begin
  inherited;
  FPoints := False;
  FLines := False;
  FArea := True;
  FValidateRegion := True;
  Name := 'Region';
end;

procedure TRegion.Draw;
var
  i: Integer;
  Trapezoid: ID2D1PathGeometry;
  Sink: ID2D1GeometrySink;
  D2d1Point: TD2D1Point2F;
  PntFcn: function(const X1, X2: Double): TPointD;
  UnboundMin, UnboundMax: function(const APoint: TD2D1Point2F): TD2D1Point2F of object;
begin

  Canvas.Brush.Color := Style.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Handle.SetOpacity(Style.Opacity / Style.Opacity.MaxValue);
  Canvas.Pen.Color := Style.BorderColor;
  Canvas.Pen.Width := idfcn(Style.BorderWidth);
  Canvas.Pen.Style := psSolid;

  var FPointSizeDiv2 := FPointSize / 2;

  case FAxis of
    TCartesianAxis.X:
      begin
        PntFcn := FCtl.P;
        UnboundMin := FCtl.UnboundYMin;
        UnboundMax := FCtl.UnboundYMax;
      end;
    TCartesianAxis.Y:
      begin
        PntFcn := FCtl.Q;
        UnboundMin := FCtl.UnboundXMin;
        UnboundMax := FCtl.UnboundXMax;
      end;
  else
    Exit;
  end;

  if not FUnboundedMin then
    UnboundMin := FCtl.UnboundIdentity;

  if not FUnboundedMax then
    UnboundMax := FCtl.UnboundIdentity;

  if Assigned(FSliceData) then
  begin

    if FArea and (Length(FSliceData) >= 2) then
    begin
      if Succeeded(D2DFactory.CreatePathGeometry(Trapezoid)) then
      begin
        if Succeeded(Trapezoid.Open(Sink)) then
        begin
          try
            if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[0].t, FSliceData[0].a), D2d1Point) then
              Exit;
            Sink.BeginFigure(UnboundMin(D2d1Point), D2D1_FIGURE_BEGIN_FILLED);
            try
              for i := 1 to High(FSliceData) do
              begin
                if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[i].t, FSliceData[i].a), D2d1Point) then
                  Exit;
                Sink.AddLine(UnboundMin(D2d1Point));
              end;
              for i := High(FSliceData) downto 0 do
              begin
                if (FSliceData[i].b >= FSliceData[i].a) or not FValidateRegion then
                begin
                  if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[i].t, FSliceData[i].b), D2d1Point) then
                    Exit;
                end
                else
                begin
                  if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[i].t, FSliceData[i].a), D2d1Point) then
                    Exit;
                end;
                Sink.AddLine(UnboundMax(D2d1Point));
              end;
            finally
              Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
            end;
          finally
            Sink.Close;
          end;
          Canvas.FillGeometry(Trapezoid);
        end;
      end;
    end;

    if FLines and (Length(FSliceData) >= 2) then
    begin
      if not FUnboundedMin and Succeeded(D2DFactory.CreatePathGeometry(Trapezoid)) then
      begin
        if Succeeded(Trapezoid.Open(Sink)) then
        begin
          try
            if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[0].t, FSliceData[0].a), D2d1Point) then
              Exit;
            Sink.BeginFigure(D2d1Point, D2D1_FIGURE_BEGIN_HOLLOW);
            try
              for i := 1 to High(FSliceData) do
              begin
                if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[i].t, FSliceData[i].a), D2d1Point) then
                  Exit;
                Sink.AddLine(D2d1Point);
              end;
            finally
              Sink.EndFigure(D2D1_FIGURE_END_OPEN);
            end;
          finally
            Sink.Close;
          end;
          Canvas.DrawGeometry(Trapezoid);
        end;
      end;
      if not FUnboundedMax and Succeeded(D2DFactory.CreatePathGeometry(Trapezoid)) then
      begin
        if Succeeded(Trapezoid.Open(Sink)) then
        begin
          try
            if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[0].t, FSliceData[0].b), D2d1Point) then
              Exit;
            Sink.BeginFigure(D2d1Point, D2D1_FIGURE_BEGIN_HOLLOW);
            try
              for i := 1 to High(FSliceData) do
              begin
                if not FCtl.TrySpaceToD2d1(PntFcn(FSliceData[i].t, FSliceData[i].b), D2d1Point) then
                  Exit;
                Sink.AddLine(D2d1Point);
              end;
            finally
              Sink.EndFigure(D2D1_FIGURE_END_OPEN);
            end;
          finally
            Sink.Close;
          end;
          Canvas.DrawGeometry(Trapezoid);
        end;
      end;
    end;

    if FPoints then
      for i := Low(FSliceData) to High(FSliceData) do
      begin
        if not FUnboundedMin then
          DrawDiskSpPx(PntFcn(FSliceData[i].t, FSliceData[i].a), FPointSizeDiv2);
        if not FUnboundedMax then
          DrawDiskSpPx(PntFcn(FSliceData[i].t, FSliceData[i].b), FPointSizeDiv2);
      end;

  end;

end;

procedure TRegion.DrawToContent(ASVG: TSVGBuilder_VisCtl2D);
var
  PntFcn: function(const X1, X2: Double): TPointD;
  UnboundMin, UnboundMax: function(const APoint: TD2DPoint2f): TD2DPoint2f of object;
begin

  inherited;

  if FSliceData = nil then
    Exit;

  var FPointSizeDiv2 := FPointSize / 2;

  case FAxis of
    TCartesianAxis.X:
      begin
        PntFcn := FCtl.P;
        UnboundMin := FCtl.UnboundYMin;
        UnboundMax := FCtl.UnboundYMax;
      end;
    TCartesianAxis.Y:
      begin
        PntFcn := FCtl.Q;
        UnboundMin := FCtl.UnboundXMin;
        UnboundMax := FCtl.UnboundXMax;
      end;
  else
    Exit;
  end;

  if not FUnboundedMin then
    UnboundMin := FCtl.UnboundIdentity;

  if not FUnboundedMax then
    UnboundMax := FCtl.UnboundIdentity;

  if FArea and (Length(FSliceData) >= 2) then
  begin
    var pts: TArray<TPointD>;
    SetLength(pts, Length(FSliceData) * 2);
    for var i := 0 to High(FSliceData) do
      pts[i] := UnboundMin(FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].a)));
    for var i := High(FSliceData) downto 0 do
      if (FSliceData[i].b >= FSliceData[i].a) or not FValidateRegion then
        pts[Length(FSliceData) + High(FSliceData) - i] :=
          UnboundMax(FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].b)))
      else
        pts[Length(FSliceData) + High(FSliceData) - i] :=
          UnboundMax(FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].a)));
    ASVG
      .Polygon(pts)
      .Fill(Style.Color)
      .FillOpacity(Style.OpacityFraction)
      .Stroke('none')
      .Append;
  end;

  if FLines and (Length(FSliceData) >= 2) then
  begin
    if not FUnboundedMin then
    begin
      var pts: TArray<TPointD>;
      SetLength(pts, Length(FSliceData));
      for var i := 0 to High(FSliceData) do
        pts[i] := FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].a));
      ASVG
        .PolyLine(pts)
        .&Class('low-bound')
        .Fill('none')
        .Stroke(Style.BorderColor)
        .StrokeWidthPx(Style.BorderWidth)
        .Append;
    end;
    if not FUnboundedMax then
    begin
      var pts: TArray<TPointD>;
      SetLength(pts, Length(FSliceData));
      for var i := 0 to High(FSliceData) do
        pts[i] := FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].b));
      ASVG
        .PolyLine(pts)
        .&Class('high-bound')
        .Fill('none')
        .Stroke(Style.BorderColor)
        .StrokeWidthPx(Style.BorderWidth)
        .Append;
    end;
  end;

  if FPoints then
  begin
    ASVG
      .BeginGroup
      .Fill(Style.Color)
      .FillOpacity(Style.OpacityFraction)
      .Stroke(Style.BorderColor)
      .StrokeWidthPx(Style.BorderWidth)
      .Append;
    if not FUnboundedMin then
    begin
      ASVG
        .BeginGroup
        .&Class('low-bound')
        .Append;
      for var i := 0 to High(FSliceData) do
        ASVG
          .Circle(FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].a)), FPointSizeDiv2)
          .Append;
      ASVG.EndGroup.Append;
    end;
    if not FUnboundedMax then
    begin
      ASVG
        .BeginGroup
        .&Class('high-bound')
        .Append;
      for var i := 0 to High(FSliceData) do
        ASVG
          .Circle(FCtl.SpaceToCanvas(PntFcn(FSliceData[i].t, FSliceData[i].b)), FPointSizeDiv2)
          .Append;
      ASVG.EndGroup.Append;
    end;
    ASVG.EndGroup.Append;
  end;

end;

procedure TRegion.SetAxis(const Value: TCartesianAxis);
begin
  if FAxis <> Value then
  begin
    FAxis := Value;
    Changed;
  end;
end;

procedure TRegion.SetSliceData(const Value: TArray<TSlice>);
begin
  FSliceData := Copy(Value);
  Changed;
end;

procedure TRegion.SetUnboundedMax(const Value: Boolean);
begin
  if FUnboundedMax <> Value then
  begin
    FUnboundedMax := Value;
    Changed;
  end;
end;

procedure TRegion.SetUnboundedMin(const Value: Boolean);
begin
  if FUnboundedMin <> Value then
  begin
    FUnboundedMin := Value;
    Changed;
  end;
end;

procedure TRegion.SetValidateRegion(const Value: Boolean);
begin
  if FValidateRegion <> Value then
  begin
    FValidateRegion := Value;
    Changed;
  end;
end;

{ TSlice }

constructor TSlice.Create(const t, a, b: Double);
begin
  Self.t := t;
  Self.a := a;
  Self.b := b;
end;

{ TSVGExportOptions }

function TSVGExportOptions.AutomaticAspectRatio: Boolean;
begin
  Result := (Width = 0) or (Height = 0);
end;

function TSVGExportOptions.AutomaticHeight: Boolean;
begin
  result := Height = 0;
end;

function TSVGExportOptions.AutomaticSize: Boolean;
begin
  Result := (Width = 0) and (Height = 0);
end;

function TSVGExportOptions.AutomaticWidth: Boolean;
begin
  Result := Width = 0;
end;

procedure TSVGExportOptions.SetDimensionsFromText(const AWidth,
  AHeight: string);

  procedure ParseValue(const S: string; out V: Double; out U: string);
  begin
    if S.Trim.IsEmpty then
    begin
      V := 0.0;
      U := '';
      Exit;
    end;
    var Vs: string;
    U := '';
    Vs := S;
    for var KnownUnit in SVGLengthUnits do
      if not KnownUnit.IsEmpty and S.EndsWith(KnownUnit, True) then
      begin
        U := KnownUnit;
        Vs := Copy(S, 1, S.Length - U.Length);
        Break;
      end;
    try
      V := StrToFloat(Vs);
    except
      V := StrToFloat(Vs, TFormatSettings.Invariant);
    end;
  end;

var
  WValue, HValue: Double;
  WUnit, HUnit: string;
begin

  ParseValue(AWidth, WValue, WUnit);
  ParseValue(AHeight, HValue, HUnit);

  if (WUnit <> HUnit) and (WValue <> 0) and (HValue <> 0) then
    raise ESVGException.Create('Width and height units do not match.');

  if WValue < 0 then
    raise ESVGException.Create('Width must not be negative.');

  if HValue < 0 then
    raise ESVGException.Create('Height must not be negative.');

  Self.Width := WValue;
  Self.Height := HValue;
  if WValue <> 0 then
    Self.LengthUnit := WUnit
  else
    Self.LengthUnit := HUnit;

end;

function TSVGExportOptions.SpecificAspectRatio: Boolean;
begin
  Result := (Width <> 0) and (Height <> 0);
end;

function TSVGExportOptions.SpecificHeight: Boolean;
begin
  Result := Height <> 0;
end;

function TSVGExportOptions.SpecificSize: Boolean;
begin
  Result := (Width <> 0) and (Height <> 0);
end;

function TSVGExportOptions.SpecificWidth: Boolean;
begin
  Result := Width <> 0;
end;

procedure TSVGExportOptions.Validate;
begin
  if
    (Width < 0)
  or
    (Height < 0)
  or
    (IndexStr(LengthUnit, SVGLengthUnits) = -1)
  then
    raise ESVGException.Create('Invalid SVG export options.');
end;

{ TSVGBuilder_VisCtl2D }

constructor TSVGBuilder_VisCtl2D.Create(AAbstract: Boolean);
begin
  inherited;
  FMarkerDict := TMarkerDict.Create;
end;

destructor TSVGBuilder_VisCtl2D.Destroy;
begin
  FreeAndNil(FMarkerDict);
  inherited;
end;

function TSVGBuilder_VisCtl2D.GetMarkerName(ACtl: TVisCtl2D;
  const AMarkerDef: TMarkerDef; const ALineDelta: Double): string;
var
  LMarkerData: TMarkerData;
begin

  if FMarkerDict.TryGetValue(AMarkerDef, LMarkerData) then
    Exit(LMarkerData.Name);

  var LFilled := AMarkerDef.Filled and AMarkerDef.Shape.IsFilled;

  Result := AMarkerDef.GetName;

  var LMarkerTag := DefMarker
    (
      Result,
      TViewBox.Create(-100, -100, 200, 200, AMarkerDef.Width * AMarkerDef.SizeUnit, AMarkerDef.Height * AMarkerDef.SizeUnit),
      ALineDelta * IfThen(AMarkerDef.Start, 1, -1),
      0,
      200 * AMarkerDef.Width * AMarkerDef.SizeUnit,
      200 * AMarkerDef.Height* AMarkerDef.SizeUnit,
      False
    )
    .Attrib('orient', 'auto');
  LMarkerTag.Append;
  ACtl.FSVGMarkers[AMarkerDef.Shape, AMarkerDef.Filled, AMarkerDef.Start]
    .RescalePoints(AMarkerDef.Height * AMarkerDef.SizeUnit, AMarkerDef.Width * AMarkerDef.SizeUnit)
    { SIC! The SVG markers are rotated 90 degrees compared to the D2D1 markers }
    .FillIf(AMarkerDef.Color, LFilled)
    .StrokeIf(AMarkerDef.Color, not LFilled)
    .StrokeWidthIf(AMarkerDef.LineWidth, not LFilled)
    .Associate(Self)
    .Append;
  EndDefMarker;

  LMarkerData.Name := Result;
  LMarkerData.Marker := LMarkerTag;
  FMarkerDict.Add(AMarkerDef, LMarkerData);

end;

{ TSVGBuilder_VisCtl2D.TMarkerDef }

function TSVGBuilder_VisCtl2D.TMarkerDef.GetName: string;
var
  LColorName: string;
begin
  if not TryGetColorName(Color, LColorName) then
    LColorName := ColorToHex(Color);
  Result := 'marker-' + Shape.ToString.Replace(#32, '-').ToLower + IfThen(Start, '-s')
    + IfThen(Filled, '-filled') + '-' + Width.ToString + '-' + Height.ToString
    + '-' + LineWidth.ToString + '-' + LColorName;
end;

end.
