Port to diagrams >1.3

# Conflicts:
#	Algebra/Vector.hs
#	CG2.cabal
#	Graphics/Diagram/Core.hs
#	Graphics/Diagram/Gif.hs
#	Graphics/Diagram/Gtk.hs
#	Test/Vector.hs
This commit is contained in:
2015-05-21 02:14:15 +02:00
parent 5120a44d0f
commit 984ed40c63
15 changed files with 204 additions and 209 deletions

View File

@@ -123,9 +123,9 @@ kdSquares = Diag f
where
-- Gets all lines that make up the kdSquares. Every line is
-- described by two points, start and end respectively.
kdLines :: KDTree P2
kdLines :: KDTree (P2 Double)
-> ((Double, Double), (Double, Double)) -- ^ square
-> [(P2, P2)]
-> [(P2 Double, P2 Double)]
kdLines (KTNode ln pt Horizontal rn) ((xmin, ymin), (xmax, ymax)) =
(\(x, _) -> [(p2 (x, ymin), p2 (x, ymax))])
(unp2 pt)
@@ -180,7 +180,7 @@ kdTreeDiag = Diag f
-- |Get the quad tree corresponding to the given points and diagram properties.
qt :: [P2] -> DiagProp -> QuadTree P2
qt :: [P2 Double] -> DiagProp -> QuadTree (P2 Double)
qt vt p = quadTree vt (diagDimSquare p)
@@ -194,7 +194,7 @@ quadPathSquare = Diag f
(getSquare (stringToQuads (quadPath p)) (qt (mconcat vts) p, []))
where
getSquare :: [Either Quad Orient]
-> QTZipper P2
-> QTZipper (P2 Double)
-> ((Double, Double), (Double, Double))
getSquare [] z = getSquareByZipper (diagDimSquare p) z
getSquare (q:qs) z = case q of
@@ -212,7 +212,7 @@ gifQuadPath = GifDiag f
<$> getSquares (stringToQuads (quadPath p)) (qt vt p, [])
where
getSquares :: [Either Quad Orient]
-> QTZipper P2
-> QTZipper (P2 Double)
-> [((Double, Double), (Double, Double))]
getSquares [] z = [getSquareByZipper (diagDimSquare p) z]
getSquares (q:qs) z = case q of
@@ -233,12 +233,12 @@ treePretty = Diag f
. quadPath
$ p)
where
getCurQT :: [Either Quad Orient] -> QTZipper P2 -> QTZipper P2
getCurQT :: [Either Quad Orient] -> QTZipper (P2 Double) -> QTZipper (P2 Double)
getCurQT [] z = z
getCurQT (q:qs) z = case q of
Right x -> getCurQT qs (fromMaybe z (findNeighbor x z))
Left x -> getCurQT qs (fromMaybe z (goQuad x z))
prettyRoseTree :: Tree String -> Diagram Cairo R2
prettyRoseTree :: Tree String -> Diagram Cairo
prettyRoseTree tree =
-- HACK: in order to give specific nodes a specific color
renderTree (\n -> case head n of

View File

@@ -15,18 +15,18 @@ data Diag =
Diag
{
mkDiag :: DiagProp
-> [[P2]]
-> Diagram Cairo R2
-> [[P2 Double]]
-> Diagram Cairo
}
| GifDiag
{
mkGifDiag :: DiagProp
-> Colour Double
-> ([P2] -> [[P2]])
-> [P2]
-> [Diagram Cairo R2]
-> ([P2 Double] -> [[P2 Double]])
-> [P2 Double]
-> [Diagram Cairo]
}
| EmptyDiag (Diagram Cairo R2)
| EmptyDiag (Diagram Cairo)
-- |Holds the properties for a Diagram, like thickness of 2d points etc.
@@ -134,7 +134,7 @@ maybeDiag b d
| otherwise = mempty
filterValidPT :: DiagProp -> [P2] -> [P2]
filterValidPT :: DiagProp -> [P2 Double] -> [P2 Double]
filterValidPT =
filter
. inRange
@@ -146,21 +146,21 @@ diagDimSquare p = dimToSquare (xDimension p) $ yDimension p
-- |Draw a list of points.
drawP :: [P2] -- ^ the points to draw
drawP :: [P2 Double] -- ^ the points to draw
-> Double -- ^ dot size
-> Diagram Cairo R2 -- ^ the resulting diagram
-> Diagram Cairo -- ^ the resulting diagram
drawP [] _ = mempty
drawP vt ds =
position (zip vt (repeat dot))
where
dot = circle ds :: Diagram Cairo R2
dot = circle ds :: Diagram Cairo
-- |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
-> Diagram Cairo
rectByDiagonal (xmin, ymin) (xmax, ymax) =
fromVertices [p2 (xmin, ymin)
, p2 (xmax, ymin)
@@ -172,7 +172,7 @@ rectByDiagonal (xmin, ymin) (xmax, ymax) =
-- |Creates a Diagram from a point that shows the coordinates
-- in text format, such as "(1.0, 2.0)".
pointToTextCoord :: P2 -> Diagram Cairo R2
pointToTextCoord :: P2 Double -> Diagram Cairo
pointToTextCoord pt =
text ("(" ++ (show . trim') x ++ ", " ++ (show . trim') y ++ ")") # scale 10
where

View File

@@ -2,7 +2,7 @@
module Graphics.Diagram.Gif where
import Algebra.Vector(PT)
import Algebra.Vector
import Algorithms.GrahamScan
import Codec.Picture.Gif
import qualified Data.ByteString.Char8 as B
@@ -16,7 +16,7 @@ import Parser.Meshparser
-- |Return a list of tuples used by 'gifMain' to generate an animated gif.
gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
gifDiag :: DiagProp -> [P2 Double] -> [(Diagram Cairo, GifDelay)]
gifDiag p xs =
fmap ((\x -> (x, 50)) . (<> nonChDiag))
(upperHullList
@@ -35,5 +35,5 @@ gifDiag p xs =
-- |Same as gifDiag, except that it takes a string containing the
-- mesh file content instead of the the points.
gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo R2, GifDelay)]
gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo, GifDelay)]
gifDiagS p = gifDiag p . filterValidPT p . meshToArr

View File

@@ -2,6 +2,7 @@
module Graphics.Diagram.Gtk where
import Algebra.Vector
import qualified Data.ByteString.Char8 as B
import Data.List(find)
import Diagrams.Backend.Cairo
@@ -45,7 +46,7 @@ diagTreAlgos =
-- |Create the Diagram from the points.
diag :: DiagProp -> [DiagAlgo] -> [[P2]] -> Diagram Cairo R2
diag :: DiagProp -> [DiagAlgo] -> [[P2 Double]] -> Diagram Cairo
diag p das vts = maybe mempty (\x -> mkDiag x p vts)
$ mconcat
-- get the actual [Diag] array
@@ -57,7 +58,7 @@ diag p das vts = maybe mempty (\x -> mkDiag x p vts)
-- |Create the Diagram from a String which is supposed to be the contents
-- of an obj file.
diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2
diagS :: DiagProp -> B.ByteString -> Diagram Cairo
diagS p mesh =
diag p diagAlgos
. fmap (filterValidPT p)
@@ -68,7 +69,7 @@ diagS p mesh =
-- |Create the tree diagram from a String which is supposed to be the contents
-- of an obj file.
diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo R2
diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo
diagTreeS p mesh =
diag p diagTreAlgos
. fmap (filterValidPT p)