DIAGRAM: rename functions to reflect their type
This commit is contained in:
parent
5020778f60
commit
fa3e498c45
48
Diagram.hs
48
Diagram.hs
@ -83,8 +83,8 @@ yuD = snd . dY
|
|||||||
-- |Creates a Diagram that shows the coordinates from the points
|
-- |Creates a Diagram that shows the coordinates from the points
|
||||||
-- as dots. The points and thickness of the dots can be controlled
|
-- as dots. The points and thickness of the dots can be controlled
|
||||||
-- via DiagProp.
|
-- via DiagProp.
|
||||||
showCoordinates :: Diag
|
coordPoints :: Diag
|
||||||
showCoordinates = Diag f
|
coordPoints = Diag f
|
||||||
where
|
where
|
||||||
f p vt
|
f p vt
|
||||||
= position (zip (filter (inRange (dX p) (dY p)) $ vt)
|
= position (zip (filter (inRange (dX p) (dY p)) $ vt)
|
||||||
@ -95,8 +95,8 @@ showCoordinates = Diag f
|
|||||||
|
|
||||||
|
|
||||||
-- |Create a diagram which shows the points of the convex hull.
|
-- |Create a diagram which shows the points of the convex hull.
|
||||||
showConvexHullPoints :: Diag
|
convexHullPoints :: Diag
|
||||||
showConvexHullPoints = Diag f
|
convexHullPoints = Diag f
|
||||||
where
|
where
|
||||||
f p vt
|
f p vt
|
||||||
= position (zip (filter (inRange (dX p) (dY p)) $ vtch)
|
= position (zip (filter (inRange (dX p) (dY p)) $ vtch)
|
||||||
@ -109,8 +109,8 @@ showConvexHullPoints = Diag f
|
|||||||
|
|
||||||
-- |Create a diagram which shows the lines along the convex hull
|
-- |Create a diagram which shows the lines along the convex hull
|
||||||
-- points.
|
-- points.
|
||||||
showConvexHullLines :: Diag
|
convexHullLines :: Diag
|
||||||
showConvexHullLines = Diag f
|
convexHullLines = Diag f
|
||||||
where
|
where
|
||||||
f _ [] = mempty
|
f _ [] = mempty
|
||||||
f _ vt
|
f _ vt
|
||||||
@ -124,8 +124,8 @@ showConvexHullLines = Diag f
|
|||||||
|
|
||||||
-- |Same as showConvexHullLines, except that it returns an array
|
-- |Same as showConvexHullLines, except that it returns an array
|
||||||
-- of diagrams with each step of the algorithm.
|
-- of diagrams with each step of the algorithm.
|
||||||
showConvexHullLinesInterval :: DiagProp -> [PT] -> [Diagram Cairo R2]
|
convexHullLinesInterval :: DiagProp -> [PT] -> [Diagram Cairo R2]
|
||||||
showConvexHullLinesInterval _ xs =
|
convexHullLinesInterval _ xs =
|
||||||
fmap g (grahamGetCHSteps xs)
|
fmap g (grahamGetCHSteps xs)
|
||||||
where
|
where
|
||||||
g vt
|
g vt
|
||||||
@ -137,24 +137,24 @@ showConvexHullLinesInterval _ xs =
|
|||||||
|
|
||||||
-- |Creates a Diagram that shows an XAxis which is bound
|
-- |Creates a Diagram that shows an XAxis which is bound
|
||||||
-- by the dimensions given in xD from DiagProp.
|
-- by the dimensions given in xD from DiagProp.
|
||||||
showXAxis :: Diag
|
xAxis :: Diag
|
||||||
showXAxis = Diag f
|
xAxis = Diag f
|
||||||
where
|
where
|
||||||
f p _ = (strokeTrail . fromVertices $ [p2 (xlD p,0), p2 (xuD p, 0)]) # moveTo (p2 (xlD p,0))
|
f p _ = (strokeTrail . fromVertices $ [p2 (xlD p,0), p2 (xuD p, 0)]) # moveTo (p2 (xlD p,0))
|
||||||
|
|
||||||
|
|
||||||
-- |Creates a Diagram that shows an YAxis which is bound
|
-- |Creates a Diagram that shows an YAxis which is bound
|
||||||
-- by the dimensions given in yD from DiagProp.
|
-- by the dimensions given in yD from DiagProp.
|
||||||
showYAxis :: Diag
|
yAxis :: Diag
|
||||||
showYAxis = Diag f
|
yAxis = Diag f
|
||||||
where
|
where
|
||||||
f p _ = (strokeTrail . fromVertices $ [p2 (0, ylD p), p2 (0, yuD p)]) # moveTo (p2 (0, ylD p))
|
f p _ = (strokeTrail . fromVertices $ [p2 (0, ylD p), p2 (0, yuD p)]) # moveTo (p2 (0, ylD p))
|
||||||
|
|
||||||
|
|
||||||
-- |Creates a Diagram that shows a white rectangle which is a little
|
-- |Creates a Diagram that shows a white rectangle which is a little
|
||||||
-- bit bigger as both X and Y axis dimensions from DiagProp.
|
-- bit bigger as both X and Y axis dimensions from DiagProp.
|
||||||
showWhiteRectB :: Diag
|
whiteRectB :: Diag
|
||||||
showWhiteRectB = Diag f
|
whiteRectB = Diag f
|
||||||
where
|
where
|
||||||
f p _ = whiteRect (w' + 50) (h' + 50) # moveTo (p2 (w' / 2, h' / 2))
|
f p _ = whiteRect (w' + 50) (h' + 50) # moveTo (p2 (w' / 2, h' / 2))
|
||||||
where
|
where
|
||||||
@ -166,12 +166,12 @@ showWhiteRectB = Diag f
|
|||||||
diag :: DiagProp -> [PT] -> Diagram Cairo R2
|
diag :: DiagProp -> [PT] -> Diagram Cairo R2
|
||||||
diag p = case alg p of
|
diag p = case alg p of
|
||||||
0 -> mkDiag
|
0 -> mkDiag
|
||||||
(mconcat [showCoordinates, showXAxis, showYAxis, showWhiteRectB])
|
(mconcat [coordPoints, xAxis, yAxis, whiteRectB])
|
||||||
p
|
p
|
||||||
1 -> mkDiag
|
1 -> mkDiag
|
||||||
(mconcat $
|
(mconcat $
|
||||||
[showConvexHullPoints, showConvexHullLines, showCoordinates,
|
[convexHullPoints, convexHullLines, coordPoints,
|
||||||
showXAxis, showYAxis, showWhiteRectB])
|
xAxis, yAxis, whiteRectB])
|
||||||
p
|
p
|
||||||
_ -> mempty
|
_ -> mempty
|
||||||
|
|
||||||
@ -190,16 +190,16 @@ gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
|
|||||||
gifDiag p xs = fmap (\x -> (x, 100)) .
|
gifDiag p xs = fmap (\x -> (x, 100)) .
|
||||||
fmap (\x -> x <> g) .
|
fmap (\x -> x <> g) .
|
||||||
flip (++)
|
flip (++)
|
||||||
[mkDiag (showConvexHullLines `mappend`
|
[mkDiag (convexHullLines `mappend`
|
||||||
showConvexHullPoints) p xs] $
|
convexHullPoints) p xs] $
|
||||||
(showConvexHullLinesInterval p xs)
|
(convexHullLinesInterval p xs)
|
||||||
where
|
where
|
||||||
g = mconcat .
|
g = mconcat .
|
||||||
fmap (\x -> mkDiag x p xs) $
|
fmap (\x -> mkDiag x p xs) $
|
||||||
[showCoordinates,
|
[coordPoints,
|
||||||
showXAxis,
|
xAxis,
|
||||||
showYAxis,
|
yAxis,
|
||||||
showWhiteRectB]
|
whiteRectB]
|
||||||
|
|
||||||
|
|
||||||
-- |Same as gifDiag, except that it takes a string containing the
|
-- |Same as gifDiag, except that it takes a string containing the
|
||||||
|
Loading…
Reference in New Issue
Block a user