Add test objs

.gitignore

@@ -11,10 +11,3 @@ 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     = V2 Double
-type PT      = P2 Double
+type Vec     = R2
+type PT      = P2
 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 (V2 a1 a2) (V2 b1 b2) = a1 * b1 + a2 * b2
+scalarProd (R2 a1 a2) (R2 b1 b2) = a1 * b1 + a2 * b2
 
 
 -- |Multiply a scalar with a vector.
 scalarMul :: Double -> Vec -> Vec
-scalarMul d (V2 a b) = V2 (a * d) (b * d)
+scalarMul d (R2 a b) = R2 (a * d) (b * d)
 
 
 -- |Construct a vector that points to a point from the origin.

Algorithms/PolygonIntersection.hs

@@ -136,3 +136,15 @@ 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,7 +65,6 @@ executable Gtk
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gtk
                        Graphics.Diagram.Plotter
-                       Graphics.HalfEdge
                        GUI.Gtk
                        MyPrelude
                        Parser.Meshparser
@@ -77,20 +76,21 @@ executable Gtk
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6,
+                       base >=4.6 && <4.8,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
                        dequeue >= 0.1.5,
-                       diagrams-lib >=1.3,
-                       diagrams-cairo >=1.3,
-                       diagrams-contrib >= 1.3.0.0,
-                       directory >=1.2,
+                       diagrams-lib >=1.2 && <1.3,
+                       diagrams-cairo >=1.2 && <1.3,
+                       diagrams-contrib >= 1.1.2.1,
+                       directory >=1.2 && <1.3,
                        filepath >= 1.3.0.2,
-                       glade >=0.12,
+                       glade >=0.12 && <0.13,
                        gloss >= 1.2.0.1,
-                       gtk >=0.12,
+                       gtk >=0.12 && <0.13,
+                       multiset-comb >= 0.2.1,
                        safe >= 0.3.8,
-                       transformers >=0.4
+                       transformers >=0.4 && <0.5
 
   -- Directories containing source files.
   -- hs-source-dirs:
@@ -115,7 +115,6 @@ executable Gif
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gif
                        Graphics.Diagram.Plotter
-                       Graphics.HalfEdge
                        MyPrelude
                        Parser.Meshparser
                        Parser.PathParser
@@ -127,17 +126,18 @@ executable Gif
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6,
+                       base >=4.6 && <4.8,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
                        dequeue >= 0.1.5,
-                       diagrams-lib >=1.3,
-                       diagrams-cairo >=1.3,
-                       diagrams-contrib >= 1.3.0.0,
+                       diagrams-lib >=1.2 && <1.3,
+                       diagrams-cairo >=1.2 && <1.3,
+                       diagrams-contrib >= 1.1.2.1,
                        gloss >= 1.2.0.1,
                        JuicyPixels >= 3.1.7.1,
-                       safe >= 0.3.8,
-                       transformers >=0.4
+                       multiset-comb >= 0.2.1,
+                       transformers >=0.4 && <0.5,
+                       safe >= 0.3.8
 
   -- Directories containing source files.
   -- hs-source-dirs:
@@ -162,7 +162,6 @@ executable Test
                        Graphics.Diagram.Core
                        Graphics.Diagram.Gif
                        Graphics.Diagram.Plotter
-                       Graphics.HalfEdge
                        MyPrelude
                        Parser.Meshparser
                        Parser.PathParser
@@ -176,14 +175,18 @@ executable Test
 
   -- Other library packages from which modules are imported.
   build-depends:       attoparsec >= 0.12.1.1,
-                       base >=4.6,
+                       base >=4.6 && <4.8,
                        bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
-                       diagrams-lib >=1.3,
-                       diagrams-cairo >=1.3,
-                       diagrams-contrib >= 1.3.0.0,
+                       dequeue >= 0.1.5,
+                       diagrams-lib >=1.2 && <1.3,
+                       diagrams-cairo >=1.2 && <1.3,
+                       diagrams-contrib >= 1.1.2.1,
                        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 :: Graphics.UI.Gtk.Box,
+  vbox7 :: Box,
   -- |Horizontal box containing the Rang search entry widgets.
