GLScene/Externals/GR32/Source/GR32_Brushes.pas

unit GR32_Brushes;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1 or LGPL 2.1 with linking exception
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * Alternatively, the contents of this file may be used under the terms of the
 * Free Pascal modified version of the GNU Lesser General Public License
 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
 * of this license are applicable instead of those above.
 * Please see the file LICENSE.txt for additional information concerning this
 * license.
 *
 * The Original Code is Vectorial Polygon Rasterizer for Graphics32
 *
 * The Initial Developer of the Original Code is
 * Mattias Andersson <[email protected]>
 *
 * Portions created by the Initial Developer are Copyright (C) 2012
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$I GR32.inc}

uses
  Classes, GR32, GR32_Polygons, GR32_Transforms;

type
  TBooleanArray = array of boolean;

type
  TCustomBrush = class;
  TBrushClass = class of TCustomBrush;

// TODO: devise a common base class for TBrushCollection/TLayerCollection

  { TBrushCollection }
  TBrushCollection = class(TNotifiablePersistent)
  private
    FItems: TList;
    FOwner: TPersistent;
    procedure InsertItem(Item: TCustomBrush);
    procedure RemoveItem(Item: TCustomBrush);
    function GetCount: Integer;
    function GetItem(Index: Integer): TCustomBrush;
    procedure SetItem(Index: Integer; const Value: TCustomBrush);
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    function Add(ItemClass: TBrushClass): TCustomBrush;
    procedure Clear;
    procedure Delete(Index: Integer);
    function Insert(Index: Integer; ItemClass: TBrushClass): TCustomBrush;
    property Owner: TPersistent read FOwner;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TCustomBrush read GetItem write SetItem; default;
  end;

  { TCustomBrush }
  TCustomBrush = class(TNotifiablePersistent)
  private
    FBrushCollection: TBrushCollection;
    FVisible: Boolean;
    function GetIndex: Integer;
    procedure SetBrushCollection(const Value: TBrushCollection);
    procedure SetVisible(const Value: Boolean);
  protected
    procedure SetIndex(Value: Integer); virtual;
    procedure UpdateRenderer(Renderer: TCustomPolygonRenderer); virtual;
    procedure DoPolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); virtual;
  public
    constructor Create(ABrushCollection: TBrushCollection); virtual;
    destructor Destroy; override;
    procedure Changed; override;
    procedure PolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); virtual;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); overload; virtual;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: TBooleanArray); overload; virtual;
    property Index: Integer read GetIndex write SetIndex;
    property BrushCollection: TBrushCollection read FBrushCollection write SetBrushCollection;
    property Visible: Boolean read FVisible write SetVisible;
  end;


  { TSolidBrush }
  TSolidBrush = class(TCustomBrush)
  private
    FFillColor: TColor32;
    FFillMode: TPolyFillMode;
    FFiller: TCustomPolygonFiller;
    procedure SetFillColor(const Value: TColor32);
    procedure SetFillMode(const Value: TPolyFillMode);
    procedure SetFiller(const Value: TCustomPolygonFiller);
  protected
    procedure UpdateRenderer(Renderer: TCustomPolygonRenderer); override;
  public
    constructor Create(ABrushCollection: TBrushCollection); override;
    property FillColor: TColor32 read FFillColor write SetFillColor;
    property FillMode: TPolyFillMode read FFillMode write SetFillMode;
    property Filler: TCustomPolygonFiller read FFiller write SetFiller;
  end;

  { TNestedBrush }
  TNestedBrush = class(TSolidBrush)
  private
    FBrushes: TBrushCollection;
  public
    constructor Create(ABrushCollection: TBrushCollection); override;
    destructor Destroy; override;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: TBooleanArray); overload; override;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); overload; override;
    procedure PolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); override;
    property Brushes: TBrushCollection read FBrushes;
  end;

  { TStrokeBrush }
  TStrokeBrush = class(TSolidBrush)
  private
    FStrokeWidth: TFloat;
    FJoinStyle: TJoinStyle;
    FMiterLimit: TFloat;
    FEndStyle: TEndStyle;
    FBuffer: TArrayOfArrayOfFloatPoint;
    FCurrentIndex: integer;
    procedure SetStrokeWidth(const Value: TFloat);
    procedure SetEndStyle(const Value: TEndStyle);
    procedure SetJoinStyle(const Value: TJoinStyle);
    procedure SetMiterLimit(const Value: TFloat);
  protected
    procedure DoPolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); override;
  public
    constructor Create(BrushCollection: TBrushCollection); override;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); overload; override;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: TBooleanArray); overload; override;
    property StrokeWidth: TFloat read FStrokeWidth write SetStrokeWidth;
    property JoinStyle: TJoinStyle read FJoinStyle write SetJoinStyle;
    property EndStyle: TEndStyle read FEndStyle write SetEndStyle;
    property MiterLimit: TFloat read FMiterLimit write SetMiterLimit;
  end;

  { TGrowBrush }
  TGrowBrush = class(TNestedBrush)
  private
    FGrowAmount: TFloat;
    FJoinStyle: TJoinStyle;
    FMiterLimit: TFloat;
    procedure SetGrowAmount(const Value: TFloat);
    procedure SetJoinStyle(const Value: TJoinStyle);
    procedure SetMiterLimit(const Value: TFloat);
  public
    constructor Create(BrushCollection: TBrushCollection); override;
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); override;
    property GrowAmount: TFloat read FGrowAmount write SetGrowAmount;
    property JoinStyle: TJoinStyle read FJoinStyle write SetJoinStyle;
    property MiterLimit: TFloat read FMiterLimit write SetMiterLimit;
  end;

  { TDashedBrush }
  TDashedBrush = class(TStrokeBrush)
  private
    FDashOffset: TFloat;
    FDashArray: TArrayOfFloat;
    procedure SetDashOffset(const Value: TFloat);
  public
    procedure PolyPolygonFS(Renderer: TCustomPolygonRenderer;
      const Points: TArrayOfArrayOfFloatPoint;
      const ClipRect: TFloatRect; Transformation: TTransformation;
      Closed: Boolean); override;
    procedure SetDashArray(const ADashArray: array of TFloat);
    property DashOffset: TFloat read FDashOffset write SetDashOffset;
  end;

