kam-mobile/code/KM_RenderAux_Mobile.pas

unit KM_RenderAux_Mobile;
{$I KaM_Remake.inc}
interface
uses
  KM_Points, KM_CommonTypes;

procedure KMRenderAuxMobileFill(
  const aPoints: array of TKMPointF;
  const aColor: TKMColor4f);
procedure KMRenderAuxMobileStroke(
  const aPoints: array of TKMPointF;
  aClosed: Boolean;
  aWorldWidth: Single;
  aPattern: Word;
  aPatternBitWorldLength: Single;
  const aColor: TKMColor4f);

implementation
uses
  SysUtils, Math, KM_Render;

type
  TSolidVertexArray = array of TKMSolidVertex;
  TPointArray = array of TKMPointF;
  TIndexArray = array of Integer;

function IsFinitePoint(const P: TKMPointF): Boolean;
begin
  Result := not IsNan(P.X) and not IsInfinite(P.X)
        and not IsNan(P.Y) and not IsInfinite(P.Y);
end;

function IsFiniteColor(const C: TKMColor4f): Boolean;
begin
  Result := not IsNan(C.R) and not IsInfinite(C.R)
        and not IsNan(C.G) and not IsInfinite(C.G)
        and not IsNan(C.B) and not IsInfinite(C.B)
        and not IsNan(C.A) and not IsInfinite(C.A);
end;

function SignedCross(const A, B, C: TKMPointF): Double;
begin
  Result := (Double(B.X) - A.X) * (Double(C.Y) - A.Y)
          - (Double(B.Y) - A.Y) * (Double(C.X) - A.X);
end;

function SameAdjacentPoint(const A, B: TKMPointF): Boolean;
begin
  Result := (A.X = B.X) and (A.Y = B.Y);
end;

function Distance(const A, B: TKMPointF): Double;
var
  DX, DY: Double;
begin
  DX := Double(A.X) - B.X;
  DY := Double(A.Y) - B.Y;
  Result := Sqrt(DX * DX + DY * DY);
end;

function NearClosingRepeat(const Points: TPointArray): Boolean;
var
  FirstEdge, LastEdge, ClosingDistance: Double;
  I: Integer;
begin
  Result := False;
  if Length(Points) < 3 then
    Exit;

  if SameAdjacentPoint(Points[0], Points[High(Points)]) then
  begin
    Result := True;
    Exit;
  end;

  FirstEdge := 0;
  for I := 1 to High(Points) do
  begin
    FirstEdge := Distance(Points[I - 1], Points[I]);
    if FirstEdge > 0 then
      Break;
  end;

  LastEdge := 0;
  for I := High(Points) - 1 downto 0 do
  begin
    LastEdge := Distance(Points[I + 1], Points[I]);
    if LastEdge > 0 then
      Break;
  end;

  if (FirstEdge <= 0) or (LastEdge <= 0) then
    Exit;
  ClosingDistance := Distance(Points[0], Points[High(Points)]);
  Result := ClosingDistance <= 1E-6 * Min(FirstEdge, LastEdge);
end;

function OnSegment(const A, B, P: TKMPointF): Boolean;
begin
  Result := (SignedCross(A, B, P) = 0)
        and (P.X >= Min(A.X, B.X)) and (P.X <= Max(A.X, B.X))
        and (P.Y >= Min(A.Y, B.Y)) and (P.Y <= Max(A.Y, B.Y));
end;

function SegmentsIntersect(const A, B, C, D: TKMPointF): Boolean;
var
  O1, O2, O3, O4: Double;
begin
  O1 := SignedCross(A, B, C);
  O2 := SignedCross(A, B, D);
  O3 := SignedCross(C, D, A);
  O4 := SignedCross(C, D, B);
  Result := ((O1 = 0) and OnSegment(A, B, C))
         or ((O2 = 0) and OnSegment(A, B, D))
         or ((O3 = 0) and OnSegment(C, D, A))
         or ((O4 = 0) and OnSegment(C, D, B))
         or ((((O1 < 0) and (O2 > 0)) or ((O1 > 0) and (O2 < 0)))
          and (((O3 < 0) and (O4 > 0)) or ((O3 > 0) and (O4 < 0))));
end;

function SegmentCrossesOrTouchesNonNeighbor(const Points: TPointArray;
  EdgeA, EdgeB: Integer): Boolean;
var
  N, NextA, NextB: Integer;
  Shared: Boolean;
  CommonPoint, OtherA, OtherB: TKMPointF;
