diff --git a/CG2.cabal b/CG2.cabal
index e457765..5fa06a4 100644
--- a/CG2.cabal
+++ b/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:
diff --git a/GUI/gtk2.glade b/GUI/gtk2.glade
index 26e0e1b..bc7ffc4 100644
--- a/GUI/gtk2.glade
+++ b/GUI/gtk2.glade
@@ -765,7 +765,9 @@ Public License instead of this License.
True
False
Show points
-Show convex hull
+Show convex hull
+Show polygons
+Show polygons intersection
False
diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs
index b7f46a5..9b310d0 100644
--- a/Graphics/Diagram/Gtk.hs
+++ b/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
diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs
index 969b406..a9be94a 100644
--- a/Graphics/Diagram/Plotter.hs
+++ b/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
diff --git a/Parser/Meshparser.hs b/Parser/Meshparser.hs
index 96a180a..ff03aee 100644
--- a/Parser/Meshparser.hs
+++ b/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 (\(Just (x, _)) -> x) .
- filter (/= Nothing) .
- fmap (runParser parseVertice) .
- lines
+ fmap (p2 . fst)
+ . catMaybes
+ . fmap (runParser parseVertice)
+ . 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) <*>
- (spaces *> allDouble)
+ (,)
+ <$> (char 'v' *> spaces *> allDouble)
+ <*> (spaces *> allDouble)
+
+
+parseFace :: Parser [Integer]
+parseFace = char 'f' *> oneOrMore (spaces *> posInt)