diff --git a/Graphics/Diagram/Gif.hs b/Graphics/Diagram/Gif.hs index 3d97b86..454e6f4 100644 --- a/Graphics/Diagram/Gif.hs +++ b/Graphics/Diagram/Gif.hs @@ -34,4 +34,4 @@ gifDiag p xs = -- |Same as gifDiag, except that it takes a string containing the -- mesh file content instead of the the points. gifDiagS :: DiagProp -> MeshString -> [(Diagram Cairo R2, GifDelay)] -gifDiagS p = gifDiag p . meshToArr +gifDiagS p = gifDiag p . filterValidPT p . meshToArr diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs index f349caf..51f4114 100644 --- a/Graphics/Diagram/Gtk.hs +++ b/Graphics/Diagram/Gtk.hs @@ -38,13 +38,21 @@ diag p objs@(Objects _) -- of an obj file. diagS :: DiagProp -> MeshString -> Diagram Cairo R2 diagS p mesh - | algo p == 2 || algo p == 3 = diag p. Objects . facesToArr $ mesh - | otherwise = (diag p . Object . meshToArr $ mesh) # bg white + | algo p == 2 || algo p == 3 = + diag p + . Objects + . fmap (filterValidPT p) + . facesToArr + $ mesh + | otherwise = (diag p . Object . filterValidPT p . meshToArr $ mesh) # bg white -- |Create the tree diagram from a String which is supposed to be the contents -- of an obj file. diagTreeS :: DiagProp -> MeshString -> Diagram Cairo R2 diagTreeS p mesh - | algo p == 4 = mkDiag treePretty p (Object . meshToArr $mesh) + | algo p == 4 = mkDiag treePretty p (Object + . filterValidPT p + . meshToArr + $ mesh) | otherwise = mempty diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs index 02acc8a..1bc417f 100644 --- a/Graphics/Diagram/Plotter.hs +++ b/Graphics/Diagram/Plotter.hs @@ -26,8 +26,7 @@ coordPoints = Diag cp cp p (Objects vts) = drawP (concat vts) p drawP [] _ = mempty drawP vt p = - position (zip (filterValidPT p vt) - (repeat dot)) + position (zip vt (repeat dot)) where dot = (circle $ dotSize p :: Diagram Cairo R2) # fc black @@ -54,11 +53,9 @@ coordPointsText = Diag cpt drawT vt p | showCoordText p = position - $ zip vtf (pointToTextCoord <$> vtf) + $ zip vt (pointToTextCoord <$> vt) # translate (r2 (0, 10)) | otherwise = mempty - where - vtf = filterValidPT p vt -- |Draw the lines of the polygon. @@ -66,15 +63,14 @@ polyLines :: Diag polyLines = Diag pp where pp _ (Objects []) = mempty - pp p (Objects (x:y:_)) = + pp _ (Objects (x:y:_)) = strokePoly x <> strokePoly y where strokePoly x' = (strokeTrail . fromVertices - $ vtf x' ++ [head . vtf $ x']) + $ x' ++ [head x']) # moveTo (head x') # lc black - vtf = filterValidPT p pp _ _ = mempty @@ -87,8 +83,8 @@ polyIntersection = Diag pi' dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red vtpi = intersectionPoints . sortLexPolys - $ (sortLexPoly . filterValidPT p $ x, - sortLexPoly . filterValidPT p $ y) + $ (sortLexPoly x, + sortLexPoly y) pi' _ _ = mempty @@ -106,8 +102,8 @@ polyIntersectionText = Diag pit' where vtpi = intersectionPoints . sortLexPolys - $ (sortLexPoly . filterValidPT p $ x, - sortLexPoly . filterValidPT p $ y) + $ (sortLexPoly x, + sortLexPoly y) pit' _ _ = mempty @@ -120,7 +116,7 @@ convexHP = Diag chp (repeat dot)) where dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red - vtch = grahamCH $ filterValidPT p vt + vtch = grahamCH vt chp _ _ = mempty @@ -135,7 +131,7 @@ convexHPText = Diag chpt (pointToTextCoord <$> vtchf) # translate (r2 (0, 10)) | otherwise = mempty where - vtchf = grahamCH . filterValidPT p $ vt + vtchf = grahamCH vt chpt _ _ = mempty @@ -145,15 +141,13 @@ convexHLs :: Diag convexHLs = Diag chl where chl _ (Object []) = mempty - chl p (Object vt) = + chl _ (Object vt) = (strokeTrail . fromVertices - . flip (++) [head $ grahamCH vtf] + . flip (++) [head $ grahamCH vt] . grahamCH - $ vtf) - # moveTo (head $ grahamCH vtf) # lc red - where - vtf = filterValidPT p vt + $ vt) + # moveTo (head $ grahamCH vt) # lc red chl _ _ = mempty @@ -164,7 +158,7 @@ convexHStepsLs :: Diag convexHStepsLs = GifDiag chs where chs p col f vt = - fmap mkChDiag (f . filterValidPT p $ vt) + fmap mkChDiag (f vt) where mkChDiag vt' = (strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col @@ -181,17 +175,15 @@ squares = Diag f $ (\((xmin, xmax), (ymin, ymax)) -> rect (xmax - xmin) (ymax - ymin) # moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2)) # lw ultraThin) <$> (quadTreeSquares (xDimension p, yDimension p) - . quadTree vtf + . quadTree vt $ (xDimension p, yDimension p)) - where - vtf = filterValidPT p vt f _ _ = mempty -- |Get the quad tree corresponding to the given points and diagram properties. qt :: [PT] -> DiagProp -> QuadTree PT -qt vt p = quadTree (filterValidPT p vt) (xDimension p, yDimension p) +qt vt p = quadTree vt (xDimension p, yDimension p) -- |Create a diagram that shows a single square of the RangeSearch algorithm