implementation

uses
  GR32_VectorUtils;

{ TBrushCollection }

function TBrushCollection.Add(ItemClass: TBrushClass): TCustomBrush;
begin
  Result := ItemClass.Create(Self);
  Result.Index := FItems.Count - 1;
  //Notify(lnLayerAdded, Result, Result.Index);
end;

procedure TBrushCollection.Clear;
begin
  BeginUpdate;
  try
    while FItems.Count > 0 do TCustomBrush(FItems.Last).Free;
    //Notify(lnCleared, nil, 0);
  finally
    EndUpdate;
  end;
end;

constructor TBrushCollection.Create(AOwner: TPersistent);
begin
  FItems := TList.Create;
end;

procedure TBrushCollection.Delete(Index: Integer);
begin
  TCustomBrush(FItems[Index]).Free;
end;

destructor TBrushCollection.Destroy;
begin
  if Assigned(FItems) then Clear;
  FItems.Free;
  inherited;
end;

function TBrushCollection.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TBrushCollection.GetItem(Index: Integer): TCustomBrush;
begin
  Result := FItems[Index];
end;

function TBrushCollection.Insert(Index: Integer;
  ItemClass: TBrushClass): TCustomBrush;
begin
  BeginUpdate;
  try
    Result := Add(ItemClass);
    Result.Index := Index;
    //Notify(lnLayerInserted, Result, Index);
  finally
    EndUpdate;
  end;
end;

