From 562fdbe26fdd5eb57ef9629dc377f98d3a76a1e1 Mon Sep 17 00:00:00 2001
From: hasufell <hasufell@hasufell.de>
Date: Sun, 16 Nov 2014 16:44:26 +0100
Subject: [PATCH] DIAG: filter valid points earlier

This saves us some code duplication.
---
 Graphics/Diagram/Gif.hs     |  2 +-
 Graphics/Diagram/Gtk.hs     | 14 ++++++++++---
 Graphics/Diagram/Plotter.hs | 42 +++++++++++++++----------------------
 3 files changed, 29 insertions(+), 29 deletions(-)

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