From d866df206e703854cfa95e6aabe3ed5ed3bfbcaa Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 11 Jun 2019 02:21:46 -0400 Subject: Fixed Sundqvist v and vt parsing. --- src/Graphics/WaveFront/Model.hs | 12 +++++++----- src/Graphics/WaveFront/Parse/Common.hs | 19 +++++++++++++++++-- src/Graphics/WaveFront/Parse/OBJ.hs | 6 +++--- src/Graphics/WaveFront/Types.hs | 13 +++++++------ test/TestSundqvist.hs | 2 +- 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 -- cgit v1.2.3