-  vbox10 :: Graphics.UI.Gtk.Box,
+  vbox10 :: 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
-               (mkSizeSpec2D (Just $ fromIntegral winWidth) (Just $ fromIntegral winHeight))
+               (Dims (fromIntegral winWidth) (fromIntegral winHeight))
                SVG False)
-            (buildDiag (MyPrelude.def{
+            (buildDiag (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
+        prettyRoseTree :: Tree String -> Diagram Cairo R2
         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
+           -> Diagram Cairo R2
   }
   | GifDiag
   {
@@ -24,9 +24,9 @@ data Diag =
               -> Colour Double
               -> ([PT] -> [[PT]])
               -> [PT]
-              -> [Diagram Cairo]
+              -> [Diagram Cairo R2]
   }
-  | EmptyDiag (Diagram Cairo)
+  | EmptyDiag (Diagram Cairo R2)
 
 
 -- |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     -- ^ the resulting diagram
+      -> Diagram Cairo R2  -- ^ the resulting diagram
 drawP [] _  = mempty
 drawP vt ds =
   position (zip vt (repeat dot))
   where
-    dot = circle ds :: Diagram Cairo
+    dot = circle ds :: Diagram Cairo R2
 
 
 -- |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
+               -> Diagram Cairo R2
 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
+pointToTextCoord :: PT -> Diagram Cairo R2
 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, GifDelay)]
+gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, 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, GifDelay)]
-gifDiagS p = gifDiag p . filterValidPT p . meshVertices
+gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo R2, GifDelay)]
+gifDiagS p = gifDiag p . filterValidPT p . meshToArr

Graphics/Diagram/Gtk.hs

@@ -46,7 +46,7 @@ diagTreAlgos =
 
 
 -- |Create the Diagram from the points.
-diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo
+diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo R2
 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
+diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2
 diagS p mesh =
   diag p diagAlgos
     . fmap (filterValidPT p)
-    . (\x -> if null x then [meshVertices mesh] else x)
-    . meshFaceVertices
+    . (\x -> if null x then [meshToArr mesh] else x)
+    . facesToArr
     $ 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
+diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo R2
 diagTreeS p mesh =
   diag p diagTreAlgos
     . fmap (filterValidPT p)
-    . (\x -> if null x then [meshVertices mesh] else x)
-    . meshFaceVertices
+    . (\x -> if null x then [meshToArr mesh] else x)
+    . facesToArr
     $ mesh
 

Graphics/HalfEdge.hs

@@ -1,241 +0,0 @@
-{-# 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 where
+module Parser.Meshparser (meshToArr, facesToArr) where
 
 import Algebra.Vector(PT)
 import Control.Applicative
@@ -12,17 +12,19 @@ import Diagrams.TwoD.Types
 
 -- |Convert a text String with multiple vertices and faces into
 -- a list of vertices, ordered by the faces specification.
-meshFaceVertices :: B.ByteString -> [[PT]]
-meshFaceVertices str = fmap (fmap (\y -> meshVertices str !! (y - 1)))
-                            (meshFaces str)
+facesToArr :: B.ByteString -> [[PT]]
+facesToArr str = fmap (fmap (\y -> meshToArr str !! (fromIntegral y - 1)))
+                      (faces str)
+  where
+    faces = rights . fmap (parseOnly parseFace) . B.lines
 
 
 -- |Convert a text String with multiple vertices into
 -- an array of float tuples.
-meshVertices :: B.ByteString -- ^ the string to convert
+meshToArr :: B.ByteString -- ^ the string to convert
           -> [PT]         -- ^ the resulting vertice table
-meshVertices
-  = fmap p2
+meshToArr =
+  fmap p2
     . rights
     . fmap (parseOnly parseVertice)
     . B.lines
@@ -36,12 +38,5 @@ parseVertice =
     <*> (many' space *> double)
 
 
-parseFace :: (Integral a) => Parser [a]
+parseFace :: Parser [Integer]
 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 :: V2 Double }
+newtype RoundR2 = RoundR2 { getRR2 :: R2 }
   deriving (Eq, Ord, Show, Read)
 
 
-newtype PosRoundR2 = PosRoundR2 { getPRR2 :: V2 Double }
+newtype PosRoundR2 = PosRoundR2 { getPRR2 :: R2 }
   deriving (Eq, Ord, Show, Read)
 
 
-newtype RoundP2 = RoundP2 { getRP2 :: P2 Double }
+newtype RoundP2 = RoundP2 { getRP2 :: P2 }
   deriving (Eq, Ord, Show, Read)
 
 
-newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 Double }
+newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 }
   deriving (Eq, Ord, Show, Read)
 
 
