PascalType.Geometry.pas

unit PascalType.Geometry;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  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 code is part of the PascalType Project                                //
//                                                                            //
//  The initial developer of this code is Anders Melander.                    //
//                                                                            //
//  Portions created by Anders Melander are Copyright (C) 2024                //
//  by Anders Melander. All Rights Reserved.                                  //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////

interface

{$I PT_Compiler.inc}

uses
  System.Types,
  PascalType.Classes,
  PascalType.Painter;

// TODO : Consider moving this to GR32_VectorUtils.

type
  TArrayOfFloatPoint = TArray<TFloatPoint>;
  TArrayOfArrayOfFloatPoint = TArray<TArray<TFloatPoint>>;


//------------------------------------------------------------------------------
//
//      IntersectPolygons and IntersectPolyPolygons
//
//------------------------------------------------------------------------------
function IntersectPolygons(const Subject, Clipper: TArrayOfFloatPoint): TArrayOfFloatPoint;

function IntersectPolyPolygons(const Subject, Clipper: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFloatPoint;


//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

implementation

uses
  Math;

//------------------------------------------------------------------------------
//
//      IntersectPolygons
//
//------------------------------------------------------------------------------
// Sutherland-Hodgman algorithm
//------------------------------------------------------------------------------
// Proof of concept; Completely unoptimized.
//------------------------------------------------------------------------------
function IntersectPolygons(const Subject, Clipper: TArrayOfFloatPoint): TArrayOfFloatPoint;
var
  InputList, OutputList: TArrayOfFloatPoint;

  function IsInside(const p, p1, p2: TFloatPoint): Boolean;
  begin
    Result := (p2.X - p1.X) * (p.Y - p1.Y) > (p2.Y - p1.Y) * (p.X - p1.X);
  end;

  function Intersect(const p1, p2, p3, p4: TFloatPoint): TFloatPoint;
  var
    num, den: Single;
  begin
    den := (p1.X - p2.X) * (p3.Y - p4.Y) - (p1.Y - p2.Y) * (p3.X - p4.X);
    if den = 0 then
    begin
      Result := p1;
      exit;
    end;
    num := (p1.X * p2.Y - p1.Y * p2.X) * (p3.X - p4.X) - (p1.X - p2.X) * (p3.X * p4.Y - p3.Y * p4.X);
    Result.X := num / den;
    num := (p1.X * p2.Y - p1.Y * p2.X) * (p3.Y - p4.Y) - (p1.Y - p2.Y) * (p3.X * p4.Y - p3.Y * p4.X);
    Result.Y := num / den;
  end;

begin
  if Length(Clipper) < 3 then
    Exit(Subject);

  OutputList := Subject;

  for var i := 0 to High(Clipper) do
  begin
    var cp1 := Clipper[i];
    var cp2 := Clipper[(i + 1) mod Length(Clipper)];

    InputList := OutputList;
    OutputList := nil;

    if Length(InputList) = 0 then
      Break;

    var s := InputList[High(InputList)];

    for var j := 0 to High(InputList) do
    begin
      var e := InputList[j];

      if IsInside(e, cp1, cp2) then
      begin
        if not IsInside(s, cp1, cp2) then
          OutputList := OutputList + [Intersect(s, e, cp1, cp2)];

        OutputList := OutputList + [e];
      end else
      if IsInside(s, cp1, cp2) then
        OutputList := OutputList + [Intersect(s, e, cp1, cp2)];

      s := e;
    end;
  end;

  Result := OutputList;
end;

//------------------------------------------------------------------------------
//
//      IntersectPolyPolygons
//
//------------------------------------------------------------------------------
function IntersectPolyPolygons(const Subject, Clipper: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFloatPoint;
begin
  // For now, we only support clipping against a single polygon Clipper.
  // Full Boolean operations would require a more complex library like Clipper.
  // COLRv1 usually specifies a single clip path.
  if Length(Clipper) = 0 then
    Exit(Subject);

  SetLength(Result, Length(Subject));
  for var i := 0 to High(Subject) do
    Result[i] := IntersectPolygons(Subject[i], Clipper[0]);
end;

end.