Allow drawing the polygon stuff via GUI

Graphics/Diagram/Gtk.hs

@@ -11,14 +11,14 @@ import Parser.Meshparser
 
 
 -- |Create the Diagram from the points.
-diag :: DiagProp -> [PT] -> Diagram Cairo R2
-diag p = case alg p of
+diag :: DiagProp -> [[PT]] -> Diagram Cairo R2
+diag p pts = case alg p of
   0 ->
     mkDiag
       (mconcat [maybeDiag (ct p) coordPointsText,
         coordPoints, xAxis, yAxis,
         maybeDiag (gd p) grid, whiteRectB])
-      p
+      p (head pts)
   1 ->
     mkDiag
       (mconcat
@@ -26,15 +26,48 @@ diag p = case alg p of
         convexHP, convexHLs,
         coordPoints, xAxis, yAxis,
         maybeDiag (gd p) grid, whiteRectB])
-      p
+      p (head pts)
+  2 -> polys
+  3 ->
+      polyIntText
+      `atop`
+      polyIntersection (head pts) (pts !! 1) p
+      `atop`
+      polys
   _ -> mempty
+  where
+    polys =
+      mkDiag
+        (mconcat [maybeDiag (ct p) coordPointsText, polyLines])
+        p (head pts)
+      `atop`
+      mkDiag
+        (mconcat
+          [maybeDiag (ct p) coordPointsText,
+          polyLines, coordPoints, xAxis, yAxis,
+          maybeDiag (gd p) grid, whiteRectB])
+        p (pts !! 1)
+    polyIntText = if ct p
+                    then polyIntersectionText (head pts) (pts !! 1) p
+                    else mempty
+
 
 
 -- |Create the Diagram from a String which is supposed to be the contents
 -- of an obj file.
 diagS :: DiagProp -> MeshString -> Diagram Cairo R2
-diagS p mesh =
-  (diag p       .
-      meshToArr $
-      mesh) #
-    bg white
+diagS p mesh = case alg p of
+  2 ->
+    diag p.
+      facesToArr $
+      mesh
+  3 ->
+    diag p.
+      facesToArr $
+      mesh
+  _ ->
+    (diag p       .
+        (:[])     .
+        meshToArr $
+        mesh) #
+      bg white

Graphics/Diagram/Plotter.hs

@@ -5,6 +5,7 @@ module Graphics.Diagram.Plotter where
 import Algebra.Vector
 import Algebra.VectorTypes
 import Algorithms.ConvexHull.GrahamScan
+import Algorithms.PolygonIntersection.Core
 import Data.Monoid
 import Diagrams.Backend.Cairo
 import Diagrams.Prelude hiding ((<>))
@@ -44,6 +45,54 @@ coordPointsText = Diag cpt
         vtf = filter (inRange (dX p) (dY p)) vt
 
 
+-- |Draw the lines of the polygon.
+polyLines :: Diag
+polyLines = Diag pp
+  where
+    pp _ []  = mempty
+    pp p vt =
+        (strokeTrail        .
+          fromVertices      $
+          vtf ++ [head vtf])   #
+        moveTo (head vt)       #
+        lc black
+      where
+        vtf = filter (inRange (dX p) (dY p)) vt
+
+
+-- |Show the intersection points of two polygons as red dots.
+polyIntersection :: [PT]
+                 -> [PT]
+                 -> DiagProp
+                 -> Diagram Cairo R2
+polyIntersection pA pB p =
+  position (zip vtpi (repeat dot))
+  where
+    paF  = filter (inRange (dX p) (dY p)) pA
+    pbF  = filter (inRange (dX p) (dY p)) pB
+    dot  = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
+    vtpi = intersectionPoints
+            . sortLexPolys
+            $ (sortLexPoly paF, sortLexPoly pbF)
+
+
+-- |Show the intersection points of two polygons as red dots.
+polyIntersectionText :: [PT]
+                     -> [PT]
+                     -> DiagProp
+                     -> Diagram Cairo R2
+polyIntersectionText pA pB p =
+  position $
+    zip vtpi
+        (pointToTextCoord # fc red <$> vtpi) # translate (r2 (0, 10))
+  where
+    paF  = filter (inRange (dX p) (dY p)) pA
+    pbF  = filter (inRange (dX p) (dY p)) pB
+    vtpi = intersectionPoints
+            . sortLexPolys
+            $ (sortLexPoly paF, sortLexPoly pbF)
+
+
 -- |Create a diagram which shows the points of the convex hull.
 convexHP :: Diag
 convexHP = Diag chp