cga/Graphics/Diagram/Core.hs

172 lines
4.6 KiB
Haskell
Raw Normal View History

2014-10-10 15:40:08 +00:00
{-# OPTIONS_HADDOCK ignore-exports #-}
module Graphics.Diagram.Core where
2014-10-10 15:40:08 +00:00
import Algebra.Vector
2014-10-10 15:40:08 +00:00
import Diagrams.Backend.Cairo
import Diagrams.Prelude
import MyPrelude
-- |Represents a Cairo Diagram. This allows us to create multiple
-- diagrams with different algorithms but based on the same
-- coordinates and common properties.
data Diag =
Diag
{
mkDiag :: DiagProp
-> [[PT]]
-> Diagram Cairo R2
}
| GifDiag
{
mkGifDiag :: DiagProp
-> Colour Double
-> ([PT] -> [[PT]])
-> [PT]
-> [Diagram Cairo R2]
}
| EmptyDiag (Diagram Cairo R2)
2014-10-10 15:40:08 +00:00
-- |Holds the properties for a Diagram, like thickness of 2d points etc.
-- This can also be seen as a context when merging multiple diagrams.
data DiagProp = MkProp {
-- |The thickness of the dots.
dotSize :: Double,
2014-10-10 15:40:08 +00:00
-- |The dimensions of the x-axis.
xDimension :: Coord,
2014-10-10 15:40:08 +00:00
-- |The dimensions of the y-axis.
yDimension :: Coord,
2014-10-10 15:40:08 +00:00
-- |Algorithm to use.
algo :: Int,
2014-10-10 15:40:08 +00:00
-- |If we want to show the grid.
haveGrid :: Bool,
2014-10-10 15:40:08 +00:00
-- |If we want to show the coordinates as text.
showCoordText :: Bool,
2014-10-10 15:40:08 +00:00
-- |Square size used to show the grid and x/y-axis.
squareSize :: Double,
-- |The path to a quad in the quad tree.
quadPath :: String,
-- |The square for the kd-tree range search.
rangeSquare :: Square
2014-10-10 15:40:08 +00:00
}
instance Def DiagProp where
def = diagDefaultProp
2014-10-10 15:40:08 +00:00
instance Monoid Diag where
mempty = EmptyDiag mempty
mappend d1@(Diag {}) d2@(Diag {}) = Diag g
where
g p obj = mkDiag d1 p obj <> mkDiag d2 p obj
mappend d1@(GifDiag {}) d2@(Diag {}) = GifDiag g
where
g p col f vt = mkGifDiag d1 p col f vt ++ [mkDiag d2 p [vt]]
mappend d1@(Diag {}) d2@(GifDiag {}) = GifDiag g
where
g p col f vt = mkDiag d2 p [vt] : mkGifDiag d1 p col f vt
mappend d1@(GifDiag {}) d2@(GifDiag {}) = GifDiag g
2014-10-10 15:40:08 +00:00
where
g p col f vt = mkGifDiag d1 p col f vt ++ mkGifDiag d2 p col f vt
mappend (EmptyDiag _) g = g
mappend g (EmptyDiag _) = g
2014-10-10 15:40:08 +00:00
mconcat = foldr mappend mempty
-- |The default properties of the Diagram.
diagDefaultProp :: DiagProp
diagDefaultProp = MkProp 2 (0,500) (0,500)
0 False False 50 "" ((0,500),(0,500))
2014-10-10 15:40:08 +00:00
-- |Extract the lower bound of the x-axis dimension.
diagXmin :: DiagProp -> Double
diagXmin = fst . xDimension
2014-10-10 15:40:08 +00:00
-- |Extract the upper bound of the x-axis dimension.
diagXmax :: DiagProp -> Double
diagXmax = snd . xDimension
2014-10-10 15:40:08 +00:00
-- |Extract the lower bound of the y-axis dimension.
diagYmin :: DiagProp -> Double
diagYmin = fst . yDimension
2014-10-10 15:40:08 +00:00
-- |Extract the upper bound of the y-axis dimension.
diagYmax :: DiagProp -> Double
diagYmax = snd . yDimension
2014-10-11 01:59:21 +00:00
-- |The full width of the x dimension.
diagWidth :: DiagProp -> Double
diagWidth p = diagXmax p - diagXmin p
2014-10-11 01:59:21 +00:00
-- |The full height of the y dimension.
diagHeight :: DiagProp -> Double
diagHeight p = diagYmax p - diagYmin p
2014-10-11 01:59:21 +00:00
-- |The offset on the x-axis to move the grid and the white rectangle
-- to the right place.
diagWidthOffset :: DiagProp -> Double
diagWidthOffset p = diagXmin p + (diagWidth p / 2)
2014-10-11 01:59:21 +00:00
-- |The offset on the y-axis to move the grid and the white rectangle
-- to the right place.
diagHeightOffset :: DiagProp -> Double
2014-12-07 19:00:54 +00:00
diagHeightOffset p = diagYmin p + (diagHeight p / 2)
2014-10-10 15:40:08 +00:00
-- |Returns the specified diagram if True is passed,
-- otherwise returns the empty diagram. This is just for convenience
-- to avoid if else constructs.
maybeDiag :: Bool -> Diag -> Diag
maybeDiag b d
| b = d
| otherwise = mempty
filterValidPT :: DiagProp -> [PT] -> [PT]
filterValidPT p = filter (inRange (xDimension p, yDimension p))
-- |Draw a list of points.
drawP :: [PT] -- ^ the points to draw
-> Double -- ^ dot size
-> Diagram Cairo R2 -- ^ the resulting diagram
drawP [] _ = mempty
drawP vt ds =
position (zip vt (repeat dot))
where
dot = circle ds :: Diagram Cairo R2
-- |Create a rectangle around a diagonal line, which has sw
-- as startpoint and nw as endpoint.
rectByDiagonal :: (Double, Double) -- ^ sw point
-> (Double, Double) -- ^ nw point
-> Diagram Cairo R2
rectByDiagonal (xmin, xmax) (ymin, ymax) =
rect (xmax - xmin) (ymax - ymin)
# moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2))
-- |Creates a Diagram from a point that shows the coordinates
-- in text format, such as "(1.0, 2.0)".
pointToTextCoord :: PT -> Diagram Cairo R2
pointToTextCoord pt =
text ("(" ++ (show . trim') x ++ ", " ++ (show . trim') y ++ ")") # scale 10
where
trim' :: Double -> Double
trim' x' = fromInteger . round $ x' * (10^(2 :: Int)) /
(10.0^^(2 :: Int))
(x, y) = unp2 pt