------------------------------------------------------------------------------
--                             G N A T C O L L                              --
--                                                                          --
--                     Copyright (C) 2010-2014, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Text_IO;       use Ada.Text_IO;
with GNATCOLL.Geometry;

procedure Test_Geometry is
   generic
      type Coordinate is digits <>;
      with package Geom is new GNATCOLL.Geometry (Coordinate);
   package Asserts is
      use Geom;

      Tolerance : constant Distance_Type := 1.0E-5;
      --  Tolerance when comparing distances

      procedure Dump (P1 : Point);
      procedure Dump (C : Circle);
      procedure Assert (P1, P2 : Point; Error : String);
      procedure Assert (B1, B2 : Boolean; Error : String);
      procedure Assert_Inside
        (P : Point; S : Segment;
         On_Line, On_Segment : Boolean;
         Error : String);
      procedure Assert_Inside_Triangle
        (P : Point; T : Triangle; Result : Boolean; Error : String);
      procedure Assert_Intersection
        (S1, S2 : Segment;
         On_Line, On_Segment : Point;
         Error : String);
      procedure Assert_Intersect_Triangle
        (T1, T2 : Triangle; Inter : Boolean; Error : String);
      procedure Assert_Intersect_Rectangle
        (R1, R2 : Rectangle; Inter : Boolean; Error : String);
      procedure Assert_Same_Side
        (P1, P2 : Point; S : Segment; Result : Boolean; Error : String);
      procedure Assert (D1, D2 : Coordinate'Base; Error : String);
      procedure Assert_Distance
         (P : Point; S : Segment; On_Line, On_Segment : Coordinate;
          Error : String);
      procedure Assert_Area
         (P : Polygon; D : Coordinate; Error : String);
      procedure Assert
         (C1, C2 : Circle; Error : String);
   end Asserts;

   package body Asserts is
      procedure Dump (P1 : Point) is
      begin
         if P1 = No_Point then
            Put ("No point");
         elsif P1 = Infinity_Points then
            Put ("Infinity of points");
         else
            Put ("(" & P1.X'Img & "," & P1.Y'Img & ")");
         end if;
      end Dump;

      procedure Dump (C : Circle) is
      begin
         Put ("(c="); Dump (C.Center);
         Put (" r=" & C.Radius'Img);
      end Dump;

      procedure Assert (P1, P2 : Point; Error : String) is
      begin
         if P1 /= P2 then
            Put_Line ("Error: " & Error);
            Put ("   "); Dump (P1); Put (" /= "); Dump (P2); New_Line;
         end if;
      end Assert;

      procedure Assert (B1, B2 : Boolean; Error : String) is
      begin
         if B1 /= B2 then
            Put_Line ("Error: " & Error);
            Put_Line ("   " & B1'Img & " /= " & B2'Img);
         end if;
      end Assert;

      procedure Assert_Inside
        (P : Point; S : Segment;
         On_Line, On_Segment : Boolean;
         Error : String)
      is
         SR : constant Segment := (S (2), S (1));
      begin
         Assert (Inside (P, To_Line (S)), On_Line, Error & " (line test)");
         Assert (Inside (P, To_Line (SR)), On_Line, Error & " (reverse line test)");
         Assert (Inside (P, S), On_Segment,
                 Error & " (segment test)");
         Assert (Inside (P, SR), On_Segment,
                 Error & " (reverse segment test)");
      end Assert_Inside;

      procedure Assert_Inside_Triangle
        (P : Point; T : Triangle; Result : Boolean; Error : String)
      is
      begin
         Assert (Inside (P, T), Result, Error & " (triangle test)");
         Assert (Inside (P, Polygon (T)), Result, Error & " (polygon test)");
      end Assert_Inside_Triangle;

      procedure Assert_Intersection
        (S1, S2 : Segment;
         On_Line, On_Segment : Point;
         Error : String)
      is
      begin
         Assert (Intersection (To_Line (S1), To_Line (S2)), On_Line,
                 Error & " (line test)");
         Assert (Intersection (To_Line (S2), To_Line (S1)), On_Line,
                 Error & " (reverse line test)");
         Assert (Intersection (S1, S2), On_Segment,
                 Error & " (segment test)");
         Assert (Intersection (S2, S1), On_Segment,
                 Error & " (reverse segment test)");
      end Assert_Intersection;

      procedure Assert_Intersect_Triangle
        (T1, T2 : Triangle; Inter : Boolean; Error : String)
      is
         T3 : constant Triangle := (T1 (2), T1 (3), T1 (1));
      begin
         Assert (Intersect (T1, T2), Inter, Error & " (test1)");
         Assert (Intersect (T2, T1), Inter, Error & " (test2)");
         Assert (Intersect (T3, T2), Inter, Error & " (test3)");
         Assert (Intersect (T2, T3), Inter, Error & " (test4)");
      end Assert_Intersect_Triangle;

      procedure Assert_Intersect_Rectangle
        (R1, R2 : Rectangle; Inter : Boolean; Error : String)
      is
      begin
         Assert (Intersect (R1, R2), Inter, Error);
      end Assert_Intersect_Rectangle;

      procedure Assert_Same_Side
        (P1, P2 : Point; S : Segment; Result : Boolean; Error : String) is
      begin
         Assert (Same_Side (P1, P2, S), Result, Error & " (segment test)");
         Assert (Same_Side (P1, P2, To_Line (S)), Result, Error & " (line test)");
      end Assert_Same_Side;

      procedure Assert (D1, D2 : Coordinate'Base; Error : String) is
      begin
         if abs (D1 - D2) > Tolerance then
            Put_Line ("Error: " & Error);
            Put_Line ("   " & D1'Img & " /= " & D2'Img);
         end if;
      end Assert;

      procedure Assert_Distance
         (P : Point; S : Segment; On_Line, On_Segment : Coordinate;
          Error : String)
      is
         SR : constant Segment := (S (2), S (1));
      begin
         Assert (Distance (P, To_Line (S)), On_Line, Error & " (line test)");
         Assert (Distance (P, To_Line (SR)),
                 On_Line, Error & " (reverse line test)");
         Assert (Distance (P, S), On_Segment,
                 Error & " (segment test)");
         Assert (Distance (P, SR), On_Segment,
                 Error & " (reverse segment test)");
      end Assert_Distance;

      procedure Assert_Area
         (P : Polygon; D : Coordinate; Error : String) is
      begin
         Assert (Area (P), abs (D), Error & " (poly test)");
         if P'Length = 3 then
            Assert (Area (Triangle (P)), D,
                    Error & " (triangle test)");
         end if;
      end Assert_Area;

      procedure Assert
         (C1, C2 : Circle; Error : String) is
      begin
         if C1 /= C2 then
            Put_Line ("Error: " & Error);
            Put ("   "); Dump (C1); Put (" /= "); Dump (C2); New_Line;
         end if;
      end Assert;
   end Asserts;

   generic
      type Coordinate is digits <>;
   procedure Tests;

   procedure Tests is
      package Geom is new GNATCOLL.Geometry (Coordinate);
      package Assertions is new Asserts (Coordinate, Geom);
      use Assertions, Geom, Geom.Coordinate_Elementary_Functions;
   begin
      Assert_Inside ((2.0, 0.0), ((0.0, 0.0), (10.0, 0.0)), True, True,
                     "Point on vertical line");
      Assert_Inside ((-1.0, 0.0), ((0.0, 0.0), (10.0, 0.0)), True, False,
                     "Point on vertical line, but not on segment");
      Assert_Inside ((0.0, 0.0), ((0.0, 0.0), (10.0, 0.0)), True, True,
                     "Point on vertical line at one end");
      Assert_Inside ((0.0, 2.0), ((0.0, 0.0), (0.0, 10.0)), True, True,
                     "Point on horizontal line");
      Assert_Inside ((0.0, -1.0), ((0.0, 0.0), (0.0, 10.0)), True, False,
                     "Point on horizontal line, but not on segment");
      Assert_Inside ((0.0, 0.0), ((0.0, 0.0), (0.0, 10.0)), True, True,
                     "Point on horizontal line at one end");
      Assert_Inside ((0.0, 0.0), ((-2.0, 2.0), (2.0, 2.0)), False, False,
                     "Not on line nor segment");
      Assert_Intersection
         (((0.0, 0.0), (10.0, 0.0)), ((0.0, 0.0), (10.0, 0.0)),
          Infinity_Points, Infinity_Points,
          "Intersection of same horizontal line is infinite");
      Assert_Intersection
         (((0.0, 0.0), (10.0, 0.0)), ((0.0, 0.0), (5.0, 0.0)),
          Infinity_Points, Infinity_Points,
          "Intersection of overlapping horizontal line is infinite");
      Assert_Intersection
         (((0.0, 0.0), (0.0, 10.0)), ((0.0, 0.0), (0.0, 10.0)),
          Infinity_Points, Infinity_Points,
          "Intersection of same vertical line is infinite");
      Assert_Intersection
         (((0.0, 0.0), (0.0, 10.0)), ((0.0, 0.0), (0.0, 5.0)),
           Infinity_Points, Infinity_Points,
          "Intersection of overlapping vertical vectors is infinite");
      Assert_Intersection
         (((0.0, 0.0), (10.0, 0.0)), ((-2.0, 2.0), (2.0, 2.0)),
           No_Point, No_Point,
          "No intersection of parallel vectors");
      Assert_Intersection
         (((0.0, 0.0), (10.0, 0.0)), ((11.0, 0.0), (20.0, 0.0)),
           Infinity_Points, No_Point,
           "Intersection of aligned vectors");
      Assert_Intersection
         (((0.0, 0.0), (0.0, 10.0)), ((-2.0, 2.0), (2.0, 2.0)),
           Point'(0.0, 2.0), Point'(0.0, 2.0),
           "Simple segment intersection");
      Assert_Intersection
         (((0.0, 0.0), (0.0, 10.0)), ((-2.0, 0.0), (2.0, 0.0)),
           Point'(0.0, 0.0), Point'(0.0, 0.0),
           "Intersection at one end of the vectors");
      Assert_Intersection
         (((0.0, 0.0), (10.0, 0.0)), ((-2.0, 2.0), (2.0, 2.0)),
           No_Point, No_Point,
           "Parallel lines have no intersection");
      Assert_Distance
         ((0.0, 0.0), ((-2.0, 2.0), (2.0, 2.0)), 2.0, 2.0,
           "Simple distance to line");
      Assert_Distance
         ((0.0, 2.0), ((-2.0, 2.0), (2.0, 2.0)), 0.0, 0.0,
           "Distance when point on line");
      Assert_Distance
         ((-3.0, 2.0), ((-2.0, 2.0), (2.0, 2.0)), 0.0, 1.0,
           "Distance when point on line, not on segment");
      Assert_Distance
         ((-3.0, 0.0), ((-2.0, 2.0), (2.0, 2.0)), 2.0, Sqrt (5.0),
           "Distance when orthogonal projection not on segment");
      Assert_Area
         (((0.0, 0.0), (4.0, 0.0), (0.0, 3.0)), 6.0,
           "Area of a counter-clockwise triangle");
      Assert_Area
         (((0.0, 0.0), (0.0, 3.0), (4.0, 0.0)), 6.0,
           "Area of clockwise triangle");
      Assert_Area
         (((0.0, 0.0), (0.0, 3.0), (2.0, 3.0), (2.0, 4.0),
           (3.0, 4.0), (3.0, 0.0)), 10.0,
           "Area for two squares (non-convex)");
      Assert
         (To_Circle ((0.0, 0.0), (1.0, 0.0), (0.0, 1.0)),
          ((0.5, 0.5), Sqrt (0.5)),
          "Circle from point");
      Assert_Inside_Triangle
         ((0.0, 0.0), ((0.0, 0.0), (0.0, 1.0), (1.0, 0.0)),
          True, "Point on boundary of triangle");
      Assert_Inside_Triangle
         ((0.1, 0.1), ((0.0, 0.0), (0.0, 1.0), (1.0, 0.0)),
          True, "Point inside triangle");
      Assert_Inside_Triangle
         ((0.5, 1.0), ((0.0, 0.0), (0.0, 1.0), (1.0, 0.0)),
          False, "Point outside triangle");
      Assert
         (Inside ((2.5, 3.5),
                  Poly => ((0.0, 0.0), (0.0, 3.0), (2.0, 3.0), (2.0, 4.0),
                   (3.0, 4.0), (3.0, 0.0))), True,
          "Point inside non-convex polygon");
      Assert
         (Inside ((2.0, 2.5),
                  Poly => ((0.0, 0.0), (0.0, 3.0), (2.0, 3.0), (2.0, 4.0),
                   (3.0, 4.0), (3.0, 0.0))), True,
          "Point inside non-convex polygon, vertically below vertex");
      Assert_Same_Side
         ((0.0, 0.0), (4.0, 0.0), ((-2.0, 2.0), (2.0, 2.0)), True,
          "Same side of horizontal line");
      Assert_Same_Side
         ((0.0, 0.0), (0.0, 4.0), ((-2.0, 2.0), (-2.0, -2.0)), True,
          "Same side of vertical line");
      Assert_Same_Side
         ((0.0, 0.0), (4.0, 0.0), ((2.0, 2.0), (2.0, -2.0)), False,
          "Not same side of vertical line");
      Assert
         (Centroid (((0.0, 0.0), (1.0, 0.0), (1.0, 1.0), (0.0, 1.0))),
          (0.5, 0.5),
          "Centroid of rectangle");
      Assert
         (Centroid (((0.0, 0.0), (1.0, 0.0), (0.0, 1.0))),
          (1.0 / 3.0, 1.0 / 3.0),
          "Centroid of triangle");
      Assert_Intersect_Triangle
         (((0.0, 0.0), (1.0, 0.0), (0.0, 1.0)),
          ((0.5, 0.0), (1.5, 0.0), (0.5, 1.0)),
          True, "Intersection of two triangles");
      Assert_Intersect_Triangle
         (((0.0, 0.0), (1.0, 0.0), (0.0, 1.0)),
          ((1.0, 0.0), (2.0, 0.0), (1.0, 1.0)),
          True, "Intersection with one common vertex");
      Assert_Intersect_Triangle
         (((0.0, 0.0), (1.0, 0.0), (0.0, 1.0)),
          ((1.1, 0.0), (2.1, 0.0), (1.1, 1.0)),
          False, "No Intersection");
      Assert_Intersect_Rectangle
         (((0.0, 0.0), (1.0, 1.0)),
          ((0.5, 0.0), (1.5, 2.0)),
          True, "Intersection of rectangles");
      Assert_Intersect_Rectangle
         (((0.0, 0.0), (1.0, 1.0)),
          ((0.5, 1.0), (1.5, 2.0)),
          True, "Intersection of rectangles with common edge");
      Assert_Intersect_Rectangle
         (((0.0, 0.0), (1.0, 1.0)),
          ((0.5, 1.1), (1.5, 2.0)),
          False, "No intersection of rectangles");

      --  From the documentation of Boost geometry
      --  http://geometrylibrary.geodan.nl/
   
      declare
         P1 : constant Point := (1.0, 1.0);
         P2 : constant Point := (2.0, 3.0);
         P3 : constant Point := (3.7, 2.0);
         P  : constant Polygon :=
            ((2.0, 1.3), (4.1, 3.0), (5.3, 2.6), (2.9, 0.7));
      begin
         Assert (2.23607, Distance (P1, P2), "Distance P1-P2");
         Assert (3.015,   Area (P), "Area of polygon");
         Assert (True,    Inside (P3, P), "Point inside polygon");
         Assert (1.04403, Distance (P1, P), "Distance point-polygon");
      end;
   end Tests;

begin
   declare
      subtype Coordinate is Float;
      procedure Float_Tests is new Tests (Coordinate);
   begin
      Float_Tests;
   end;

   --  Check we can instantiate with more restricted types

   declare
      type Coordinate is digits 1 range -500.0 .. 500.0;
      procedure Float_Tests is new Tests (Coordinate);
   begin
      Float_Tests;
   end;

   declare
      type Coordinate is digits 1 range -500.0 .. -200.0;
      package Geom is new GNATCOLL.Geometry (Coordinate);
      package Assertions is new Asserts (Coordinate, Geom);
      use Geom, Assertions;
      P1 : constant Point := (-401.0, -401.0);
      P2 : constant Point := (-402.0, -403.0);
   begin
      Assert (2.23607, Distance (P1, P2), "Distance P1-P2");
   end;


end Test_Geometry;

