{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                       HATCH parsing                        }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}

unit sgHatch;

interface

uses
  Classes, sgConsts, SysUtils, Math, sgFunction, sgLists;

type
  PLineWithBaseP = ^TLineWithBaseP;
  TLineWithBaseP = record
    P1, P2, BP: TF2DPoint;
  end;

procedure ParseLinesHatch(ABoundaryPolylines: TList; AHatchLine: PLineWithBaseP;
  AParsedLines: TList);

implementation

type
  TsgParserLineHatch = class
  private
    FAccuracyCmp: Double;
    FBoundaryEdges: TList;
    FBoxesBoundary: TList;
    FBoundaryPoint1: TFPoint;
    FBoundaryPoint2: TFPoint;
    FBoundaryPolylines: TList;
    FParsedLines: TList;
    FParsedLinesPrevCount: Integer;
    FPoint1: TFPoint;
    FPoint2: TFPoint;
    FUseYSort: Boolean;
  protected
    function IsEqual(const AP1, AP2: TFPoint): Boolean; overload;
    function IsEqual(const AP1, AP2: TF2DPoint): Boolean; overload;
    procedure SortParsedLines;
    procedure SpliteLine;
    function CalcVisibilitySegment(const AMiddlePoint: TFPoint; const ABoxes: TList): Byte;
    procedure CalcBoxBoundary;
    procedure DeleteSamePoints;
  public
    procedure Parse(const ABoundaryPolylines: TList; const AP1, AP2: TF2DPoint;
      const AParsedLines: TList);
  end;
{ ParseLinesHatch

  ABoundaries is pointer to an array of PdxfPoint (elements=PdxfPoint)
  ACount is number of elements in the ABoundaries (number of hatch-boundaries)
  ALines is list of lines-coords (elements=Single, i.e. X1, Y1, X2, Y2, ...)
  AParsedLines is list for writing parsed lines (elements=PdxfPoint)

  Truncates lines of hatch.                              }
procedure ParseLinesHatch(ABoundaryPolylines: TList; AHatchLine: PLineWithBaseP;
  AParsedLines: TList);
var
  vParserLineHatch: TsgParserLineHatch;
begin
  vParserLineHatch := TsgParserLineHatch.Create;
  try
    vParserLineHatch.Parse(ABoundaryPolylines, AHatchLine^.P1, AHatchLine^.P2,
      AParsedLines);
  finally
    vParserLineHatch.Free;
  end;
end;

procedure TsgParserLineHatch.CalcBoxBoundary;
var
  I, J: Integer;
  vBox: PFRect;
  vBoundaryPolyline: TF2DPointList;
begin
  if FBoxesBoundary = nil then
    Exit;
  // Calculation  Box by all boundary
  for I := 0 to FBoundaryPolylines.Count - 1 do
  begin
    vBoundaryPolyline := FBoundaryPolylines.List[I];
    if (vBoundaryPolyline = nil) or (vBoundaryPolyline.Count = 0) then
    begin
      FBoxesBoundary.Add(nil);
      Continue;
    end;
    New(vBox);
    vBox^ :=  cnstBadRect;
    for J := vBoundaryPolyline.Count - 1 downto 0 do
      ExpandFRect2D(vBox^, MakeFPointFrom2D(vBoundaryPolyline[J]));
    vBox^.Z1 := 0;
    vBox^.Z2 := 0;
    FBoxesBoundary.Add(vBox);
  end;
end;

function TsgParserLineHatch.CalcVisibilitySegment(
  const AMiddlePoint: TFPoint; const ABoxes: TList): Byte;
var
  I: Integer;
  vLine: PsgLineState;
begin
  for I := 0 to FBoundaryEdges.Count-1 do
  begin
    vLine := PsgLineState(FBoundaryEdges.List[I]);
    if IsPointOnSegmentPts(vLine^.Point1, vLine^.Point2, AMiddlePoint) then
    begin
      Result := 1;
      Exit;
    end;
  end;
  if IsPointInPolyPolyline(FBoundaryPolylines, AMiddlePoint, ABoxes, fExtendedResolution) then
    Result := 254
  else
    Result := 2
end;

procedure TsgParserLineHatch.DeleteSamePoints;
var
  I: Integer;
begin
  I := FParsedLinesPrevCount;
  while I < FParsedLines.Count - 1 do
  begin
    if IsEqual(PF2DPoint(FParsedLines[I])^,PF2DPoint(FParsedLines[I+1])^) then
    begin
      Dispose(FParsedLines[I]);
      FParsedLines.Delete(I);
    end
    else
      Inc(I);
  end;
end;

