From 7fe3aa8458491c1dc30b4d10aae59b74187b55b0 Mon Sep 17 00:00:00 2001 From: hasufell Date: Thu, 21 May 2015 01:39:34 +0200 Subject: [PATCH] Port to diagrams >1.3 --- Algebra/Vector.hs | 8 +++---- CG2.cabal | 18 +++++++------- GUI/Gtk.hs | 8 +++---- Graphics/Diagram/AlgoDiags.hs | 2 +- Graphics/Diagram/Core.hs | 14 +++++------ Graphics/Diagram/Gif.hs | 4 ++-- Graphics/Diagram/Gtk.hs | 6 ++--- Test/Vector.hs | 44 +++++++++++++++++------------------ 8 files changed, 52 insertions(+), 52 deletions(-) diff --git a/Algebra/Vector.hs b/Algebra/Vector.hs index 4bbbf44..6164742 100644 --- a/Algebra/Vector.hs +++ b/Algebra/Vector.hs @@ -13,8 +13,8 @@ import GHC.Float import MyPrelude -type Vec = R2 -type PT = P2 +type Vec = V2 Double +type PT = P2 Double type Coord = (Double, Double) type Segment = (PT, PT) type Square = (Coord, Coord) @@ -64,12 +64,12 @@ vecLength v = sqrt (x^(2 :: Int) + y^(2 :: Int)) -- |Compute the scalar product of two vectors. scalarProd :: Vec -> Vec -> Double -scalarProd (R2 a1 a2) (R2 b1 b2) = a1 * b1 + a2 * b2 +scalarProd (V2 a1 a2) (V2 b1 b2) = a1 * b1 + a2 * b2 -- |Multiply a scalar with a vector. scalarMul :: Double -> Vec -> Vec -scalarMul d (R2 a b) = R2 (a * d) (b * d) +scalarMul d (V2 a b) = V2 (a * d) (b * d) -- |Construct a vector that points to a point from the origin. diff --git a/CG2.cabal b/CG2.cabal index 6048ce8..eb45a17 100644 --- a/CG2.cabal +++ b/CG2.cabal @@ -81,9 +81,9 @@ executable Gtk bytestring >= 0.10.4.0, containers >= 0.5.0.0, dequeue >= 0.1.5, - diagrams-lib >=1.2, - diagrams-cairo >=1.2, - diagrams-contrib >= 1.1.2.1, + diagrams-lib >=1.3, + diagrams-cairo >=1.3, + diagrams-contrib >= 1.3.0.0, directory >=1.2, filepath >= 1.3.0.2, glade >=0.12, @@ -131,9 +131,9 @@ executable Gif bytestring >= 0.10.4.0, containers >= 0.5.0.0, dequeue >= 0.1.5, - diagrams-lib >=1.2, - diagrams-cairo >=1.2, - diagrams-contrib >= 1.1.2.1, + diagrams-lib >=1.3, + diagrams-cairo >=1.3, + diagrams-contrib >= 1.3.0.0, gloss >= 1.2.0.1, JuicyPixels >= 3.1.7.1, safe >= 0.3.8, @@ -179,9 +179,9 @@ executable Test base >=4.6, bytestring >= 0.10.4.0, containers >= 0.5.0.0, - diagrams-lib >=1.2, - diagrams-cairo >=1.2, - diagrams-contrib >= 1.1.2.1, + diagrams-lib >=1.3, + diagrams-cairo >=1.3, + diagrams-contrib >= 1.3.0.0, gloss >= 1.2.0.1, QuickCheck >= 2.4.2, safe >= 0.3.8 diff --git a/GUI/Gtk.hs b/GUI/Gtk.hs index 5e53753..5cfb5c4 100644 --- a/GUI/Gtk.hs +++ b/GUI/Gtk.hs @@ -63,9 +63,9 @@ data MyGUI = MkMyGUI { -- |Path entry widget for the quad tree. quadPathEntry :: Entry, -- |Horizontal box containing the path entry widget. - vbox7 :: Box, + vbox7 :: Graphics.UI.Gtk.Box, -- |Horizontal box containing the Rang search entry widgets. - vbox10 :: Box, + vbox10 :: Graphics.UI.Gtk.Box, -- |Range entry widget for lower x bound rangeXminEntry :: Entry, -- |Range entry widget for upper x bound @@ -299,9 +299,9 @@ saveAndDrawDiag fp fps mygui = renderDiag winWidth winHeight buildDiag = renderDia Cairo (CairoOptions fps - (Dims (fromIntegral winWidth) (fromIntegral winHeight)) + (mkSizeSpec2D (Just $ fromIntegral winWidth) (Just $ fromIntegral winHeight)) SVG False) - (buildDiag (def{ + (buildDiag (MyPrelude.def{ dotSize = scaleVal, xDimension = fromMaybe (0, 500) xDim, yDimension = fromMaybe (0, 500) yDim, diff --git a/Graphics/Diagram/AlgoDiags.hs b/Graphics/Diagram/AlgoDiags.hs index 6e12c73..be21b44 100644 --- a/Graphics/Diagram/AlgoDiags.hs +++ b/Graphics/Diagram/AlgoDiags.hs @@ -233,7 +233,7 @@ treePretty = Diag f 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 diff --git a/Graphics/Diagram/Core.hs b/Graphics/Diagram/Core.hs index c31bfb4..26dadf5 100644 --- a/Graphics/Diagram/Core.hs +++ b/Graphics/Diagram/Core.hs @@ -16,7 +16,7 @@ data Diag = { mkDiag :: DiagProp -> [[PT]] - -> Diagram Cairo R2 + -> Diagram Cairo } | GifDiag { @@ -24,9 +24,9 @@ data Diag = -> Colour Double -> ([PT] -> [[PT]]) -> [PT] - -> [Diagram Cairo R2] + -> [Diagram Cairo] } - | EmptyDiag (Diagram Cairo R2) + | EmptyDiag (Diagram Cairo) -- |Holds the properties for a Diagram, like thickness of 2d points etc. @@ -148,19 +148,19 @@ diagDimSquare p = dimToSquare (xDimension p) $ yDimension p -- |Draw a list of points. drawP :: [PT] -- ^ 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 :: PT -> Diagram Cairo R2 +pointToTextCoord :: PT -> Diagram Cairo pointToTextCoord pt = text ("(" ++ (show . trim') x ++ ", " ++ (show . trim') y ++ ")") # scale 10 where diff --git a/Graphics/Diagram/Gif.hs b/Graphics/Diagram/Gif.hs index b34a45b..034bcd2 100644 --- a/Graphics/Diagram/Gif.hs +++ b/Graphics/Diagram/Gif.hs @@ -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 -> [PT] -> [(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 . meshVertices diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs index 462d7b2..3b92cfe 100644 --- a/Graphics/Diagram/Gtk.hs +++ b/Graphics/Diagram/Gtk.hs @@ -46,7 +46,7 @@ diagTreAlgos = -- |Create the Diagram from the points. -diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo R2 +diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo diag p das vts = maybe mempty (\x -> mkDiag x p vts) $ mconcat -- get the actual [Diag] array @@ -58,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) @@ -69,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) diff --git a/Test/Vector.hs b/Test/Vector.hs index 52c1423..31e99cc 100644 --- a/Test/Vector.hs +++ b/Test/Vector.hs @@ -21,19 +21,19 @@ newtype PosRoundDouble = PosRoundDouble { getPRD :: Double } deriving (Eq, Ord, Show, Read) -newtype RoundR2 = RoundR2 { getRR2 :: R2 } +newtype RoundR2 = RoundR2 { getRR2 :: V2 Double } deriving (Eq, Ord, Show, Read) -newtype PosRoundR2 = PosRoundR2 { getPRR2 :: R2 } +newtype PosRoundR2 = PosRoundR2 { getPRR2 :: V2 Double } deriving (Eq, Ord, Show, Read) -newtype RoundP2 = RoundP2 { getRP2 :: P2 } +newtype RoundP2 = RoundP2 { getRP2 :: P2 Double } deriving (Eq, Ord, Show, Read) -newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 } +newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 Double } deriving (Eq, Ord, Show, Read) @@ -72,11 +72,11 @@ instance Arbitrary PosRoundP2 where <*> (arbitrary :: Gen PosRoundDouble) -instance Arbitrary R2 where +instance Arbitrary (V2 Double) where arbitrary = curry r2 <$> arbitrary <*> arbitrary -instance Arbitrary P2 where +instance Arbitrary (P2 Double) where arbitrary = curry p2 <$> arbitrary <*> arbitrary @@ -131,42 +131,42 @@ onPTProp1 pt = onPT id pt == pt -- add a random value to the point coordinates -onPTProp2 :: PT -> Positive R2 -> Bool -onPTProp2 pt (Positive (R2 rx ry)) +onPTProp2 :: PT -> Positive (V2 Double) -> Bool +onPTProp2 pt (Positive (V2 rx ry)) = onPT (\(x, y) -> (x + rx, y + ry)) pt /= pt -- angle between two vectors both on the x-axis must be 0 getAngleProp1 :: Positive Vec -> Positive Vec -> Bool -getAngleProp1 (Positive (R2 x1 _)) (Positive (R2 x2 _)) - = getAngle (R2 x1 0) (R2 x2 0) == 0 +getAngleProp1 (Positive (V2 x1 _)) (Positive (V2 x2 _)) + = getAngle (V2 x1 0) (V2 x2 0) == 0 -- angle between two vectors both on the y-axis must be 0 getAngleProp2 :: Positive Vec -> Positive Vec -> Bool -getAngleProp2 (Positive (R2 _ y1)) (Positive (R2 _ y2)) - = getAngle (R2 0 y1) (R2 0 y2) == 0 +getAngleProp2 (Positive (V2 _ y1)) (Positive (V2 _ y2)) + = getAngle (V2 0 y1) (V2 0 y2) == 0 -- angle between two vectors both on the x-axis but with opposite direction -- must be pi getAngleProp3 :: Positive Vec -> Positive Vec -> Bool -getAngleProp3 (Positive (R2 x1 _)) (Positive (R2 x2 _)) - = getAngle (R2 (negate x1) 0) (R2 x2 0) == pi +getAngleProp3 (Positive (V2 x1 _)) (Positive (V2 x2 _)) + = getAngle (V2 (negate x1) 0) (V2 x2 0) == pi -- angle between two vectors both on the y-axis but with opposite direction -- must be pi getAngleProp4 :: Positive Vec -> Positive Vec -> Bool -getAngleProp4 (Positive (R2 _ y1)) (Positive (R2 _ y2)) - = getAngle (R2 0 (negate y1)) (R2 0 y2) == pi +getAngleProp4 (Positive (V2 _ y1)) (Positive (V2 _ y2)) + = getAngle (V2 0 (negate y1)) (V2 0 y2) == pi -- angle between vector in x-axis direction and y-axis direction must be -- p/2 getAngleProp5 :: Positive Vec -> Positive Vec -> Bool -getAngleProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2)) - = getAngle (R2 x1 0) (R2 0 y2) == pi / 2 +getAngleProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2)) + = getAngle (V2 x1 0) (V2 0 y2) == pi / 2 -- commutative @@ -213,8 +213,8 @@ scalarProdProp4 (RoundDouble s1) (RoundDouble s2) (RoundR2 v1) (RoundR2 v2) -- orthogonal scalarProdProp5 :: Positive Vec -> Positive Vec -> Bool -scalarProdProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2)) - = scalarProd (R2 x1 0) (R2 0 y2) == 0 +scalarProdProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2)) + = scalarProd (V2 x1 0) (V2 0 y2) == 0 -- this is almost the same as the function definition @@ -262,10 +262,10 @@ vp2Prop1 p1' p2' vp2Prop2 :: PT -> PT -> Bool vp2Prop2 p1' p2' | p1' == origin && p2' == origin = True - | otherwise = vp2 p1' p2' == (\(R2 x y) -> negate x ^& negate y) + | otherwise = vp2 p1' p2' == (\(V2 x y) -> negate x ^& negate y) (vp2 p2' p1') && - vp2 p2' p1' == (\(R2 x y) -> negate x ^& negate y) + vp2 p2' p1' == (\(V2 x y) -> negate x ^& negate y) (vp2 p1' p2')