Allow drawing the polygon stuff via GUI

CG2.cabal

@@ -54,7 +54,7 @@ executable Gtk
   main-is:             GtkMain.hs
 
   -- Modules included in this executable, other than Main.
-  other-modules:       MyPrelude GUI.Gtk Graphics.Diagram.Gtk Graphics.Diagram.Types Graphics.Diagram.Plotter Parser.Meshparser Parser.Core System.FileSystem.FileExt Algebra.Vector Algorithms.ConvexHull.GrahamScan QueueEx
+  other-modules:       MyPrelude GUI.Gtk Graphics.Diagram.Gtk Graphics.Diagram.Types Graphics.Diagram.Plotter Parser.Meshparser Parser.Core System.FileSystem.FileExt Algebra.Vector Algorithms.ConvexHull.GrahamScan QueueEx Algorithms.PolygonIntersection.Core
 
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:
@@ -74,7 +74,7 @@ executable Gif
   main-is:             GifMain.hs
 
   -- Modules included in this executable, other than Main.
-  other-modules:       MyPrelude Graphics.Diagram.Gif Graphics.Diagram.Types Graphics.Diagram.Plotter Parser.Meshparser Parser.Core System.FileSystem.FileExt Algebra.Vector Algorithms.ConvexHull.GrahamScan QueueEx
+  other-modules:       MyPrelude Graphics.Diagram.Gif Graphics.Diagram.Types Graphics.Diagram.Plotter Parser.Meshparser Parser.Core System.FileSystem.FileExt Algebra.Vector Algorithms.ConvexHull.GrahamScan QueueEx Algorithms.PolygonIntersection.Core
 
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:

GUI/gtk2.glade

@@ -765,7 +765,9 @@ Public License instead of this License.
             <property name="visible">True</property>
             <property name="can_focus">False</property>
             <property name="items" translatable="yes">Show points
-Show convex hull</property>
+Show convex hull
+Show polygons
+Show polygons intersection</property>
           </widget>
           <packing>
             <property name="expand">False</property>

Graphics/Diagram/Gtk.hs

@@ -11,14 +11,14 @@ import Parser.Meshparser
 
 
 -- |Create the Diagram from the points.
-diag :: DiagProp -> [PT] -> Diagram Cairo R2
+diag :: DiagProp -> [[PT]] -> Diagram Cairo R2
-diag p = case alg p of
+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 =
+diagS p mesh = case alg p of
-  (diag p       .
+  2 ->
-      meshToArr $
+    diag p.
-      mesh) #
+      facesToArr $
-    bg white
+      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

Parser/Meshparser.hs

@@ -1,28 +1,42 @@
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
-module Parser.Meshparser (meshToArr) where
+module Parser.Meshparser (meshToArr, facesToArr) where
 
 import Algebra.VectorTypes
 import Control.Applicative
+import Data.Maybe
 import Diagrams.TwoD.Types
 import Parser.Core
 
 
--- | Convert a text String with multiple vertices into
+-- |Convert a text String with multiple vertices and faces into
+-- a list of vertices, ordered by the faces specification.
+facesToArr :: String -> [[PT]]
+facesToArr str = fmap (fmap (\y -> meshs str !! (fromIntegral y - 1)))
+                      (faces str)
+  where
+    meshs = meshToArr
+    faces = fmap fst . catMaybes . fmap (runParser parseFace) . lines
+
+
+-- |Convert a text String with multiple vertices into
 -- an array of float tuples.
 meshToArr :: String   -- ^ the string to convert
           -> [PT]     -- ^ the resulting vertice table
 meshToArr =
-  fmap p2                         .
+  fmap (p2 . fst)
-    fmap (\(Just (x, _)) -> x)    .
+    . catMaybes
-    filter (/= Nothing)           .
+    . fmap (runParser parseVertice)
-    fmap (runParser parseVertice) .
+    . lines
-    lines
 
 
--- | Creates a Parser that accepts a single vertice, such as 'v 1.0 2.0'.
+-- |Creates a Parser that accepts a single vertice, such as 'v 1.0 2.0'.
 parseVertice :: Parser (Double, Double)
 parseVertice =
-  (,)                                 <$>
+  (,)
-    (char 'v' *> spaces *> allDouble) <*>
+    <$> (char 'v' *> spaces *> allDouble)
-    (spaces *> allDouble)
+    <*> (spaces *> allDouble)
+
+
+parseFace :: Parser [Integer]
+parseFace = char 'f' *> oneOrMore (spaces *> posInt)