begin
  N := Length(Points);
  NextA := (EdgeA + 1) mod N;
  NextB := (EdgeB + 1) mod N;
  Shared := (EdgeA = EdgeB) or (NextA = EdgeB) or (NextB = EdgeA);
  if not SegmentsIntersect(Points[EdgeA], Points[NextA], Points[EdgeB], Points[NextB]) then
  begin
    Result := False;
    Exit;
  end;

  if not Shared then
  begin
    Result := True;
    Exit;
  end;

  if NextA = EdgeB then
  begin
    CommonPoint := Points[NextA];
    OtherA := Points[EdgeA];
    OtherB := Points[NextB];
  end
  else if NextB = EdgeA then
  begin
    CommonPoint := Points[NextB];
    OtherA := Points[NextA];
    OtherB := Points[EdgeB];
  end
  else
  begin
    Result := True;
    Exit;
  end;

  Result := (SignedCross(CommonPoint, OtherA, OtherB) = 0)
        and ((Double(OtherA.X) - CommonPoint.X) * (Double(OtherB.X) - CommonPoint.X)
           + (Double(OtherA.Y) - CommonPoint.Y) * (Double(OtherB.Y) - CommonPoint.Y) > 0);
end;

function PointInOrOnTriangle(const P, A, B, C: TKMPointF;
  Winding: Double): Boolean;
begin
  Result := (Winding * SignedCross(A, B, P) >= 0)
        and (Winding * SignedCross(B, C, P) >= 0)
        and (Winding * SignedCross(C, A, P) >= 0);
end;

procedure AppendTriangle(const A, B, C: TKMPointF; var Dest: TSolidVertexArray);
var
  L: Integer;
begin
  L := Length(Dest);
  SetLength(Dest, L + 3);
  Dest[L].X := A.X; Dest[L].Y := A.Y; Dest[L].Z := 0.0;
  Dest[L + 1].X := B.X; Dest[L + 1].Y := B.Y; Dest[L + 1].Z := 0.0;
  Dest[L + 2].X := C.X; Dest[L + 2].Y := C.Y; Dest[L + 2].Z := 0.0;
end;

procedure AppendRibbon(const A, B: TKMPointF; HalfWidth: Single;
  var Triangles: TSolidVertexArray);
var
  DX, DY, L, NX, NY: Double;
  AL, AR, BL, BR: TKMPointF;
begin
  DX := Double(B.X) - A.X;
  DY := Double(B.Y) - A.Y;
  L := Sqrt(DX * DX + DY * DY);
  if L = 0 then
    Exit;
  NX := -DY / L * HalfWidth;
  NY := DX / L * HalfWidth;
  AL.X := A.X + NX; AL.Y := A.Y + NY;
  AR.X := A.X - NX; AR.Y := A.Y - NY;
  BL.X := B.X + NX; BL.Y := B.Y + NY;
  BR.X := B.X - NX; BR.Y := B.Y - NY;
  AppendTriangle(AL, BL, BR, Triangles);
  AppendTriangle(AL, BR, AR, Triangles);
end;

procedure AppendBevel(const Prev, P, Next: TKMPointF; HalfWidth: Single;
  var Triangles: TSolidVertexArray);
var
  DX1, DY1, DX2, DY2, L1, L2, CrossValue: Double;
  NX1, NY1, NX2, NY2: Double;
  V1, V2: TKMPointF;
begin
  DX1 := Double(P.X) - Prev.X; DY1 := Double(P.Y) - Prev.Y;
  DX2 := Double(Next.X) - P.X; DY2 := Double(Next.Y) - P.Y;
  L1 := Sqrt(DX1 * DX1 + DY1 * DY1);
  L2 := Sqrt(DX2 * DX2 + DY2 * DY2);
  if (L1 = 0) or (L2 = 0) then Exit;
  DX1 := DX1 / L1; DY1 := DY1 / L1;
  DX2 := DX2 / L2; DY2 := DY2 / L2;
  CrossValue := DX1 * DY2 - DY1 * DX2;
  if (Abs(CrossValue) <= 1E-6) or ((DX1 + DX2) * (DX1 + DX2) +
      (DY1 + DY2) * (DY1 + DY2) <= 1E-12) then Exit;
  NX1 := -DY1 * HalfWidth; NY1 := DX1 * HalfWidth;
  NX2 := -DY2 * HalfWidth; NY2 := DX2 * HalfWidth;
  if CrossValue > 0 then
  begin
    V1.X := P.X - NX2; V1.Y := P.Y - NY2;
    V2.X := P.X - NX1; V2.Y := P.Y - NY1;
  end
  else
  begin
    V1.X := P.X + NX1; V1.Y := P.Y + NY1;
    V2.X := P.X + NX2; V2.Y := P.Y + NY2;
  end;
  AppendTriangle(P, V1, V2, Triangles);
end;

procedure AppendOpenRun(const A, B: TKMPointF;
  StartDistance, EndDistance, TotalLength: Double;
  HalfWidth: Single; var Triangles: TSolidVertexArray);
var
  StartPoint, EndPoint: TKMPointF;
