unit dflash_coloring;

{$MODE FPC}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
{$MODESWITCH ADVANCEDRECORDS}

interface

uses
  dstackallocator,
  dvector2f;

type
PPoint = ^TVec2f;
TPoints = array of PPoint;

PEdge = ^TEdge;
TEdge = record
  Point: PPoint;
  IsQuadric: Boolean;
  Control: TVec2f; // for quadric curve
  Prev: PEdge;
  Next: PEdge;
  LineStyle: LongInt;
end;

PFlashContour = ^TFlashContour;
TFlashContour = object
  FillStyle: LongInt;
  LineStyle: LongInt;
  Direct: Boolean;
  ShapeIndex: LongInt;
  First, Last: PEdge;
  function IsClosed: Boolean;
  function Has(Point: PPoint): Boolean;
end;

TFlashContours = array of TFlashContour;

TFlashColoring = object
private
  FStackAllocator: TStackAllocator;
  FPoints: TPoints;
  FContours: TFlashContours;
  FLastContour: array[0 .. 1] of LongInt;
  function GetPoint(const V: TVec2f): PPoint;
public
  procedure Init;
  procedure Done;
  procedure Start;
  procedure AddEdge(const A, Control, B: TVec2f; Quadric: Boolean; FillStyle, LineStyle: LongInt; Direct: Boolean; ShapeIndex: LongInt);
  procedure Finish;
  property Points: TPoints read FPoints;
  property Contours: TFlashContours read FContours;
end;

implementation

function TFlashContour.IsClosed: Boolean;
begin
  if First <> Last then begin
    Exit(First^.Point = Last^.Point);
  end else
    Exit(True);
end;

function TFlashContour.Has(Point: PPoint): Boolean;
var
  I: LongInt;
  E: PEdge;
begin
  E := First;
  while E <> nil do begin
    if E^.Point = Point then
      Exit(True);
    E := E^.Next;
  end;
  Exit(False);
end;

function TFlashColoring.GetPoint(const V: TVec2f): PPoint;
var
  L, R, M: LongInt;
  P: PPoint;
begin
  L := 0;
  R := High(FPoints);
  while R >= L do begin
    M := L + (R - L) div 2;
    P := FPoints[M];
    if (P^.X = V.X) and (P^.Y = V.Y) then begin
      Exit(P);
    end;
    if (P^.X < V.X) or ((P^.X = V.X) and (P^.Y < V.Y)) then begin
      L := M + 1;
    end else
      R := M - 1;
  end;
  Result := saGetMem(FStackAllocator, SizeOf(TVec2f));
  Result^ := V;
  SetLength(FPoints, Length(FPoints) + 1);
  for R := High(FPoints) downto L + 1 do
    FPoints[R] := FPoints[R - 1];
  FPoints[L] := Result;
end;

procedure TFlashColoring.Init;
begin
  saInit(FStackAllocator);
  SetLength(FContours, 0);
  FLastContour[0] := -1;
  FLastContour[1] := -1;
end;

procedure TFlashColoring.Done;
begin
  SetLength(FContours, 0);
  saDone(FStackAllocator);
end;

procedure TFlashColoring.Start;
begin
  saDone(FStackAllocator);
  saInit(FStackAllocator);
  SetLength(FContours, 0);
  FLastContour[0] := -1;
  FLastContour[1] := -1;
end;

procedure TFlashColoring.AddEdge(const A, Control, B: TVec2f; Quadric: Boolean; FillStyle, LineStyle: LongInt; Direct: Boolean; ShapeIndex: LongInt);
var
  I, J: LongInt;
  C: PFlashContour;
  _A, _B: PPoint;
  E: PEdge;
