{-# OPTIONS_HADDOCK ignore-exports #-} module Graphics.Diagram.Plotter where import Data.Monoid import Diagrams.Prelude hiding ((<>)) import Graphics.Diagram.Core -- |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 -- |Show coordinates as text above all points. coordPointsText :: Diag coordPointsText = Diag f where f p vts = drawT (concat vts) p drawT [] _ = mempty drawT vt p | showCoordText p = position $ zip vt (pointToTextCoord <$> vt) # translate (r2 (0, 10)) | otherwise = mempty -- |Creates a Diagram that shows an XAxis which is bound -- by the dimensions given in xDimension from DiagProp. xAxis :: Diag xAxis = Diag hRule <> Diag segments <> Diag labels where hRule p _ = arrowAt (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p)) (r2 (diagWidth p, 0)) segments 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)) labels p _ = position . zip (mkPoint <$> xs) $ ((\x -> (text . show $ x) # scale 10) <$> xs) where xs :: [Int] xs = take (floor . (/) (diagWidth p) $ squareSize p) (iterate (+(floor . squareSize $ p)) (floor . diagXmin $ p)) mkPoint x = p2 (fromIntegral x, -15 + (if diagYmin p <= 0 then 0 else diagYmin p)) -- |Creates a Diagram that shows an YAxis which is bound -- by the dimensions given in yDimension from DiagProp. yAxis :: Diag yAxis = Diag vRule <> Diag segments <> Diag labels where vRule p _ = arrowAt (p2 (if diagXmin p <= 0 then 0 else diagXmin p, diagYmin p)) (r2 (0, diagHeight p)) segments p _ = vcat' (with & sep .~ squareSize p) (replicate (floor . (/) (diagHeight p) $ squareSize p) (hrule 10)) # alignB # moveTo (p2 (if diagXmin p <= 0 then 0 else diagXmin p, diagYmin p)) labels p _ = position . zip (mkPoint <$> ys) $ ((\x -> (text . show $ x) # scale 10) <$> ys) where ys :: [Int] ys = take (floor . (/) (diagHeight p) $ squareSize p) (iterate (+(floor . squareSize $ p)) (floor . diagYmin $ p)) mkPoint y = p2 (-15 + (if diagXmin p <= 0 then 0 else diagXmin p), fromIntegral y) -- |Creates a Diagram that shows a white rectangle which is a little -- bit bigger than both X and Y axis dimensions from DiagProp. whiteRectB :: Diag whiteRectB = Diag rect' where rect' p _ = rect (diagWidth p + (diagWidth p / 10)) (diagHeight p + (diagHeight p / 10)) # lwG 0.00 # bg white # moveTo (p2 (diagWidthOffset p, diagHeightOffset p)) where -- |Create a grid across the whole diagram with squares of the -- given size in DiagProp. grid :: Diag grid = Diag xGrid <> Diag yGrid where yGrid p _ | haveGrid 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 = vcat' (with & sep .~ squareSize p) (replicate (floor . (/) (diagHeight p) $ squareSize p) (hrule $ diagWidth p)) # alignB # moveTo (p2 (diagWidthOffset p, diagYmin p)) # lw ultraThin | otherwise = mempty plotterBG :: Diag plotterBG = mconcat [xAxis, yAxis, grid, whiteRectB]