hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

DIAGRAM: fix grid/axis for negative dimensions

Browse Source
This commit is contained in:
hasufell 2014-10-11 03:24:18 +02:00
parent 5e5f305c65
commit bfa3665985
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Graphics/Diagram/Plotter.hs
View File

@ -111,7 +111,8 @@ xAxis =
(Diag labels) (Diag labels)
where where
hRule p _ = hRule p _ =
arrowAt (p2 (xlD p,0)) (r2 (xuD p, 0)) # moveTo (p2 (xlD p,0)) arrowAt (p2 (xlD p,0))
(r2 (xuD p - xlD p, 0))
segments p _ = segments p _ =
hcat' (with & sep .~ (sqS p)) hcat' (with & sep .~ (sqS p))
(take (floor . (/) (xuD p - xlD p) $ (sqS p)) . (take (floor . (/) (xuD p - xlD p) $ (sqS p)) .
@ -124,7 +125,7 @@ xAxis =
where where
xs :: [Int] xs :: [Int]
xs = take (floor . (/) (xuD p - xlD p) $ (sqS p)) xs = take (floor . (/) (xuD p - xlD p) $ (sqS p))
(iterate (+(floor . sqS $ p)) 0) (iterate (+(floor . sqS $ p)) (floor . xlD $ p))
mkPoint x = p2 (fromIntegral x, -15) mkPoint x = p2 (fromIntegral x, -15)
@ -137,7 +138,8 @@ yAxis =
(Diag labels) (Diag labels)
where where
vRule p _ = vRule p _ =
arrowAt (p2 (0, ylD p)) (r2 (0, yuD p)) # moveTo (p2 (0, ylD p)) arrowAt (p2 (0, ylD p))
(r2 (0, yuD p - ylD p))
segments p _ = segments p _ =
vcat' (with & sep .~ (sqS p)) vcat' (with & sep .~ (sqS p))
(take (floor . (/) (yuD p - ylD p) $ (sqS p)) . (take (floor . (/) (yuD p - ylD p) $ (sqS p)) .
@ -151,7 +153,7 @@ yAxis =
where where
ys :: [Int] ys :: [Int]
ys = take (floor . (/) (yuD p - ylD p) $ (sqS p)) ys = take (floor . (/) (yuD p - ylD p) $ (sqS p))
(iterate (+(floor . sqS $ p)) 0) (iterate (+(floor . sqS $ p)) (floor . ylD $ p))
mkPoint y = p2 (-15, fromIntegral y) mkPoint y = p2 (-15, fromIntegral y)
@ -177,15 +179,15 @@ grid :: Diag
grid = Diag xGrid `mappend` Diag yGrid grid = Diag xGrid `mappend` Diag yGrid
where where
yGrid p _ = yGrid p _ =
hcat' (with & sep .~ (sqS p)) hcat' (with & sep .~ sqS p)
(take (floor . (/) (xuD p - xlD p) $ (sqS p)) . (replicate (floor . (/) (xuD p - xlD p) $ sqS p)
repeat $ (vrule $ xuD p - xlD p)) # (vrule $ yuD p - ylD p)) #
moveTo (p2 (xlD p, (yuD p - ylD p) / 2)) # moveTo (p2 (xlD p, ylD p + ((yuD p - ylD p) / 2))) #
lw ultraThin lw ultraThin
xGrid p _ = xGrid p _ =
vcat' (with & sep .~ (sqS p)) vcat' (with & sep .~ sqS p)
(take (floor . (/) (yuD p - ylD p) $ (sqS p)) . (replicate (floor . (/) (yuD p - ylD p) $ sqS p)
repeat $ (hrule $ yuD p - ylD p)) # (hrule $ xuD p - xlD p)) #
alignB # alignB #
moveTo (p2 ((xuD p - xlD p) / 2, ylD p)) # moveTo (p2 (xlD p + ((xuD p - xlD p) / 2), ylD p)) #
lw ultraThin lw ultraThin