@@ -72,11 +72,11 @@ instance Arbitrary PosRoundP2 where
                 <*> (arbitrary :: Gen PosRoundDouble)
 
 
-instance Arbitrary (V2 Double) where
+instance Arbitrary R2 where
   arbitrary = curry r2 <$> arbitrary <*> arbitrary
 
 
-instance Arbitrary (P2 Double) where
+instance Arbitrary P2 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 (V2 Double) -> Bool
-onPTProp2 pt (Positive (V2 rx ry))
+onPTProp2 :: PT -> Positive R2 -> Bool
+onPTProp2 pt (Positive (R2 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 (V2 x1 _)) (Positive (V2 x2 _))
-  = getAngle (V2 x1 0) (V2 x2 0) == 0
+getAngleProp1 (Positive (R2 x1 _)) (Positive (R2 x2 _))
+  = getAngle (R2 x1 0) (R2 x2 0) == 0
 
 
 -- angle between two vectors both on the y-axis must be 0
 getAngleProp2 :: Positive Vec -> Positive Vec -> Bool
-getAngleProp2 (Positive (V2 _ y1)) (Positive (V2 _ y2))
-  = getAngle (V2 0 y1) (V2 0 y2) == 0
+getAngleProp2 (Positive (R2 _ y1)) (Positive (R2 _ y2))
+  = getAngle (R2 0 y1) (R2 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 (V2 x1 _)) (Positive (V2 x2 _))
-  = getAngle (V2 (negate x1) 0) (V2 x2 0) == pi
+getAngleProp3 (Positive (R2 x1 _)) (Positive (R2 x2 _))
+  = getAngle (R2 (negate x1) 0) (R2 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 (V2 _ y1)) (Positive (V2 _ y2))
-  = getAngle (V2 0 (negate y1)) (V2 0 y2) == pi
+getAngleProp4 (Positive (R2 _ y1)) (Positive (R2 _ y2))
+  = getAngle (R2 0 (negate y1)) (R2 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 (V2 x1 _)) (Positive (V2 _ y2))
-  = getAngle (V2 x1 0) (V2 0 y2) == pi / 2
+getAngleProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2))
+  = getAngle (R2 x1 0) (R2 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 (V2 x1 _)) (Positive (V2 _ y2))
-  = scalarProd (V2 x1 0) (V2 0 y2) == 0
+scalarProdProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2))
+  = scalarProd (R2 x1 0) (R2 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' == (\(V2 x y) -> negate x ^& negate y)
+  | otherwise = vp2 p1' p2' == (\(R2 x y) -> negate x ^& negate y)
                                  (vp2 p2' p1')
                 &&
-                vp2 p2' p1' == (\(V2 x y) -> negate x ^& negate y)
+                vp2 p2' p1' == (\(R2 x y) -> negate x ^& negate y)
                                  (vp2 p1' p2')
 
 

test_objs/UB5_T1_CCW.obj

@@ -0,0 +1,11 @@
+v 150.0 450.0
+v 75.0 300.0
+v 50.0 100.0
+v 125.0 200.0
+v 350.0 50.0
+v 400.0 225.0
+v 350.0 175.0
+v 325.0 425.0
+v 300.0 350.0
+f 1 2 3 4 5 6 7 8 9
+

test_objs/UB5_T2_CCW.obj

@@ -0,0 +1,17 @@
+v 150.0 500.0
+v 100.0 400.0
+v 125.0 300.0
+v 100.0 125.0
+v 125.0 75.0
+v 200.0 50.0
+v 275.0 200.0
+v 350.0 150.0
+v 425.0 225.0
+v 475.0 175.0
+v 500.0 375.0
+v 450.0 350.0
+v 400.0 450.0
+v 300.0 425.0
+f 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+
+

test_objs/testcube_trans.obj

@@ -1,19 +0,0 @@
-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