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

DIAG: improve readability

Browse Source
This commit is contained in:
hasufell 2014-12-03 01:36:12 +01:00
parent 5123abfd99
commit 4a0c9ff58d
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 27 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
Graphics/Diagram/Plotter.hs
View File

@ -25,7 +25,7 @@ drawP [] _ = mempty
drawP vt ds =
position (zip vt (repeat dot))
where
dot = (circle ds :: Diagram Cairo R2)
dot = circle ds :: Diagram Cairo R2
-- |Create a rectangle around a diagonal line, which has sw
@ -68,9 +68,7 @@ coordPointsText = Diag cpt
cpt p (Objects vts) = drawT (concat vts) p
drawT [] _ = mempty
drawT vt p
| showCoordText p =
position
$ zip vt (pointToTextCoord <$> vt)
| showCoordText p = position $ zip vt (pointToTextCoord <$> vt)
# translate (r2 (0, 10))
| otherwise = mempty
@ -83,10 +81,7 @@ polyLines = Diag pp
pp _ (Objects (x:y:_)) =
strokePoly x <> strokePoly y
where
strokePoly x' =
(strokeTrail
. fromVertices
$ x' ++ [head x'])
strokePoly x' = (strokeTrail . fromVertices $ x' ++ [head x'])
# moveTo (head x') # lc black
pp _ _ = mempty
@ -97,10 +92,7 @@ polyIntersection = Diag pi'
where
pi' p (Objects (x:y:_)) = drawP vtpi (dotSize p) # fc red # lc red
where
vtpi = intersectionPoints
. sortLexPolys
$ (sortLexPoly x,
sortLexPoly y)
vtpi = intersectionPoints . sortLexPolys $ (sortLexPoly x, sortLexPoly y)
pi' _ _ = mempty
@ -109,10 +101,7 @@ polyIntersectionText :: Diag
polyIntersectionText = Diag pit'
where
pit' p (Objects (x:y:_))
| showCoordText p =
position
. zip vtpi
$ (pointToTextCoord # fc red <$> vtpi)
| showCoordText p = position . zip vtpi $ (pointToTextCoord # fc red <$> vtpi)
# translate (r2 (0, 10))
| otherwise = mempty
where
@ -137,9 +126,7 @@ convexHPText = Diag chpt
where
chpt p (Object vt)
| showCoordText p =
position $
zip vtchf
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
position $ zip vtchf (pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
| otherwise = mempty
where
vtchf = grahamCH vt
@ -153,11 +140,7 @@ convexHLs = Diag chl
where
chl _ (Object []) = mempty
chl _ (Object vt) =
(strokeTrail
. fromVertices
. flip (++) [head $ grahamCH vt]
. grahamCH
$ vt)
(strokeTrail . fromVertices . flip (++) [head $ grahamCH vt] . grahamCH $ vt)
# moveTo (head $ grahamCH vt) # lc red
chl _ _ = mempty
@ -168,11 +151,9 @@ convexHLs = Diag chl
convexHStepsLs :: Diag
convexHStepsLs = GifDiag chs
where
chs _ col f vt =
fmap mkChDiag (f vt)
chs _ col f vt = fmap mkChDiag (f vt)
where
mkChDiag vt' =
(strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col
mkChDiag vt' = (strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col
-- |Create a diagram that shows all squares of the RangeSearch algorithm
@ -338,11 +319,9 @@ xAxis =
<> Diag segments
<> Diag labels
where
hRule p _ =
arrowAt (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
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)
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))
@ -410,15 +389,13 @@ grid :: Diag
grid = Diag xGrid <> Diag yGrid
where
yGrid p _
| haveGrid p =
hcat' (with & sep .~ squareSize 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)
| 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