Port to diagrams >1.3

Algebra/Vector.hs

@@ -13,8 +13,8 @@ import GHC.Float
 import MyPrelude
 
 
-type Vec     = R2
+type Vec     = V2 Double
-type PT      = P2
+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.

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-lib >=1.3,
-                       diagrams-cairo >=1.2,
+                       diagrams-cairo >=1.3,
-                       diagrams-contrib >= 1.1.2.1,
+                       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-lib >=1.3,
-                       diagrams-cairo >=1.2,
+                       diagrams-cairo >=1.3,
-                       diagrams-contrib >= 1.1.2.1,
+                       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-lib >=1.3,
-                       diagrams-cairo >=1.2,
+                       diagrams-cairo >=1.3,
-                       diagrams-contrib >= 1.1.2.1,
+                       diagrams-contrib >= 1.3.0.0,
                        gloss >= 1.2.0.1,
                        QuickCheck >= 2.4.2,
                        safe >= 0.3.8

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,

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

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

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

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)

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 (V2 Double) -> Bool
-onPTProp2 pt (Positive (R2 rx ry))
+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 _))
+getAngleProp1 (Positive (V2 x1 _)) (Positive (V2 x2 _))
-  = getAngle (R2 x1 0) (R2 x2 0) == 0
+  = 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))
+getAngleProp2 (Positive (V2 _ y1)) (Positive (V2 _ y2))
-  = getAngle (R2 0 y1) (R2 0 y2) == 0
+  = 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 _))
+getAngleProp3 (Positive (V2 x1 _)) (Positive (V2 x2 _))
-  = getAngle (R2 (negate x1) 0) (R2 x2 0) == pi
+  = 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))
+getAngleProp4 (Positive (V2 _ y1)) (Positive (V2 _ y2))
-  = getAngle (R2 0 (negate y1)) (R2 0 y2) == pi
+  = 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))
+getAngleProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2))
-  = getAngle (R2 x1 0) (R2 0 y2) == pi / 2
+  = 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))
+scalarProdProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2))
-  = scalarProd (R2 x1 0) (R2 0 y2) == 0
+  = 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')