DIAGRAM: improve style and readability

This commit is contained in:
hasufell 2014-10-11 03:59:21 +02:00
parent bfa3665985
commit 7fb3588300
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 66 additions and 42 deletions

View File

@ -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

View File

@ -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,