diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs index e19fb0e..6a71718 100644 --- a/Graphics/Diagram/Plotter.hs +++ b/Graphics/Diagram/Plotter.hs @@ -17,7 +17,7 @@ coordPoints :: Diag coordPoints = Diag cp where cp p vt = - position (zip (filter (inRange (dX p) (dY p)) $ vt) + position (zip (filter (inRange (dX p) (dY p)) vt) (repeat dot)) where dot = (circle $ t p :: Diagram Cairo R2) # fc black @@ -48,7 +48,7 @@ convexHullPoints :: Diag convexHullPoints = Diag chp where chp p vt = - position (zip (filter (inRange (dX p) (dY p)) $ vtch) + position (zip (filter (inRange (dX p) (dY p)) vtch) (repeat dot)) where dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red @@ -106,26 +106,26 @@ convexHullLinesInterval p xs = -- by the dimensions given in xD from DiagProp. xAxis :: Diag xAxis = - (Diag hRule) `mappend` - (Diag segments) `mappend` - (Diag labels) + Diag hRule `mappend` + Diag segments `mappend` + Diag labels where hRule p _ = - arrowAt (p2 (xlD p,0)) - (r2 (xuD p - xlD p, 0)) + arrowAt (p2 (xmin p,0)) + (r2 (w' p, 0)) segments p _ = - hcat' (with & sep .~ (sqS p)) - (take (floor . (/) (xuD p - xlD p) $ (sqS p)) . - repeat $ (vrule 10)) # - moveTo (p2 (xlD p,0)) + hcat' (with & sep .~ sqS p) + (replicate (floor . (/) (w' p) $ sqS p) + (vrule 10)) # + moveTo (p2 (xmin p,0)) labels p _ = position $ zip (mkPoint <$> xs) ((\x -> (text . show $ x) # scale 10) <$> xs) where xs :: [Int] - xs = take (floor . (/) (xuD p - xlD p) $ (sqS p)) - (iterate (+(floor . sqS $ p)) (floor . xlD $ p)) + xs = take (floor . (/) (w' p) $ sqS p) + (iterate (+(floor . sqS $ p)) (floor . xmin $ p)) mkPoint x = p2 (fromIntegral x, -15) @@ -133,27 +133,27 @@ xAxis = -- by the dimensions given in yD from DiagProp. yAxis :: Diag yAxis = - (Diag vRule) `mappend` - (Diag segments) `mappend` - (Diag labels) + Diag vRule `mappend` + Diag segments `mappend` + Diag labels where vRule p _ = - arrowAt (p2 (0, ylD p)) - (r2 (0, yuD p - ylD p)) + arrowAt (p2 (0, ymin p)) + (r2 (0, h' p)) segments p _ = - vcat' (with & sep .~ (sqS p)) - (take (floor . (/) (yuD p - ylD p) $ (sqS p)) . - repeat $ (hrule 10)) # + vcat' (with & sep .~ sqS p) + (replicate (floor . (/) (h' p) $ sqS p) + (hrule 10)) # alignB # - moveTo (p2 (0, (ylD p))) + moveTo (p2 (0, ymin p)) labels p _ = position $ zip (mkPoint <$> ys) ((\x -> (text . show $ x) # scale 10) <$> ys) where ys :: [Int] - ys = take (floor . (/) (yuD p - ylD p) $ (sqS p)) - (iterate (+(floor . sqS $ p)) (floor . ylD $ p)) + ys = take (floor . (/) (h' p) $ sqS p) + (iterate (+(floor . sqS $ p)) (floor . ymin $ p)) mkPoint y = p2 (-15, fromIntegral y) @@ -162,10 +162,11 @@ yAxis = whiteRectB :: Diag whiteRectB = Diag rect' where - rect' p _ = whiteRect (w' + 50) (h' + 50) # moveTo (p2 (w' / 2, h' / 2)) + rect' p _ = + whiteRect (w' p + 50) (h' p + 50) # + moveTo (p2 (wOff p, hOff p)) where - w' = xuD p - xlD p - h' = yuD p - ylD p + -- |Create a white rectangle with the given width and height. @@ -180,14 +181,15 @@ grid = Diag xGrid `mappend` Diag yGrid where yGrid p _ = hcat' (with & sep .~ sqS p) - (replicate (floor . (/) (xuD p - xlD p) $ sqS p) - (vrule $ yuD p - ylD p)) # - moveTo (p2 (xlD p, ylD p + ((yuD p - ylD p) / 2))) # + (replicate (floor . (/) (w' p) $ sqS p) + (vrule $ h' p)) # + moveTo (p2 (xmin p, hOff p)) # lw ultraThin xGrid p _ = vcat' (with & sep .~ sqS p) - (replicate (floor . (/) (yuD p - ylD p) $ sqS p) - (hrule $ xuD p - xlD p)) # - alignB # - moveTo (p2 (xlD p + ((xuD p - xlD p) / 2), ylD p)) # + (replicate (floor . (/) (h' p) $ sqS p) + (hrule $ w' p)) # + alignB # + moveTo (p2 (wOff p, ymin p)) # lw ultraThin + where diff --git a/Graphics/Diagram/Types.hs b/Graphics/Diagram/Types.hs index 352ad8d..b89ba14 100644 --- a/Graphics/Diagram/Types.hs +++ b/Graphics/Diagram/Types.hs @@ -59,23 +59,45 @@ defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50 -- |Extract the lower bound of the x-axis dimension. -xlD :: DiagProp -> Double -xlD = fst . dX +xmin :: DiagProp -> Double +xmin = fst . dX -- |Extract the upper bound of the x-axis dimension. -xuD :: DiagProp -> Double -xuD = snd . dX +xmax :: DiagProp -> Double +xmax = snd . dX -- |Extract the lower bound of the y-axis dimension. -ylD :: DiagProp -> Double -ylD = fst . dY +ymin :: DiagProp -> Double +ymin = fst . dY -- |Extract the upper bound of the y-axis dimension. -yuD :: DiagProp -> Double -yuD = snd . dY +ymax :: DiagProp -> Double +ymax = snd . dY + + +-- |The full width of the x dimension. +w' :: DiagProp -> Double +w' p = xmax p - xmin p + + +-- |The full height of the y dimension. +h' :: DiagProp -> Double +h' p = ymax p - ymin p + + +-- |The offset on the x-axis to move the grid and the white rectangle +-- to the right place. +wOff :: DiagProp -> Double +wOff p = xmin p + (w' p / 2) + + +-- |The offset on the y-axis to move the grid and the white rectangle +-- to the right place. +hOff :: DiagProp -> Double +hOff p = ymin p + (h' p / 2) -- |Returns the specified diagram if True is passed,