function TsgParserLineHatch.IsEqual(const AP1, AP2: TFPoint): Boolean;
begin
  Result := IsEqualFPoints2D(AP1, AP2, fAccuracy);
end;

function TsgParserLineHatch.IsEqual(const AP1, AP2: TF2DPoint): Boolean;
begin
  Result := IsEqualF2DPoints(AP1, AP2, fAccuracy);
end;

procedure TsgParserLineHatch.Parse(const ABoundaryPolylines: TList; const AP1,
  AP2: TF2DPoint; const AParsedLines: TList);
var
  I, vOldState, vState: Integer;
  vMiddlePoint: TFPoint;
begin
  if ABoundaryPolylines.Count = 0 then Exit;
  FAccuracyCmp := fDoubleResolution;
  FBoundaryPolylines := ABoundaryPolylines;
  FParsedLines := AParsedLines;
  FParsedLinesPrevCount := FParsedLines.Count;// previous number of points
  FPoint1.X:= AP1.X;
  FPoint1.Y:= AP1.Y;
  FPoint2.X:= AP2.X;
  FPoint2.Y:= AP2.Y;
  FUseYSort := True;
  FBoundaryEdges := TList.Create;
  FBoxesBoundary := TList.Create;
  try
    SpliteLine;
    // Sorting of the added coordinates of points of last hatch-line
    SortParsedLines;
    DeleteSamePoints;
    CalcBoxBoundary;
    //
    vOldState := 2;
    I := FParsedLinesPrevCount;
    while I < FParsedLines.Count - 1 do
    begin
      vMiddlePoint := MiddleFPoint(MakeFPointFrom2D(PF2DPoint(FParsedLines[I])^),
        MakeFPointFrom2D(PF2DPoint(FParsedLines[I+1])^));
      vState := CalcVisibilitySegment(vMiddlePoint, FBoxesBoundary);
      if vState <=2 then
        vState := 2;
      if vState = vOldState then
      begin
        Dispose(FParsedLines[I]);
        FParsedLines.Delete(I);
      end
      else
        Inc(I);
      vOldState := vState;
    end;
  finally
    FreeRecordList(FBoundaryEdges);
    FreeRecordList(FBoxesBoundary);
  end;
end;

procedure TsgParserLineHatch.SortParsedLines;
var
  vProcCompare: TsgProcCompare;
begin
  if (FParsedLines.Count > 0) and (FParsedLinesPrevCount < FParsedLines.Count - 1) then
  begin
    vProcCompare := @ProcCompareF2DPointByX;
    if FUseYSort then
      vProcCompare := @ProcCompareF2DPointByYX;
    QSortListBounds(FParsedLines, vProcCompare, FParsedLinesPrevCount,
      FParsedLines.Count - 1);
  end;
end;

procedure TsgParserLineHatch.SpliteLine;
var
  I, J: Integer;
  vBoundaryPolyline: TF2DPointList;
  vCrossPoint: TFPoint;
  vP1, vP2, vTmpPoint: PF2DPoint;
  vLine: PsgLineState;
begin
  for I := 0 to FBoundaryPolylines.Count - 1 do
  begin
    vBoundaryPolyline := FBoundaryPolylines.List[I];
    if (vBoundaryPolyline = nil) or (vBoundaryPolyline.Count = 0) then
      Continue;
    vP2 := @vBoundaryPolyline.List^[0];
    for J := 1 to vBoundaryPolyline.Count do
    begin
      if J >= vBoundaryPolyline.Count then
        vTmpPoint := @vBoundaryPolyline.List^[J - vBoundaryPolyline.Count]
      else
        vTmpPoint := @vBoundaryPolyline.List^[J];
      if IsEqual(vTmpPoint^, vP2^) then
        Continue;
      vP1 := vP2;
      vP2 := vTmpPoint;
      FBoundaryPoint1 := MakeFPointFrom2D(vP1^);
      FBoundaryPoint2 := MakeFPointFrom2D(vP2^);
      // Segments are not parallel
      if IsCrossSegmentsPts(FPoint1, FPoint2, FBoundaryPoint1, FBoundaryPoint2, @vCrossPoint) then
        AddF2DPointInList(FParsedLines, vCrossPoint)
      else
      begin
        if IsParalleniarLinesPts(FPoint1, FPoint2, FBoundaryPoint1, FBoundaryPoint2) then
        begin
          New(vLine);
          FBoundaryEdges.Add(vLine);
          vLine^.Point1 := FBoundaryPoint1;
          vLine^.Point2 := FBoundaryPoint2;
        end;
      end;
    end;
  end;
end;

end.
