DIAGRAM: improve behavior for dimensions like (100,300) (100,300)
This commit is contained in:
parent
6c66a7acb3
commit
d81e932d00
@ -111,13 +111,13 @@ xAxis =
|
|||||||
Diag labels
|
Diag labels
|
||||||
where
|
where
|
||||||
hRule p _ =
|
hRule p _ =
|
||||||
arrowAt (p2 (xmin p,0))
|
arrowAt (p2 (xmin p, if ymin p <= 0 then 0 else ymin p))
|
||||||
(r2 (w' p, 0))
|
(r2 (w' p, 0))
|
||||||
segments p _ =
|
segments p _ =
|
||||||
hcat' (with & sep .~ sqS p)
|
hcat' (with & sep .~ sqS p)
|
||||||
(replicate (floor . (/) (w' p) $ sqS p)
|
(replicate (floor . (/) (w' p) $ sqS p)
|
||||||
(vrule 10)) #
|
(vrule 10)) #
|
||||||
moveTo (p2 (xmin p,0))
|
moveTo (p2 (xmin p, if ymin p <= 0 then 0 else ymin p))
|
||||||
labels p _ =
|
labels p _ =
|
||||||
position $
|
position $
|
||||||
zip (mkPoint <$> xs)
|
zip (mkPoint <$> xs)
|
||||||
@ -126,7 +126,8 @@ xAxis =
|
|||||||
xs :: [Int]
|
xs :: [Int]
|
||||||
xs = take (floor . (/) (w' p) $ sqS p)
|
xs = take (floor . (/) (w' p) $ sqS p)
|
||||||
(iterate (+(floor . sqS $ p)) (floor . xmin $ p))
|
(iterate (+(floor . sqS $ p)) (floor . xmin $ p))
|
||||||
mkPoint x = p2 (fromIntegral x, -15)
|
mkPoint x = p2 (fromIntegral x,
|
||||||
|
-15 + (if ymin p <= 0 then 0 else ymin p))
|
||||||
|
|
||||||
|
|
||||||
-- |Creates a Diagram that shows an YAxis which is bound
|
-- |Creates a Diagram that shows an YAxis which is bound
|
||||||
@ -138,14 +139,14 @@ yAxis =
|
|||||||
Diag labels
|
Diag labels
|
||||||
where
|
where
|
||||||
vRule p _ =
|
vRule p _ =
|
||||||
arrowAt (p2 (0, ymin p))
|
arrowAt (p2 (if xmin p <= 0 then 0 else xmin p, ymin p))
|
||||||
(r2 (0, h' p))
|
(r2 (0, h' p))
|
||||||
segments p _ =
|
segments p _ =
|
||||||
vcat' (with & sep .~ sqS p)
|
vcat' (with & sep .~ sqS p)
|
||||||
(replicate (floor . (/) (h' p) $ sqS p)
|
(replicate (floor . (/) (h' p) $ sqS p)
|
||||||
(hrule 10)) #
|
(hrule 10)) #
|
||||||
alignB #
|
alignB #
|
||||||
moveTo (p2 (0, ymin p))
|
moveTo (p2 (if xmin p <= 0 then 0 else xmin p, ymin p))
|
||||||
labels p _ =
|
labels p _ =
|
||||||
position $
|
position $
|
||||||
zip (mkPoint <$> ys)
|
zip (mkPoint <$> ys)
|
||||||
@ -154,7 +155,8 @@ yAxis =
|
|||||||
ys :: [Int]
|
ys :: [Int]
|
||||||
ys = take (floor . (/) (h' p) $ sqS p)
|
ys = take (floor . (/) (h' p) $ sqS p)
|
||||||
(iterate (+(floor . sqS $ p)) (floor . ymin $ p))
|
(iterate (+(floor . sqS $ p)) (floor . ymin $ p))
|
||||||
mkPoint y = p2 (-15, fromIntegral y)
|
mkPoint y = p2 (-15 + (if xmin p <= 0 then 0 else xmin p),
|
||||||
|
fromIntegral y)
|
||||||
|
|
||||||
|
|
||||||
-- |Creates a Diagram that shows a white rectangle which is a little
|
-- |Creates a Diagram that shows a white rectangle which is a little
|
||||||
@ -168,7 +170,6 @@ whiteRectB = Diag rect'
|
|||||||
where
|
where
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- |Create a white rectangle with the given width and height.
|
-- |Create a white rectangle with the given width and height.
|
||||||
whiteRect :: Double -> Double -> Diagram Cairo R2
|
whiteRect :: Double -> Double -> Diagram Cairo R2
|
||||||
whiteRect x y = rect x y # lwG 0.00 # bg white
|
whiteRect x y = rect x y # lwG 0.00 # bg white
|
||||||
|
Loading…
Reference in New Issue
Block a user