Fixed Sundqvist v and vt parsing.

5 files changed, 35 insertions, 17 deletions

diff --git a/src/Graphics/WaveFront/Model.hs b/src/Graphics/WaveFront/Model.hs
index 96172a8..dfd90ef 100644
--- a/src/Graphics/WaveFront/Model.hs
+++ b/src/Graphics/WaveFront/Model.hs
@@ -60,7 +60,7 @@ import           Data.Set (Set)
 import Data.List   (groupBy)
 import Data.Maybe  (listToMaybe, catMaybes)
 
-import Linear (V2(..), V3(..))
+import Linear (V2(..), V3(..), V4(..))
 
 import Control.Lens ((^.), (.~), (%~), (&), _1, _2, _3)
 
@@ -271,14 +271,16 @@ tessellate = indices %~ triangles
 --        - Refactor
 --        - Folding over applicative (fold in parallel)
 --        - Make sure the order is right
-bounds :: (Num f, Ord f, Foldable m, HasVertices (Model f s i m) (m (V3 f))) => Model f s i m -> BoundingBox (V3 f)
+bounds :: (Num f, Ord f, Foldable m, HasVertices (Model f s i m) (m (V4 f))) => Model f s i m -> BoundingBox (V3 f)
 bounds model = fromExtents $ axisBounds (model^.vertices) <$> V3 x y z
   where
     -- TODO | - Factor out 'minmax'
     minmaxBy :: (Ord o, Num o, Foldable m) => (a -> o) -> m a -> (o, o)
     minmaxBy f values = foldr (\val' acc -> let val = f val' in (min val (fst acc), max val (snd acc))) (0, 0) values -- TODO: Factor out
 
-    axisBounds vs axis = minmaxBy (^.axis) vs
+    axisBounds vs axis = minmaxBy ((^.axis) . proj) vs
+
+    proj (V4 x y z _) = V3 x y z
 
 -- Orphaned TODOs?
 
@@ -316,7 +318,7 @@ diffuseColours faces' = V.concatMap (\f -> V.replicate (V.length $ f^.indices) (
 --        - Add docstrings
 
 -- |
-unindexedVertices :: Model f Text Int Vector -> Maybe (Vector (V3 f))
+unindexedVertices :: Model f Text Int Vector -> Maybe (Vector (V4 f))
 unindexedVertices model = sequence $ fromFaceIndices (model^.vertices) (index) (^.ivertex) (model^.faces)
   where
     index coords i = coords !? (i-1)
@@ -326,7 +328,7 @@ unindexedNormals model = sequence $ fromFaceIndices (model^.normals) (index) (^.
   where
     index coords mi = mi >>= \i -> coords !? (i-1)
 
-unindexedTexcoords :: Model f Text Int Vector -> Maybe (Vector (V2 f))
+unindexedTexcoords :: Model f Text Int Vector -> Maybe (Vector (V3 f))
 unindexedTexcoords model = sequence $ fromFaceIndices (model^.texcoords) (index) (^.itexcoord) (model^.faces)
   where
     index coords mi = mi >>= \i -> coords !? (i-1)
diff --git a/src/Graphics/WaveFront/Parse/Common.hs b/src/Graphics/WaveFront/Parse/Common.hs
index bfeb2d8..1554d45 100644
--- a/src/Graphics/WaveFront/Parse/Common.hs
+++ b/src/Graphics/WaveFront/Parse/Common.hs
@@ -33,10 +33,11 @@ module Graphics.WaveFront.Parse.Common where
 -- We'll need these
 --------------------------------------------------------------------------------------------------------------------------------------------
 import           Data.Text (Text, pack)
+import           Data.Maybe
 import qualified Data.Attoparsec.Text as Atto
 
 import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>))
-import Linear (V2(..), V3(..))
+import Linear (V2(..), V3(..),V4(..))
 
 import Graphics.WaveFront.Types
 
@@ -151,6 +152,20 @@ point2D :: Fractional f => Atto.Parser (V2 f)
 point2D = V2 <$> coord <*> coord
 
 
+pointTo3 :: Fractional f => Int -> f -> Atto.Parser (V3 f)
+pointTo3 3 def = V3 <$> coord <*> coord <*> coord
+pointTo3 2 def = V3 <$> coord <*> coord <*> (fromMaybe def <$> optional coord)
+pointTo3 1 def = (\x m -> case m of { Just (y,z) -> V3 x y z; Nothing -> V3 x def def })
+                    <$> coord <*> optional ( do y <- coord
+                                                z <- fromMaybe def <$> optional coord
+                                                return (y,z) )
+pointTo3 0 def = fromMaybe (V3 def def def) <$> optional (pointTo3 1 def)
+
+
+pointTo4 :: Fractional f => Int -> f -> Atto.Parser (V4 f)
+pointTo4 4 def = V4 <$> coord <*> coord <*> coord <*> coord
+pointTo4 n def = (\(V3 x y z) mw -> V4 x y z $ fromMaybe def mw) <$> pointTo3 n def <*> optional coord
+
 -- |
 clamp :: Ord n => n -> n -> n -> Atto.Parser n
 clamp lower upper n
