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

DIAGRAM: make the grid size modifiable

Browse Source
This commit is contained in:
hasufell 2014-10-10 00:30:56 +02:00
parent 8338ab109f
commit dfb25a7a1d
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Diagram.hs
View File

@ -46,7 +46,9 @@ data DiagProp = MkProp {
-- |Algorithm to use. -- |Algorithm to use.
alg :: Int, alg :: Int,
-- |If we want to show the grid. -- |If we want to show the grid.
gd :: Bool gd :: Bool,
-- |Square size used to show the grid and x/y-axis.
sqS :: Double
} }
@ -64,7 +66,7 @@ instance Monoid Diag where
-- |The default properties of the Diagram. -- |The default properties of the Diagram.
defaultProp :: DiagProp defaultProp :: DiagProp
defaultProp = MkProp 2 (0,500) (0,500) 0 False defaultProp = MkProp 2 (0,500) (0,500) 0 False 50
-- |Extract the lower bound of the x-axis dimension. -- |Extract the lower bound of the x-axis dimension.
@ -158,8 +160,9 @@ xAxis =
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, 0)) # moveTo (p2 (xlD p,0))
segments p _ = segments p _ =
hcat' (with & sep .~ 50) hcat' (with & sep .~ (sqS p))
(take (floor . (/) (xuD p - xlD p) $ 50) . repeat $ (vrule 10)) # (take (floor . (/) (xuD p - xlD p) $ (sqS p)) .
repeat $ (vrule 10)) #
moveTo (p2 (xlD p,0)) moveTo (p2 (xlD p,0))
labels p _ = labels p _ =
position $ position $
@ -168,7 +171,8 @@ xAxis =
text . show $ x) # scale 10) <$> xs) text . show $ x) # scale 10) <$> xs)
where where
xs :: [Int] xs :: [Int]
xs = take (floor . (/) (xuD p - xlD p) $ 50) (iterate (+50) 0) xs = take (floor . (/) (xuD p - xlD p) $ (sqS p))
(iterate (+(floor . sqS $ p)) 0)
mkPoint x = p2 (fromIntegral x, -15) mkPoint x = p2 (fromIntegral x, -15)
@ -183,8 +187,8 @@ yAxis =
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)) # moveTo (p2 (0, ylD p))
segments p _ = segments p _ =
vcat' (with & sep .~ 50) vcat' (with & sep .~ (sqS p))
(take (floor . (/) (yuD p - ylD p) $ 50) . (take (floor . (/) (yuD p - ylD p) $ (sqS p)) .
repeat $ (hrule 10)) # repeat $ (hrule 10)) #
alignB # alignB #
moveTo (p2 (0, (ylD p))) moveTo (p2 (0, (ylD p)))
@ -195,7 +199,8 @@ yAxis =
text . show $ x) # scale 10) <$> ys) text . show $ x) # scale 10) <$> ys)
where where
ys :: [Int] ys :: [Int]
ys = take (floor . (/) (yuD p - ylD p) $ 50) (iterate (+50) 0) ys = take (floor . (/) (yuD p - ylD p) $ (sqS p))
(iterate (+(floor . sqS $ p)) 0)
mkPoint y = p2 (-15, fromIntegral y) mkPoint y = p2 (-15, fromIntegral y)
@ -272,14 +277,14 @@ grid :: Diag
grid = Diag f `mappend` Diag g grid = Diag f `mappend` Diag g
where where
f p _ = f p _ =
hcat' (with & sep .~ 50) hcat' (with & sep .~ (sqS p))
(take (floor . (/) (xuD p - xlD p) $ 50) . (take (floor . (/) (xuD p - xlD p) $ (sqS p)) .
repeat $ (vrule $ xuD p - xlD p)) # repeat $ (vrule $ xuD p - xlD p)) #
moveTo (p2 (xlD p, (yuD p - ylD p) / 2)) # moveTo (p2 (xlD p, (yuD p - ylD p) / 2)) #
lw ultraThin lw ultraThin
g p _ = g p _ =
vcat' (with & sep .~ 50) vcat' (with & sep .~ (sqS p))
(take (floor . (/) (yuD p - ylD p) $ 50) . (take (floor . (/) (yuD p - ylD p) $ (sqS p)) .
repeat $ (hrule $ yuD p - ylD p)) # repeat $ (hrule $ yuD p - ylD p)) #
alignB # alignB #
moveTo (p2 ((xuD p - xlD p) / 2, ylD p)) # moveTo (p2 ((xuD p - xlD p) / 2, ylD p)) #