begin
  if TotalLength <= 0 then Exit;
  StartPoint.X := A.X + (B.X - A.X) * (StartDistance / TotalLength);
  StartPoint.Y := A.Y + (B.Y - A.Y) * (StartDistance / TotalLength);
  EndPoint.X := A.X + (B.X - A.X) * (EndDistance / TotalLength);
  EndPoint.Y := A.Y + (B.Y - A.Y) * (EndDistance / TotalLength);
  AppendRibbon(StartPoint, EndPoint, HalfWidth, Triangles);
end;

procedure EmitSolidStroke(const Triangles: TSolidVertexArray;
  const aColor: TKMColor4f);
var
  I: Integer;
begin
  if Length(Triangles) = 0 then Exit;
  if Length(Triangles) mod 3 <> 0 then
    raise Exception.Create('invalid AUX stroke output');
  for I := 0 to High(Triangles) do
    if IsNan(Triangles[I].X) or IsInfinite(Triangles[I].X)
      or IsNan(Triangles[I].Y) or IsInfinite(Triangles[I].Y)
      or IsNan(Triangles[I].Z) or IsInfinite(Triangles[I].Z) then
      raise Exception.Create('non-finite AUX stroke output');
  TKMRender.DrawSolidTriangles(Triangles, aColor);
end;

procedure KMRenderAuxMobileStroke(const aPoints: array of TKMPointF;
  aClosed: Boolean; aWorldWidth: Single; aPattern: Word;
  aPatternBitWorldLength: Single; const aColor: TKMColor4f);
var
  Points: TPointArray;
  Triangles: TSolidVertexArray;
  I, N: Integer;
  K: Int64;
  L, BitLength, S: Double;
  RunOpen: Boolean;
begin
  if not IsFiniteColor(aColor) then
    raise Exception.Create('non-finite AUX stroke color');
  if IsNan(aWorldWidth) or IsInfinite(aWorldWidth) or (aWorldWidth <= 0) then
    raise Exception.Create('invalid AUX stroke width');
  for I := 0 to High(aPoints) do
    if not IsFinitePoint(aPoints[I]) then
      raise Exception.Create('non-finite AUX stroke point');
  if (aPattern <> $FFFF) and (aPattern <> 0) then
  begin
    if aClosed or (Length(aPoints) <> 2) then
      raise Exception.Create('invalid patterned AUX stroke');
    if IsNan(aPatternBitWorldLength) or IsInfinite(aPatternBitWorldLength)
      or (aPatternBitWorldLength <= 0) then
      raise Exception.Create('invalid AUX stroke pattern length');
  end;

  SetLength(Points, 0);
  for I := 0 to High(aPoints) do
    if (Length(Points) = 0) or not SameAdjacentPoint(Points[High(Points)], aPoints[I]) then
    begin
      SetLength(Points, Length(Points) + 1);
      Points[High(Points)] := aPoints[I];
    end;
  if aClosed and NearClosingRepeat(Points) then
    SetLength(Points, Length(Points) - 1);
  N := Length(Points);
  if ((not aClosed) and (N < 2)) or (aClosed and (N < 3)) or (aPattern = 0) then
    Exit;
  if aClosed then
  begin
    I := 2;
    while I < N do
    begin
      if not SameAdjacentPoint(Points[I], Points[0])
        and not SameAdjacentPoint(Points[I], Points[1]) then Break;
      Inc(I);
    end;
    if I = N then Exit;
  end;

  if aPattern = $FFFF then
  begin
    for I := 0 to N - 2 do
    begin
      AppendRibbon(Points[I], Points[I + 1], aWorldWidth / 2, Triangles);
      if I > 0 then
        AppendBevel(Points[I - 1], Points[I], Points[I + 1], aWorldWidth / 2, Triangles);
    end;
    if aClosed then
    begin
      AppendRibbon(Points[N - 1], Points[0], aWorldWidth / 2, Triangles);
      AppendBevel(Points[N - 2], Points[N - 1], Points[0], aWorldWidth / 2, Triangles);
      AppendBevel(Points[N - 1], Points[0], Points[1], aWorldWidth / 2, Triangles);
    end;
  end
  else
  begin
    L := Distance(Points[0], Points[1]);
    if L = 0 then Exit;
    BitLength := aPatternBitWorldLength;
    RunOpen := False;
    S := 0;
    K := 0;
    while K * BitLength < L do
    begin
      if ((aPattern shr Integer(K mod 16)) and 1) <> 0 then
      begin
        if not RunOpen then S := K * BitLength;
        RunOpen := True;
      end
      else if RunOpen then
      begin
        AppendOpenRun(Points[0], Points[1], S, K * BitLength, L,
          aWorldWidth / 2, Triangles);
        RunOpen := False;
      end;
      Inc(K);
    end;
    if RunOpen then
      AppendOpenRun(Points[0], Points[1], S, L, L, aWorldWidth / 2, Triangles);
  end;
  EmitSolidStroke(Triangles, aColor);
