DIAGRAM: rename functions to reflect their type

This commit is contained in:
hasufell 2014-10-09 17:19:58 +02:00
parent 5020778f60
commit fa3e498c45
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020

View File

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