begin
  _A := GetPoint(A);
  _B := GetPoint(B);
  if FLastContour[Ord(Direct)] <> -1 then begin
    C := @FContours[FLastContour[Ord(Direct)]];
    if (C^.FillStyle = FillStyle) {and (C^.LineStyle = LineStyle)} then begin
      if (_A = C^.Last^.Point) and not C^.Has(_B) then begin
        E := saGetMem(FStackAllocator, SizeOf(TEdge));
        E^.Point := _B;
        E^.IsQuadric := Quadric;
        E^.Control := Control;
        E^.LineStyle := LineStyle;
        E^.Next := nil;
        E^.Prev := C^.Last;
        C^.Last^.Next := E;
        C^.Last := E;
        Exit;
      end;
      if (_B = C^.First^.Point) and not C^.Has(_A) then begin
        E := saGetMem(FStackAllocator, SizeOf(TEdge));
        E^.Point := _A;
        C^.First^.IsQuadric := Quadric;
        C^.First^.Control := Control;
        E^.LineStyle := LineStyle;
        E^.Next := C^.First;
        E^.Prev := nil;
        C^.First^.Prev := E;
        C^.First := E;
        Exit;
      end;
    end;
  end;
  for I := 0 to High(FContours) do begin
    C := @FContours[I];
    //if (C^.FillStyle <> FillStyle) or (C^.LineStyle <> LineStyle) or (C^.Direct <> Direct) then
    //  continue;
    //if (C^.FillStyle <> FillStyle) or (C^.LineStyle <> LineStyle) or (C^.ShapeIndex <> ShapeIndex) then
    //  continue;
    if (C^.FillStyle <> FillStyle) {or (C^.LineStyle <> LineStyle)} then
      continue;
    if (_A = C^.Last^.Point) and not C^.Has(_B) then begin
      E := saGetMem(FStackAllocator, SizeOf(TEdge));
      E^.Point := _B;
      E^.IsQuadric := Quadric;
      E^.Control := Control;
      E^.LineStyle := LineStyle;
      E^.Next := nil;
      E^.Prev := C^.Last;
      C^.Last^.Next := E;
      C^.Last := E;
      FLastContour[Ord(Direct)] := I;
      Exit;
    end;
    if (_B = C^.First^.Point) and not C^.Has(_A) then begin
      E := saGetMem(FStackAllocator, SizeOf(TEdge));
      E^.Point := _A;
      E^.LineStyle := LineStyle;
      C^.First^.IsQuadric := Quadric;
      C^.First^.Control := Control;
      E^.Next := C^.First;
      E^.Prev := nil;
      C^.First^.Prev := E;
      C^.First := E;
      FLastContour[Ord(Direct)] := I;
      Exit;
    end;
  end;
  SetLength(FContours, Length(FContours) + 1);
  C := @FContours[High(FContours)];
  C^.FillStyle := FillStyle;
  C^.LineStyle := LineStyle;
  C^.Direct := Direct;
  C^.ShapeIndex := ShapeIndex;
  C^.First := saGetMem(FStackAllocator, SizeOf(TEdge));
  C^.Last  := saGetMem(FStackAllocator, SizeOf(TEdge));
  C^.First^.Point := _A;
  C^.First^.LineStyle := LineStyle;
  C^.First^.Next  := C^.Last;
  C^.First^.Prev  := nil;
  C^.Last^.Point  := _B;
  C^.Last^.LineStyle := LineStyle;
  C^.Last^.IsQuadric := Quadric;
  C^.Last^.Control   := Control;
  C^.Last^.Next   := nil;
  C^.Last^.Prev   := C^.First;
  FLastContour[Ord(Direct)] := High(FContours);
end;

procedure Merge(C, B: PFlashContour);
begin
  C^.Last^.Next := B^.First^.Next;
  B^.First^.Next^.Prev := C^.Last;
  C^.Last := B^.Last;
end;

procedure TFlashColoring.Finish;
label
  Restart;
var
  I, J, K: LongInt;
  C, B: PFlashContour;
begin
Restart:
  for I := 0 to High(FContours) do begin
    C := @FContours[I];
    if C^.IsClosed then
      continue;
    for J := 0 to High(FContours) do begin
      B := @FContours[J];
      if B^.IsClosed then
        continue;
      //if (C^.FillStyle <> B^.FillStyle) or (C^.LineStyle <> B^.LineStyle) or (C^.Direct <> B^.Direct) then
      //  continue;
      //if (C^.FillStyle <> B^.FillStyle) or (C^.LineStyle <> B^.LineStyle) or (C^.ShapeIndex <> B^.ShapeIndex) then
      //  continue;
      if (C^.FillStyle <> B^.FillStyle) {or (C^.LineStyle <> B^.LineStyle)} then
        continue;
      if C^.Last^.Point = B^.First^.Point then begin
        Merge(C, B);
        if J <= High(FContours) - 1 then
          for K := J to High(FContours) - 1 do
            FContours[K] := FContours[K + 1];
        SetLength(FContours, Length(FContours) - 1);
        goto Restart;
      end;
      if B^.Last^.Point = C^.First^.Point then begin
        Merge(B, C);
        if I <= High(FContours) - 1 then
          for K := I to High(FContours) - 1 do
            FContours[K] := FContours[K + 1];
        SetLength(FContours, Length(FContours) - 1);
        goto Restart;
      end;
    end;
  end;
end;

end.
