DIAG: fix plotter, rm moveTo if possible

Scaling the dimensions should now work better, including
scaled coordinate text and point thickness depending
on the diagram dimensions.

Graphics/Diagram/Plotter.hs

@@ -7,13 +7,26 @@ import Diagrams.Prelude hiding ((<>))
 import Graphics.Diagram.Core
 
 
+xAxisPoints :: DiagProp -> [Double]
+xAxisPoints p = takeWhile (< diagXmax p)
+                  . iterate (+ squareSize p)
+                  $ diagXmin p
+
+
+yAxisPoints :: DiagProp -> [Double]
+yAxisPoints p = takeWhile (< diagYmax p)
+                  . iterate (+ squareSize p)
+                  $ diagYmin p
+
+
 -- |Creates a Diagram that shows the coordinates from the points
 -- as dots. The points and thickness of the dots can be controlled
 -- via DiagProp.
 coordPoints :: Diag
 coordPoints = Diag f
   where
-    f p vts  = drawP (concat vts) (dotSize p) # fc black # lc black
+    f p vts  = drawP (concat vts) (relDotSize p) # fc black # lc black
+    relDotSize p = dotSize p / 500 * ((diagWidth p + diagHeight p) / 2)
 
 
 -- |Show coordinates as text above all points.
@@ -36,20 +49,27 @@ xAxis =
   <> Diag segments
   <> Diag labels
   where
-    hRule p _ = arrowAt (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
+    hRule p _ =
-                        (r2 (diagWidth p, 0))
+      arrowAt (p2 (diagXmin p, diagYminPos p))
-    segments p _ =  hcat' (with & sep .~ squareSize p)
+              (r2 (diagWidth p, 0))
-                          (replicate (floor . (/) (diagWidth p) $ squareSize p)
+    segments p _ =
-                                     (vrule 10))
+      mconcat
-      # moveTo (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
+        . fmap (\x -> p2 (x, diagYminPos p - segY)
-    labels p _ = position . zip (mkPoint <$> xs)
+                   ~~ p2 (x, diagYminPos p + segY))
-                                $ ((\x -> (text . show $ x) # scale 10) <$> xs)
+        $ xAxisPoints p
       where
-        xs :: [Int]
+        segY = diagWidth p / 100
-        xs = take (floor . (/) (diagWidth p) $ squareSize p)
+    labels p _ =
-                  (iterate (+(floor . squareSize $ p)) (floor . diagXmin $ p))
+      position
-        mkPoint x = p2 (fromIntegral x,
+        . zip (mkPoint <$> xAxisPoints p)
-                        -15 + (if diagYmin p <= 0 then 0 else diagYmin p))
+        $ ((\x -> (text . show . floor $ x) # scale labelScale)
+             <$> xAxisPoints p)
+        where
+          mkPoint x =
+            p2 (x, labelOffset + diagYminPos p)
+          labelScale = diagWidth p / 50
+          labelOffset = negate (diagWidth p / 50 * 2)
+    diagYminPos p = if diagYmin p <= 0 then 0 else diagYmin p
 
 
 -- |Creates a Diagram that shows an YAxis which is bound
@@ -60,22 +80,27 @@ yAxis =
   <> Diag segments
   <> Diag labels
   where
-    vRule p _ = arrowAt (p2 (if diagXmin p <= 0 then 0 else diagXmin p, diagYmin p))
+    vRule p _ =
-                        (r2 (0, diagHeight p))
+      arrowAt (p2 (diagXminPos p, diagYmin p))
-    segments p _ = vcat' (with & sep .~ squareSize p)
+              (r2 (0, diagHeight p))
-                         (replicate (floor . (/) (diagHeight p) $ squareSize p)
+    segments p _ =
-                                    (hrule 10))
+      mconcat
-      # alignB
+        . fmap (\y -> p2 (diagXminPos p - segX, y)
-      # moveTo (p2 (if diagXmin p <= 0 then 0 else diagXmin p, diagYmin p))
+                   ~~ p2 (diagXminPos p + segX, y))
-    labels p _ = position . zip (mkPoint <$> ys)
+        $ yAxisPoints p
-                                $ ((\x -> (text . show $ x) # scale 10) <$> ys)
+      where
+        segX = diagHeight p / 100
+    labels p _ =
+      position
+        . zip (mkPoint <$> yAxisPoints p)
+        $ ((\x -> (text . show . floor $ x) # scale labelScale)
+             <$> yAxisPoints p)
         where
-          ys :: [Int]
+          mkPoint y =
-          ys = take (floor . (/) (diagHeight p) $ squareSize p)
+            p2 (labelOffset + diagXminPos p, y)
-                    (iterate (+(floor . squareSize $ p)) (floor . diagYmin $ p))
+          labelScale = diagHeight p / 50
-          mkPoint y = p2 (-15 + (if diagXmin p <= 0 then 0 else diagXmin p),
+          labelOffset = negate (diagHeight p / 50 * 2)
-                          fromIntegral y)
+    diagXminPos p = if diagXmin p <= 0 then 0 else diagXmin p
-
 
 -- |Creates a Diagram that shows a white rectangle which is a little
 -- bit bigger than both X and Y axis dimensions from DiagProp.
@@ -87,7 +112,6 @@ whiteRectB = Diag rect'
                   # lwG 0.00
                   # bg white
                   # moveTo (p2 (diagWidthOffset p, diagHeightOffset p))
-      where
 
 
 -- |Create a grid across the whole diagram with squares of the
@@ -96,16 +120,18 @@ grid :: Diag
 grid = Diag xGrid <> Diag yGrid
   where
     yGrid p _
-      | haveGrid p = hcat' (with & sep .~ squareSize p)
+      | haveGrid p =
-                           (replicate (floor . (/) (diagWidth p) $ squareSize p)
+          mconcat
-                                      (vrule $ diagHeight p))
+            . fmap (\x -> p2 (x, diagYmin p)
-          # moveTo (p2 (diagXmin p, diagHeightOffset p)) # lw ultraThin
+                       ~~ p2 (x, diagYmax p) # lw ultraThin)
+            $ xAxisPoints p
       | otherwise = mempty
     xGrid p _
-      | haveGrid p = vcat' (with & sep .~ squareSize p)
+      | haveGrid p =
-                           (replicate (floor . (/) (diagHeight p) $ squareSize p)
+          mconcat
-                                      (hrule $ diagWidth p))
+            . fmap (\y -> p2 (diagXmin p, y)
-          # alignB # moveTo (p2 (diagWidthOffset p, diagYmin p)) # lw ultraThin
+                       ~~ p2 (diagXmax p, y) # lw ultraThin)
+            $ yAxisPoints p
       | otherwise = mempty