DIAG: improve readability

Graphics/Diagram/Plotter.hs

@@ -25,7 +25,7 @@ drawP [] _  = mempty
 drawP vt ds =
   position (zip vt (repeat dot))
   where
-    dot = (circle ds :: Diagram Cairo R2)
+    dot = circle ds :: Diagram Cairo R2
 
 
 -- |Create a rectangle around a diagonal line, which has sw
@@ -68,9 +68,7 @@ coordPointsText = Diag cpt
     cpt p (Objects vts) = drawT (concat vts) p
     drawT [] _ = mempty
     drawT vt p
-      | showCoordText p =
+      | showCoordText p = position $ zip vt (pointToTextCoord <$> vt)
-          position
-          $ zip vt (pointToTextCoord <$> vt)
           # translate (r2 (0, 10))
       | otherwise = mempty
 
@@ -83,10 +81,7 @@ polyLines = Diag pp
     pp _ (Objects (x:y:_)) =
       strokePoly x <> strokePoly y
       where
-        strokePoly x' =
+        strokePoly x' = (strokeTrail . fromVertices $ x' ++ [head x'])
-          (strokeTrail
-           . fromVertices
-           $ x' ++ [head x'])
           # moveTo (head x') # lc black
     pp _ _  = mempty
 
@@ -97,10 +92,7 @@ polyIntersection = Diag pi'
   where
     pi' p (Objects (x:y:_)) = drawP vtpi (dotSize p) # fc red # lc red
       where
-        vtpi = intersectionPoints
+        vtpi = intersectionPoints . sortLexPolys $ (sortLexPoly x, sortLexPoly y)
-               . sortLexPolys
-               $ (sortLexPoly x,
-                  sortLexPoly y)
     pi' _ _ = mempty
 
 
@@ -109,10 +101,7 @@ polyIntersectionText :: Diag
 polyIntersectionText = Diag pit'
   where
     pit' p (Objects (x:y:_))
-      | showCoordText p =
+      | showCoordText p = position . zip vtpi $ (pointToTextCoord # fc red <$> vtpi)
-          position
-          . zip vtpi
-          $ (pointToTextCoord # fc red <$> vtpi)
           # translate (r2 (0, 10))
       | otherwise = mempty
       where
@@ -137,9 +126,7 @@ convexHPText = Diag chpt
   where
     chpt p (Object vt)
       | showCoordText p =
-          position $
+          position $ zip vtchf (pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
-            zip vtchf
-                (pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
       | otherwise = mempty
       where
         vtchf = grahamCH vt
@@ -153,11 +140,7 @@ convexHLs = Diag chl
   where
     chl _ (Object []) = mempty
     chl _ (Object vt) =
-      (strokeTrail
+      (strokeTrail . fromVertices . flip (++) [head $ grahamCH vt] . grahamCH $ vt)
-       . fromVertices
-       . flip (++) [head $ grahamCH vt]
-       . grahamCH
-       $ vt)
         # moveTo (head $ grahamCH vt) # lc red
     chl _ _ = mempty
 
@@ -168,11 +151,9 @@ convexHLs = Diag chl
 convexHStepsLs :: Diag
 convexHStepsLs = GifDiag chs
   where
-    chs _ col f vt =
+    chs _ col f vt = fmap mkChDiag (f vt)
-      fmap mkChDiag (f vt)
       where
-        mkChDiag vt' =
+        mkChDiag vt' = (strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col
-          (strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col
 
 
 -- |Create a diagram that shows all squares of the RangeSearch algorithm
@@ -338,11 +319,9 @@ xAxis =
   <> Diag segments
   <> Diag labels
   where
-    hRule p _ =
+    hRule p _ = arrowAt (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
-      arrowAt (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
                         (r2 (diagWidth p, 0))
-    segments p _ =
+    segments p _ =  hcat' (with & sep .~ squareSize p)
-      hcat' (with & sep .~ squareSize p)
                           (replicate (floor . (/) (diagWidth p) $ squareSize p)
                                      (vrule 10))
       # moveTo (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
@@ -410,15 +389,13 @@ grid :: Diag
 grid = Diag xGrid <> Diag yGrid
   where
     yGrid p _
-      | haveGrid p =
+      | haveGrid p = hcat' (with & sep .~ squareSize p)
-          hcat' (with & sep .~ squareSize p)
                            (replicate (floor . (/) (diagWidth p) $ squareSize p)
                                       (vrule $ diagHeight p))
           # moveTo (p2 (diagXmin p, diagHeightOffset p)) # lw ultraThin
       | otherwise = mempty
     xGrid p _
-      | haveGrid p =
+      | haveGrid p = vcat' (with & sep .~ squareSize p)
-          vcat' (with & sep .~ squareSize p)
                            (replicate (floor . (/) (diagHeight p) $ squareSize p)
                                       (hrule $ diagWidth p))
           # alignB # moveTo (p2 (diagWidthOffset p, diagYmin p)) # lw ultraThin