end;

procedure KMRenderAuxMobileFill(const aPoints: array of TKMPointF;
  const aColor: TKMColor4f);
var
  Points: TPointArray;
  Remaining: TIndexArray;
  SolidVertices: TSolidVertexArray;
  I, J, N, EarIndex, PrevIndex, CurrIndex, NextIndex, PointIndex: Integer;
  ExpectedVertexCount: Int64;
  Area, CrossValue, Winding: Double;
  FoundEar: Boolean;
  P: TKMPointF;
begin
  for I := 0 to High(aPoints) do
    if not IsFinitePoint(aPoints[I]) then
      raise Exception.Create('non-finite AUX fill point');
  if not IsFiniteColor(aColor) then
    raise Exception.Create('non-finite AUX fill color');

  SetLength(Points, 0);
  for I := 0 to High(aPoints) do
    if (Length(Points) = 0) or not SameAdjacentPoint(Points[High(Points)], aPoints[I]) then
    begin
      SetLength(Points, Length(Points) + 1);
      Points[High(Points)] := aPoints[I];
    end;

  if NearClosingRepeat(Points) then
    SetLength(Points, Length(Points) - 1);
  N := Length(Points);
  if N < 3 then
    Exit;

  for I := 0 to N - 1 do
    for J := I + 1 to N - 1 do
      if SegmentCrossesOrTouchesNonNeighbor(Points, I, J) then
        raise Exception.Create('invalid AUX fill perimeter');

  Area := 0;
  for I := 0 to N - 1 do
  begin
    J := (I + 1) mod N;
    Area := Area + Double(Points[I].X) * Points[J].Y
                  - Double(Points[J].X) * Points[I].Y;
  end;
  if Abs(Area) / 2 <= 1E-6 then
    Exit;
  Winding := 1;
  if Area < 0 then
    Winding := -1;

  if N = 3 then
  begin
    AppendTriangle(Points[0], Points[1], Points[2], SolidVertices);
  end
  else
  begin
    SetLength(Remaining, N);
    for I := 0 to N - 1 do
      Remaining[I] := I;

    while Length(Remaining) > 3 do
    begin
      FoundEar := False;
      for I := 0 to High(Remaining) do
      begin
        PrevIndex := (I + Length(Remaining) - 1) mod Length(Remaining);
        NextIndex := (I + 1) mod Length(Remaining);
        PrevIndex := Remaining[PrevIndex];
        CurrIndex := Remaining[I];
        NextIndex := Remaining[NextIndex];
        CrossValue := SignedCross(Points[PrevIndex], Points[CurrIndex], Points[NextIndex]);
        if (Winding * CrossValue <= 0) or (Abs(CrossValue) / 2 <= 1E-6) then
          Continue;

        FoundEar := True;
        for J := 0 to High(Remaining) do
        begin
          PointIndex := Remaining[J];
          if (PointIndex = PrevIndex) or (PointIndex = CurrIndex) or (PointIndex = NextIndex) then
            Continue;
          if PointInOrOnTriangle(Points[PointIndex], Points[PrevIndex],
            Points[CurrIndex], Points[NextIndex], Winding) then
          begin
            FoundEar := False;
            Break;
          end;
        end;
        if not FoundEar then
          Continue;

        AppendTriangle(Points[PrevIndex], Points[CurrIndex], Points[NextIndex], SolidVertices);
        EarIndex := I;
        for J := EarIndex to High(Remaining) - 1 do
          Remaining[J] := Remaining[J + 1];
        SetLength(Remaining, Length(Remaining) - 1);
        FoundEar := True;
        Break;
      end;

      if not FoundEar then
        raise Exception.Create('invalid polygon triangulation');
    end;

    AppendTriangle(Points[Remaining[0]], Points[Remaining[1]],
      Points[Remaining[2]], SolidVertices);
  end;

  if Length(SolidVertices) mod 3 <> 0 then
    raise Exception.Create('invalid AUX fill output');
  ExpectedVertexCount := Int64(N - 2) * 3;
  if Length(SolidVertices) <> ExpectedVertexCount then
    raise Exception.Create('invalid AUX fill output');
  for I := 0 to High(SolidVertices) do
    if IsNan(SolidVertices[I].X) or IsInfinite(SolidVertices[I].X)
      or IsNan(SolidVertices[I].Y) or IsInfinite(SolidVertices[I].Y)
      or IsNan(SolidVertices[I].Z) or IsInfinite(SolidVertices[I].Z) then
      raise Exception.Create('non-finite AUX fill output');

  if Length(SolidVertices) = 0 then
    Exit;
  TKMRender.DrawSolidTriangles(SolidVertices, aColor);
end;

end.