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:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user