summaryrefslogtreecommitdiff
path: root/src/Graphics/WaveFront/Parse
diff options
context:
space:
mode:
Diffstat (limited to 'src/Graphics/WaveFront/Parse')
-rw-r--r--src/Graphics/WaveFront/Parse/Common.hs19
-rw-r--r--src/Graphics/WaveFront/Parse/OBJ.hs6
2 files changed, 20 insertions, 5 deletions
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
33-- We'll need these 33-- We'll need these
34-------------------------------------------------------------------------------------------------------------------------------------------- 34--------------------------------------------------------------------------------------------------------------------------------------------
35import Data.Text (Text, pack) 35import Data.Text (Text, pack)
36import Data.Maybe
36import qualified Data.Attoparsec.Text as Atto 37import qualified Data.Attoparsec.Text as Atto
37 38
38import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>)) 39import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>))
39import Linear (V2(..), V3(..)) 40import Linear (V2(..), V3(..),V4(..))
40 41
41import Graphics.WaveFront.Types 42import Graphics.WaveFront.Types
42 43
@@ -151,6 +152,20 @@ point2D :: Fractional f => Atto.Parser (V2 f)
151point2D = V2 <$> coord <*> coord 152point2D = V2 <$> coord <*> coord
152 153
153 154
155pointTo3 :: Fractional f => Int -> f -> Atto.Parser (V3 f)
156pointTo3 3 def = V3 <$> coord <*> coord <*> coord
157pointTo3 2 def = V3 <$> coord <*> coord <*> (fromMaybe def <$> optional coord)
158pointTo3 1 def = (\x m -> case m of { Just (y,z) -> V3 x y z; Nothing -> V3 x def def })
159 <$> coord <*> optional ( do y <- coord
160 z <- fromMaybe def <$> optional coord
161 return (y,z) )
162pointTo3 0 def = fromMaybe (V3 def def def) <$> optional (pointTo3 1 def)
163
164
165pointTo4 :: Fractional f => Int -> f -> Atto.Parser (V4 f)
166pointTo4 4 def = V4 <$> coord <*> coord <*> coord <*> coord
167pointTo4 n def = (\(V3 x y z) mw -> V4 x y z $ fromMaybe def mw) <$> pointTo3 n def <*> optional coord
168
154-- | 169-- |
155clamp :: Ord n => n -> n -> n -> Atto.Parser n 170clamp :: Ord n => n -> n -> n -> Atto.Parser n
156clamp lower upper n 171clamp lower upper n
@@ -163,4 +178,4 @@ clamp lower upper n
163-- | 178-- |
164-- TODO | - Clean up and generalise 179-- TODO | - Clean up and generalise
165clamped :: Integral i => i -> i -> Atto.Parser i 180clamped :: Integral i => i -> i -> Atto.Parser i
166clamped lower upper = Atto.decimal >>= clamp lower upper \ No newline at end of file 181clamped 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
139 139
140-- | Two coordinates, separated by whitespace 140-- | Two coordinates, separated by whitespace
141texcoord :: (Fractional f) => Atto.Parser (OBJToken f Text i m) 141texcoord :: (Fractional f) => Atto.Parser (OBJToken f Text i m)
142texcoord = OBJTexCoord <$> point2D 142texcoord = OBJTexCoord <$> pointTo3 1 0.0
143 143
144 144
145-- | Three coordinates, separated by whitespace 145-- | Three coordinates, separated by whitespace
146vertex :: (Fractional f) => Atto.Parser (OBJToken f s i m) 146vertex :: (Fractional f) => Atto.Parser (OBJToken f s i m)
147vertex = OBJVertex <$> point3D 147vertex = OBJVertex <$> pointTo4 3 1.0
148 148
149 149
150-- | Object names, separated by whitespace 150-- | Object names, separated by whitespace
@@ -170,4 +170,4 @@ lib = LibMTL <$> (space *> name)
170 170
171-- | An MTL material name 171-- | An MTL material name
172use :: Atto.Parser (OBJToken f Text i m) 172use :: Atto.Parser (OBJToken f Text i m)
173use = UseMTL <$> (space *> name) \ No newline at end of file 173use = UseMTL <$> (space *> name)