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

DIAGRAM: use (<>) instead of mappend

Browse Source
This commit is contained in:
hasufell 2014-10-14 21:24:21 +02:00
parent 0379463db4
commit 42dc0c4a1b
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Graphics/Diagram/Gif.hs
View File

@ -4,8 +4,9 @@ module Graphics.Diagram.Gif where
import Algebra.VectorTypes import Algebra.VectorTypes
import Codec.Picture.Gif import Codec.Picture.Gif
import Data.Monoid
import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo
import Diagrams.Prelude import Diagrams.Prelude hiding ((<>))
import Graphics.Diagram.Plotter import Graphics.Diagram.Plotter
import Graphics.Diagram.Types import Graphics.Diagram.Types
import Parser.Meshparser import Parser.Meshparser
@ -16,7 +17,7 @@ gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
gifDiag p xs = gifDiag p xs =
fmap ((\x -> (x, 100)) . (<> nonChDiag)) . fmap ((\x -> (x, 100)) . (<> nonChDiag)) .
flip (++) flip (++)
[mkDiag (convexHPText `mappend` [mkDiag (convexHPText <>
convexHP) convexHP)
p xs <> lastUpperHull <> lastLowerHull] $ p xs <> lastUpperHull <> lastLowerHull] $
(lowerHullList ++ ((<> lastLowerHull) <$> upperHullList)) (lowerHullList ++ ((<> lastLowerHull) <$> upperHullList))

13
Graphics/Diagram/Plotter.hs
View File

@ -5,8 +5,9 @@ module Graphics.Diagram.Plotter where
import Algebra.Vector import Algebra.Vector
import Algebra.VectorTypes import Algebra.VectorTypes
import Algorithms.ConvexHull.GrahamScan import Algorithms.ConvexHull.GrahamScan
import Data.Monoid
import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo
import Diagrams.Prelude import Diagrams.Prelude hiding ((<>))
import Graphics.Diagram.Types import Graphics.Diagram.Types
@ -121,8 +122,8 @@ convexUHStepsLs = convexHStepsLs purple grahamUHSteps
-- by the dimensions given in xD from DiagProp. -- by the dimensions given in xD from DiagProp.
xAxis :: Diag xAxis :: Diag
xAxis = xAxis =
Diag hRule `mappend` Diag hRule <>
Diag segments `mappend` Diag segments <>
Diag labels Diag labels
where where
hRule p _ = hRule p _ =
@ -149,8 +150,8 @@ xAxis =
-- by the dimensions given in yD from DiagProp. -- by the dimensions given in yD from DiagProp.
yAxis :: Diag yAxis :: Diag
yAxis = yAxis =
Diag vRule `mappend` Diag vRule <>
Diag segments `mappend` Diag segments <>
Diag labels Diag labels
where where
vRule p _ = vRule p _ =
@ -193,7 +194,7 @@ whiteRect x y = rect x y # lwG 0.00 # bg white
-- |Create a grid across the whole diagram with squares of the -- |Create a grid across the whole diagram with squares of the
-- given size in DiagProp. -- given size in DiagProp.
grid :: Diag grid :: Diag
grid = Diag xGrid `mappend` Diag yGrid grid = Diag xGrid <> Diag yGrid
where where
yGrid p _ = yGrid p _ =
hcat' (with & sep .~ sqS p) hcat' (with & sep .~ sqS p)