procedure TBrushCollection.InsertItem(Item: TCustomBrush);
(*
var
  Index: Integer;
*)
begin
  BeginUpdate;
  try
    {Index := } FItems.Add(Item);
    Item.FBrushCollection := Self;
    //Notify(lnLayerAdded, Item, Index);
  finally
    EndUpdate;
  end;
end;

procedure TBrushCollection.RemoveItem(Item: TCustomBrush);
var
  Index: Integer;
begin
  BeginUpdate;
  try
    Index := FItems.IndexOf(Item);
    if Index >= 0 then
    begin
      FItems.Delete(Index);
      Item.FBrushCollection := nil;
      //Notify(lnLayerDeleted, Item, Index);
    end;
  finally
    EndUpdate;
  end;
end;

procedure TBrushCollection.SetItem(Index: Integer; const Value: TCustomBrush);
begin
  TCollectionItem(FItems[Index]).Assign(Value);
end;


{ TCustomBrush }

procedure TCustomBrush.Changed;
begin
  inherited;
  if Assigned(FBrushCollection) then
    FBrushCollection.Changed;
end;

constructor TCustomBrush.Create(ABrushCollection: TBrushCollection);
begin
  BrushCollection := ABrushCollection;
  FVisible := True;
end;

destructor TCustomBrush.Destroy;
begin
  SetBrushCollection(nil);
  inherited;
end;

function TCustomBrush.GetIndex: Integer;
begin
  if Assigned(FBrushCollection) then
    Result := FBrushCollection.FItems.IndexOf(Self)
  else
    Result := -1;
end;

procedure TCustomBrush.PolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfFloatPoint;
  const ClipRect: TFloatRect; Transformation: TTransformation; Closed: Boolean);
begin
  PolyPolygonFS(Renderer, PolyPolygon(Points), ClipRect, Transformation, Closed);
end;

procedure TCustomBrush.DoPolyPolygonFS(Renderer: TCustomPolygonRenderer; const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect;
  Transformation: TTransformation; Closed: Boolean);
begin
  PolyPolygonFS(Renderer, Points, ClipRect, Transformation, Closed);
end;

procedure TCustomBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfArrayOfFloatPoint;
  const ClipRect: TFloatRect; Transformation: TTransformation; Closed: Boolean);
begin
  UpdateRenderer(Renderer);
  Renderer.PolyPolygonFS(Points, ClipRect, Transformation);
end;

procedure TCustomBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer; const Points: TArrayOfArrayOfFloatPoint;
  const ClipRect: TFloatRect; Transformation: TTransformation; Closed: TBooleanArray);
var
  Start, Next: Integer;
  i: integer;
  Buffer: TArrayOfArrayOfFloatPoint;
  RunClosed: boolean;
begin
  if (Length(Points) = 0) then
    exit;

  // Assume some paths are closed, some are open
  begin
    Start := 0;
    // Find contiguous chunks of path with same "closedness"
    while (Start < Length(Points)) do
    begin
      RunClosed := Closed[Start];
      // Find a run of same "closedness"
      Next := Start+1;
      while (Next < Length(Points)) and (Closed[Next] = RunClosed) do
        Inc(Next);

      // Run goes from Start to Next-1
      SetLength(Buffer, Next-Start);
      i := 0;
      while (Start < Next) do
      begin
        Buffer[i] := Points[Start];
        Inc(Start);
        Inc(i);
      end;

      // Render this run
      DoPolyPolygonFS(Renderer, Buffer, ClipRect, Transformation, RunClosed);
    end;
  end;
end;

procedure TCustomBrush.SetBrushCollection(const Value: TBrushCollection);
begin
  if FBrushCollection <> Value then
  begin
    if Assigned(FBrushCollection) then
      FBrushCollection.RemoveItem(Self);
    if Assigned(Value) then
      Value.InsertItem(Self);
  end;
end;

procedure TCustomBrush.SetIndex(Value: Integer);
var
  CurIndex: Integer;
