Port to diagrams >1.3

We had to add NoFace/NoEdge/NoVert constructors to our half-edge
data structures, because using "Maybe HeEdge a" as the result value
of 'indirectToDirect' causes an infinite recursion, since the whole
data structure (which is cyclic and infinite) has to be evaluated
in order to know which constructor to use.

Unfortunately this makes the code quite hard to read.

TODO: add pseudo-code

.gitignore

@@ -11,3 +11,10 @@ dist/
 # cabal
 .cabal-sandbox/
 cabal.sandbox.config
+
+# profiling
+*.prof
+
+_darcs/
+
+.liquid/

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.

Algorithms/PolygonIntersection.hs

@@ -136,15 +136,3 @@ intersectionPoints xs' = rmdups . go $ xs'
     combinations :: [a] -> [a] -> [[a]]
     combinations xs ys = concat . fmap (\y -> fmap (\x -> [y, x]) xs) $ ys
 
-
-testArr :: ([PT], [PT])
-testArr = ([p2 (200.0, 500.0),
-            p2 (0.0, 200.0),
-            p2 (200.0, 100.0),
-            p2 (400.0, 300.0)],
-
-           [p2 (350.0, 450.0),
-            p2 (275.0, 225.0),
-            p2 (350.0, 50.0),
-            p2 (500.0, 0.0),
-            p2 (450.0, 400.0)])

CG2.cabal

@@ -65,6 +65,7 @@ executable Gtk
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gtk
                        Graphics.Diagram.Plotter
+                       Graphics.HalfEdge
                        GUI.Gtk
                        MyPrelude
                        Parser.Meshparser
@@ -76,21 +77,20 @@ executable Gtk
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6 && <4.8,
+                       base >=4.6,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
                        dequeue >= 0.1.5,
-                       diagrams-lib >=1.2 && <1.3,
-                       diagrams-cairo >=1.2 && <1.3,
-                       diagrams-contrib >= 1.1.2.1,
-                       directory >=1.2 && <1.3,
+                       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 && <0.13,
+                       glade >=0.12,
                        gloss >= 1.2.0.1,
-                       gtk >=0.12 && <0.13,
-                       multiset-comb >= 0.2.1,
+                       gtk >=0.12,
                        safe >= 0.3.8,
-                       transformers >=0.4 && <0.5
+                       transformers >=0.4
 
   -- Directories containing source files.
   -- hs-source-dirs:
@@ -115,6 +115,7 @@ executable Gif
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gif
                        Graphics.Diagram.Plotter
+                       Graphics.HalfEdge
                        MyPrelude
                        Parser.Meshparser
                        Parser.PathParser
@@ -126,18 +127,17 @@ executable Gif
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6 && <4.8,
+                       base >=4.6,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
                        dequeue >= 0.1.5,
-                       diagrams-lib >=1.2 && <1.3,
-                       diagrams-cairo >=1.2 && <1.3,
-                       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,
-                       multiset-comb >= 0.2.1,
-                       transformers >=0.4 && <0.5,
-                       safe >= 0.3.8
+                       safe >= 0.3.8,
+                       transformers >=0.4
 
   -- Directories containing source files.
   -- hs-source-dirs:
@@ -162,6 +162,7 @@ executable Test
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gif
                        Graphics.Diagram.Plotter
+                       Graphics.HalfEdge
                        MyPrelude
                        Parser.Meshparser
                        Parser.PathParser
@@ -175,18 +176,14 @@ executable Test
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6 && <4.8,
+                       base >=4.6,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
-                       dequeue >= 0.1.5,
-                       diagrams-lib >=1.2 && <1.3,
-                       diagrams-cairo >=1.2 && <1.3,
-                       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,
-                       multiset-comb >= 0.2.1,
                        QuickCheck >= 2.4.2,
-                       transformers >=0.4 && <0.5,
                        safe >= 0.3.8
 
   -- Directories containing source files.

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 p = gifDiag p . filterValidPT p . meshToArr
+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,22 +58,22 @@ 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)
-    . (\x -> if null x then [meshToArr mesh] else x)
-    . facesToArr
+    . (\x -> if null x then [meshVertices mesh] else x)
+    . meshFaceVertices
     $ 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)