@@ -163,4 +178,4 @@ clamp lower upper n
 -- |
 -- TODO | - Clean up and generalise
 clamped :: Integral i => i -> i -> Atto.Parser i
-clamped lower upper = Atto.decimal >>= clamp lower upper
\ No newline at end of file
+clamped lower upper = Atto.decimal >>= clamp lower upper
diff --git a/src/Graphics/WaveFront/Parse/OBJ.hs b/src/Graphics/WaveFront/Parse/OBJ.hs
index 37aa5a0..69cce47 100644
--- a/src/Graphics/WaveFront/Parse/OBJ.hs
+++ b/src/Graphics/WaveFront/Parse/OBJ.hs
@@ -139,12 +139,12 @@ normal = OBJNormal <$> point3D
 
 -- | Two coordinates, separated by whitespace
 texcoord :: (Fractional f) => Atto.Parser (OBJToken f Text i m)
-texcoord = OBJTexCoord <$> point2D
+texcoord = OBJTexCoord <$> pointTo3 1 0.0
 
 
 -- | Three coordinates, separated by whitespace
 vertex :: (Fractional f) =>  Atto.Parser (OBJToken f s i m)
-vertex  = OBJVertex <$> point3D
+vertex  = OBJVertex <$> pointTo4 3 1.0
 
 
 -- | Object names, separated by whitespace
@@ -170,4 +170,4 @@ lib = LibMTL <$> (space *> name)
 
 -- | An MTL material name
 use :: Atto.Parser (OBJToken f Text i m)
-use = UseMTL <$> (space *> name)
\ No newline at end of file
+use = UseMTL <$> (space *> name)
diff --git a/src/Graphics/WaveFront/Types.hs b/src/Graphics/WaveFront/Types.hs
index ccd1425..5b093de 100644
--- a/src/Graphics/WaveFront/Types.hs
+++ b/src/Graphics/WaveFront/Types.hs
@@ -43,7 +43,7 @@ module Graphics.WaveFront.Types where
 import Data.Functor.Classes (Show1) --Eq1, Show1, showsPrec1, eq1)
 import Data.Map as M (Map)
 import Data.Set as S (Set)
-import Linear (V2(..), V3(..))
+import Linear (V2(..), V3(..), V4(..))
 
 
 
@@ -65,9 +65,9 @@ import Linear (V2(..), V3(..))
 --
 --        - Cover the entire spec (http://www.martinreddy.net/gfx/3d/OBJ.spec)
 --          (and handle unimplemented attributes gracefully)
-data OBJToken f s i m = OBJVertex   (V3 f) |
+data OBJToken f s i m = OBJVertex   (V4 f) |
                         OBJNormal   (V3 f) |
-                        OBJTexCoord (V2 f) |
+                        OBJTexCoord (V3 f) |
                         OBJFace (m (VertexIndices i)) | -- TODO: Associate material with each face, handle absent indices
 
                         Line i i | -- Line (I'm assuming the arguments are indices to the endpoint vertices)
@@ -202,9 +202,9 @@ data Material f s = Material {
 -- fTextures  :: Set s,
 -- data Model f s i m = Model {
 data Model f s i m = Model {
-  fVertices  :: m (V3 f),
+  fVertices  :: m (V4 f),
   fNormals   :: m (V3 f),
-  fTexcoords :: m (V2 f),
+  fTexcoords :: m (V3 f),
   fFaces     :: m (Face f s i m),
   fMaterials :: MTLTable f s,         -- TODO: Type synonym (?)
   fGroups    :: Map (Set s) (i, i), -- TODO: Type synonym
@@ -229,6 +229,7 @@ deriving instance (Show1 m,
                    Show (m f),
                    Show (m (V2 f)),
                    Show (m (V3 f)),
+                   Show (m (V4 f)),
                    Show (m (Face f s i m)),
                    Show (m s),
                    Show f,
@@ -251,4 +252,4 @@ deriving instance (Show1 m,
                    Show (m s),
                    Show f,
                    Show s,
-                   Show i) => Show (OBJToken f s i m) -- where showsPrec = _
\ No newline at end of file
+                   Show i) => Show (OBJToken f s i m) -- where showsPrec = _
diff --git a/test/TestSundqvist.hs b/test/TestSundqvist.hs
index bfcad6b..6345cd9 100644
--- a/test/TestSundqvist.hs
+++ b/test/TestSundqvist.hs
@@ -18,4 +18,4 @@ main = do
     r1 <- Load.obj (ddir ++ "/01.obj")
     print r1
     -- Failed: endOfInput
-    -- Reason: vt has 3 components instead of 2.
+    -- Reason: vp token, leading spaces, empty lines