begin
  CurIndex := GetIndex;
  if (CurIndex >= 0) and (CurIndex <> Value) then
    with FBrushCollection do
    begin
      if Value < 0 then Value := 0;
      if Value >= Count then Value := Count - 1;
      if Value <> CurIndex then
      begin
        if Visible then BeginUpdate;
        try
          FBrushCollection.FItems.Move(CurIndex, Value);
        finally
          if Visible then EndUpdate;
        end;
      end;
    end;
end;

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

procedure TCustomBrush.UpdateRenderer(Renderer: TCustomPolygonRenderer);
begin

end;


{ TNestedBrush }

constructor TNestedBrush.Create(ABrushCollection: TBrushCollection);
begin
  inherited;
  FBrushes := TBrushCollection.Create(Self);
end;

destructor TNestedBrush.Destroy;
begin
  FBrushes.Free;
  inherited;
end;

procedure TNestedBrush.PolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect;
  Transformation: TTransformation; Closed: Boolean);
var
  I: Integer;
begin
  for I := 0 to FBrushes.Count - 1 do
    if FBrushes[I].Visible then
      FBrushes[I].PolygonFS(Renderer, Points, ClipRect, Transformation, Closed);
end;

procedure TNestedBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer; const Points: TArrayOfArrayOfFloatPoint;
  const ClipRect: TFloatRect; Transformation: TTransformation; Closed: TBooleanArray);
var
  I: Integer;
begin
  for I := 0 to FBrushes.Count - 1 do
    if FBrushes[I].Visible then
      FBrushes[I].PolyPolygonFS(Renderer, Points, ClipRect, Transformation, Closed);
end;

procedure TNestedBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect;
  Transformation: TTransformation; Closed: Boolean);
var
  I: Integer;
begin
  for I := 0 to FBrushes.Count - 1 do
    if FBrushes[I].Visible then
      FBrushes[I].PolyPolygonFS(Renderer, Points, ClipRect, Transformation, Closed);
end;



{ TSolidBrush }

constructor TSolidBrush.Create(ABrushCollection: TBrushCollection);
begin
  inherited;
  FFillColor := clBlack32;
end;

procedure TSolidBrush.SetFillColor(const Value: TColor32);
begin
  if FFillColor <> Value then
  begin
    FFillColor := Value;
    Changed;
  end;
end;

procedure TSolidBrush.SetFiller(const Value: TCustomPolygonFiller);
begin
  if FFiller <> Value then
  begin
    FFiller := Value;
    Changed;
  end;
end;

procedure TSolidBrush.SetFillMode(const Value: TPolyFillMode);
begin
  if FFillMode <> Value then
  begin
    FFillMode := Value;
    Changed;
  end;
end;

procedure TSolidBrush.UpdateRenderer(Renderer: TCustomPolygonRenderer);
var
  R: TPolygonRenderer32;
begin
  R := Renderer as TPolygonRenderer32;
  R.Color := FillColor;
  R.FillMode := FillMode;
  R.Filler := Filler;
end;


{ TStrokeBrush }

constructor TStrokeBrush.Create(BrushCollection: TBrushCollection);
begin
  inherited;
  FStrokeWidth := 1;
  FFillMode := pfWinding;
  FMiterLimit := DEFAULT_MITER_LIMIT;
end;

procedure TStrokeBrush.DoPolyPolygonFS(Renderer: TCustomPolygonRenderer; const Points: TArrayOfArrayOfFloatPoint;
  const ClipRect: TFloatRect; Transformation: TTransformation; Closed: Boolean);
var
  RunPoints: TArrayOfArrayOfFloatPoint;
  i: integer;
begin
  RunPoints := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);

  for i := 0 to High(RunPoints) do
  begin
    FBuffer[FCurrentIndex] := RunPoints[i];
    Inc(FCurrentIndex);
  end;
end;

procedure TStrokeBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect;
  Transformation: TTransformation; Closed: Boolean);
