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)