-    . (\x -> if null x then [meshToArr mesh] else x)
-    . facesToArr
+    . (\x -> if null x then [meshVertices mesh] else x)
+    . meshFaceVertices
     $ mesh
 

Graphics/HalfEdge.hs

@@ -0,0 +1,241 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+-- |This module provides methods to build a cyclic half-edge data structure
+-- from an already parsed obj mesh file. As such, it depends on details
+-- of the parsed data.
+--
+-- In particular, 'indirectHeFaces', 'indirectHeVerts' and 'indirectToDirect'
+-- assume specific structure of some input lists. Check their respective
+-- documentation.
+--
+-- As the data structure has a lot of cross-references and the knots are
+-- not really known at compile-time, we have to use helper data structures
+-- such as lists and maps under the hood and tie the knots through
+-- index lookups.
+--
+-- For an explanation of the abstract concept of the half-edge data structure,
+-- check <http://www.flipcode.com/archives/The_Half-Edge_Data_Structure.shtml>
+module Graphics.HalfEdge (
+    HeVert(..)
+  , HeFace(..)
+  , HeEdge(..)
+  , buildHeEdge
+  , buildHeEdgeFromStr
+) where
+
+import Algebra.Vector
+import Control.Applicative
+import Control.Monad
+import qualified Data.ByteString.Char8 as B
+import qualified Data.IntMap.Lazy as Map
+import Data.Maybe
+import Parser.Meshparser
+import Safe
+
+
+-- |The vertex data structure for the half-edge.
+data HeVert a = HeVert {
+    vcoord  :: a        -- the coordinates of the vertex
+  , emedge  :: HeEdge a -- one of the half-edges emanating from the vertex
+} | NoVert
+
+
+-- |The face data structure for the half-edge.
+data HeFace a = HeFace {
+  bordedge :: HeEdge a -- one of the half-edges bordering the face
+} | NoFace
+
+-- |The actual half-edge data structure.
+data HeEdge a = HeEdge {
+    startvert :: HeVert a  -- start-vertex of the half-edge
+  , oppedge   :: HeEdge a  -- oppositely oriented adjacent half-edge
+  , edgeface  :: HeFace a  -- face the half-edge borders
+  , nextedge  :: HeEdge a  -- next half-edge around the face
+} | NoEdge
+
+-- This is a helper data structure of half-edge edges
+-- for tying the knots in 'indirectToDirect'.
+data IndirectHeEdge = IndirectHeEdge {
+    edgeindex  :: Int  -- edge index
+  , svindex    :: Int  -- index of start-vertice
+  , nvindex    :: Int  -- index of next-vertice
+  , indexf     :: Int  -- index of face
+  , offsetedge :: Int  -- offset to get the next edge
+} deriving (Show)
+
+-- This is a helper data structure of half-edge vertices
+-- for tying the knots in 'indirectToDirect'.
+data IndirectHeVert = IndirectHeVert {
+    emedgeindex  :: Int    -- emanating edge index (starts at 1)
+  , edgelist     :: [Int]  -- index of edge that points to this vertice
+} deriving (Show)
+
+-- This is a helper data structure of half-edge faces
+-- for tying the knots in 'indirectToDirect'.
+data IndirectHeFace =
+  IndirectHeFace (Int, [Int]) -- (faceIndex, [verticeindex])
+  deriving (Show)
+
+
+-- |Construct the indirect data structure for half-edge faces.
+-- This function assumes that the input faces are parsed exactly like so:
+--
+-- @
+-- f 1 3 4 5
+-- f 4 6 1 3
+-- @
+--
+-- becomes
+--
+-- > [[1,3,4,5],[4,6,1,3]]
+indirectHeFaces :: [[Int]]          -- ^ list of faces with their respective
+                                    --   list of vertice-indices
+                -> [IndirectHeFace]
+indirectHeFaces = fmap IndirectHeFace . zip [0..]
+
+
+-- |Construct the indirect data structure for half-edge edges.
+indirectHeEdges :: [IndirectHeFace] -> [IndirectHeEdge]
+indirectHeEdges = concat . fmap indirectHeEdge
+  where
+    indirectHeEdge :: IndirectHeFace -> [IndirectHeEdge]
+    indirectHeEdge   (IndirectHeFace (_, []))  = []
+    indirectHeEdge p@(IndirectHeFace (_, pv@(v:_))) = go p 0
+      where
+        go (IndirectHeFace (_, [])) _
+          = []
+        -- connect last to first element
+        go (IndirectHeFace (fi, [vlast])) ei
+          = [IndirectHeEdge ei vlast v fi (negate $ length pv - 1)]
+        -- regular non-last element
+        go (IndirectHeFace (fi, vfirst:vnext:vrest)) ei
+          = (:) (IndirectHeEdge ei vfirst vnext fi 1)
+                (go (IndirectHeFace (fi, vnext:vrest)) (ei + 1))
+
+
+-- |Construct the indirect data structure for half-edge vertices.
+-- It is assumed that the list of points is indexed in order of their
+-- appearance in the obj mesh file.
+indirectHeVerts :: [IndirectHeEdge]          -- ^ list of indirect edges
+                -> Map.IntMap IndirectHeVert -- ^ output map, starts at index 1
+indirectHeVerts hes' = go hes' Map.empty 0
+  where
+    go [] map' _ = map'
+    go (IndirectHeEdge _ _ nv _ offset:hes) map' i
+      = go hes
+           (Map.alter updateMap nv map')
+           (i + 1)
+      where
+        updateMap (Just (IndirectHeVert _ xs))
+          = Just (IndirectHeVert (i + offset) (i:xs))
+        updateMap Nothing
+          = Just (IndirectHeVert (i + offset) [i])
+
+
+-- |Tie the knots!
+-- It is assumed that the list of points is indexed in order of their
+-- appearance in the obj mesh file.
+--
+-- pseudo-code:
+--
+-- @
+-- indirectToDirect :: [a] -- parsed vertices, e.g. 2d points (Double, Double)
+--                  -> [IndirectHeEdge]
+--                  -> [IndirectHeFace]
+--                  -> [IndirectHeVert]
+--                  -> HeEdge a
+-- indirectToDirect points edges faces vertices
+--   = thisEdge (head edges)
+--   where
+--     thisEdge edge
+--       = HeEdge (thisVert (vertices !! svindex edge) $ svindex edge)
+--                (thisOppEdge (svindex edge) $ indexf edge)
+--                (thisFace $ faces !! indexf edge)
+--                (thisEdge $ edges !! (edgeindex edge + offsetedge edge))
+--     thisFace face = HeFace $ thisEdge (edges !! (head . snd $ face))
+--     thisVert vertice coordindex
+--       = HeVert (points !! (coordindex - 1))
+--                (thisEdge $ points !! (emedgeindex vertice - 1))
+--     thisOppEdge startverticeindex faceindex
+--       = case headMay
+--           . filter ((/=) faceindex . indexf)
+--           . fmap (edges !!)
+--           . edgelist         -- getter
+--           $ vertices !! startverticeindex
+--         of Just x  -> thisEdge x
+--            Nothing -> NoEdge
+-- @
+indirectToDirect :: [a]                       -- ^ list of points
+                 -> [IndirectHeEdge]
+                 -> [IndirectHeFace]
+                 -> Map.IntMap IndirectHeVert -- ^ assumed to start at index 1
+                 -> HeEdge a
+indirectToDirect pts pe@(e:_) fs vertmap
+  = thisEdge e
+  where
+    thisEdge (IndirectHeEdge ei sv _ fi off)
+      = case (fs `atMay` fi, pe `atMay` (ei + off), Map.lookup sv vertmap) of
+          (Just face,
+           Just edge,
+           Just vert) -> HeEdge (thisVert vert sv)
+                                (getOppEdge sv fi)
+                                (thisFace face)
+                                (thisEdge edge)
+          _           -> NoEdge
+    thisFace (IndirectHeFace (_, vi:_))
+      = case pe `atMay` vi of
+          Just edge -> HeFace (thisEdge edge)
+          Nothing   -> NoFace
+    thisFace (IndirectHeFace _) = NoFace
+    thisVert (IndirectHeVert eedg _) coordi
+      = case (pts `atMay` (coordi - 1), pe `atMay` (eedg - 1)) of
+          (Just vert, Just edge) -> HeVert vert $ thisEdge edge
+          _                      -> NoVert
+    getOppEdge sv fi
+      = case join
+               $ headMay
+               . filter ((/=) fi . indexf)
+               . catMaybes
+               . fmap (pe `atMay`)
+               . edgelist
+               <$> Map.lookup sv vertmap
+        of Just x  -> thisEdge x
+           Nothing -> NoEdge
+indirectToDirect _ _ _ _ = NoEdge
+
+
+-- |Build the half-edge data structure from a list of points
+-- and from a list of faces.
+-- The points are assumed to have been parsed in order of their appearance
+-- in the .obj mesh file, so that the indices match.
+-- The faces are assumed to have been parsed in order of their appearance
+-- in the .obj mesh file as follows:
+--
+-- @
+-- f 1 3 4 5
+-- f 4 6 1 3
+-- @
+--
+-- becomes
+--
+-- > [[1,3,4,5],[4,6,1,3]]
+buildHeEdge :: [a] -> [[Int]] -> Maybe (HeEdge a)
+buildHeEdge [] _   = Nothing
+buildHeEdge _ []   = Nothing
+buildHeEdge pts fs
+  = let faces' = indirectHeFaces fs
+        edges' = indirectHeEdges faces'
+        verts' = indirectHeVerts edges'
+    in Just $ indirectToDirect pts edges' faces' verts'
+
+
+-- |Build the HeEdge data structure from the .obj mesh file contents.
+buildHeEdgeFromStr :: B.ByteString -- ^ contents of an .obj mesh file
+                   -> HeEdge PT
+buildHeEdgeFromStr bmesh =
+  let pts    = meshVertices bmesh
+      faces' = indirectHeFaces . meshFaces $ bmesh
+      edges  = indirectHeEdges faces'
+      verts  = indirectHeVerts edges
+  in  indirectToDirect pts edges faces' verts
+

Parser/Meshparser.hs

@@ -1,6 +1,6 @@
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
-module Parser.Meshparser (meshToArr, facesToArr) where
+module Parser.Meshparser where
 
 import Algebra.Vector(PT)
 import Control.Applicative
@@ -12,19 +12,17 @@ import Diagrams.TwoD.Types
 
 -- |Convert a text String with multiple vertices and faces into
 -- a list of vertices, ordered by the faces specification.
-facesToArr :: B.ByteString -> [[PT]]
-facesToArr str = fmap (fmap (\y -> meshToArr str !! (fromIntegral y - 1)))
-                      (faces str)
-  where
-    faces = rights . fmap (parseOnly parseFace) . B.lines
+meshFaceVertices :: B.ByteString -> [[PT]]
+meshFaceVertices str = fmap (fmap (\y -> meshVertices str !! (y - 1)))
+                            (meshFaces str)
 
 
 -- |Convert a text String with multiple vertices into
 -- an array of float tuples.
-meshToArr :: B.ByteString -- ^ the string to convert
+meshVertices :: B.ByteString -- ^ the string to convert
           -> [PT]         -- ^ the resulting vertice table
-meshToArr =
-  fmap p2
+meshVertices
+  = fmap p2
     . rights
     . fmap (parseOnly parseVertice)
     . B.lines
@@ -38,5 +36,12 @@ parseVertice =
     <*> (many' space *> double)
 
 
-parseFace :: Parser [Integer]
+parseFace :: (Integral a) => Parser [a]
 parseFace = char 'f' *> many1' (many' space *> decimal)
+
+
+meshFaces :: B.ByteString -> [[Int]]
+meshFaces
+  = rights
+    . fmap (parseOnly parseFace)
+    . B.lines

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')
 
 

test_objs/testcube_trans.obj

@@ -0,0 +1,19 @@
+v 9.0 10.0
+v 11.0 10.0
+v 9.0 11.0
+v 11.0 11.0
+v 9.0 11.0
+v 11.0 11.0
+v 9.0 10.0
+v 11.0 10.0
+f 1 2 4 3
+f 3 4 6 5
+f 5 6 8 7
+f 7 8 2 1
+f 2 8 6 4
+f 7 1 3 5
+
+cstype bezier
+deg 3
+curv 1 2 3 4
+end