var
  APoints: TArrayOfArrayOfFloatPoint;
begin
  APoints := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
  inherited PolyPolygonFS(Renderer, APoints, ClipRect, Transformation, Closed);
end;

procedure TStrokeBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer; const Points: TArrayOfArrayOfFloatPoint;
  const ClipRect: TFloatRect; Transformation: TTransformation; Closed: TBooleanArray);
var
  i: integer;
  Size: integer;
begin
  Size := 0;
  for i := 0 to High(Points) do
    if (Closed[i]) then
      Inc(Size, Length(Points[i])*2)
    else
      Inc(Size, Length(Points[i]));

  SetLength(FBuffer, Size);
  FCurrentIndex := 0;

  inherited; // Builds runs of open and/or closed points

  // Render runs in one go
  inherited PolyPolygonFS(Renderer, FBuffer, ClipRect, Transformation, True);

  SetLength(FBuffer, 0);
end;

procedure TStrokeBrush.SetEndStyle(const Value: TEndStyle);
begin
  if FEndStyle <> Value then
  begin
    FEndStyle := Value;
    Changed;
  end;
end;

procedure TStrokeBrush.SetJoinStyle(const Value: TJoinStyle);
begin
  if FJoinStyle <> Value then
  begin
    FJoinStyle := Value;
    Changed;
  end;
end;

procedure TStrokeBrush.SetMiterLimit(const Value: TFloat);
begin
  if FMiterLimit <> Value then
  begin
    FMiterLimit := Value;
    Changed;
  end;
end;

procedure TStrokeBrush.SetStrokeWidth(const Value: TFloat);
begin
  if FStrokeWidth <> Value then
  begin
    FStrokeWidth := Value;
    Changed;
  end;
end;


{ TDashedBrush }

procedure TDashedBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect;
  Transformation: TTransformation; Closed: Boolean);
var
  I: Integer;
begin
  for I := 0 to High(Points) do
    inherited PolyPolygonFS(
      Renderer, BuildDashedLine(Points[I], FDashArray, FDashOffset, Closed),
      ClipRect, Transformation, False);
end;

procedure TDashedBrush.SetDashArray(const ADashArray: array of TFloat);
var
  L: Integer;
begin
  L := Length(ADashArray);
  SetLength(FDashArray, L);
  Move(ADashArray[0], FDashArray[0], L * SizeOf(TFloat));
  Changed;
end;

procedure TDashedBrush.SetDashOffset(const Value: TFloat);
begin
  if FDashOffset <> Value then
  begin
    FDashOffset := Value;
    Changed;
  end;
end;


{ TGrowBrush }

constructor TGrowBrush.Create(BrushCollection: TBrushCollection);
begin
  inherited;
  FMiterLimit := DEFAULT_MITER_LIMIT;
end;

procedure TGrowBrush.PolyPolygonFS(Renderer: TCustomPolygonRenderer;
  const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect;
  Transformation: TTransformation; Closed: Boolean);
var
  I: Integer;
  APoints: TArrayOfArrayOfFloatPoint;
begin
  SetLength(APoints, Length(Points));
  for I := 0 to High(Points) do
    APoints[I] := Grow(Points[I], GrowAmount, JoinStyle, Closed, MiterLimit);
  inherited PolyPolygonFS(Renderer, APoints, ClipRect, Transformation, True);
end;

procedure TGrowBrush.SetGrowAmount(const Value: TFloat);
begin
  if FGrowAmount <> Value then
  begin
    FGrowAmount := Value;
    Changed;
  end;
end;

procedure TGrowBrush.SetJoinStyle(const Value: TJoinStyle);
begin
  if FJoinStyle <> Value then
  begin
    FJoinStyle := Value;
    Changed;
  end;
end;

procedure TGrowBrush.SetMiterLimit(const Value: TFloat);
begin
  if FMiterLimit <> Value then
  begin
    FMiterLimit := Value;
    Changed;
  end;
end;

end.