diff options
Diffstat (limited to 'src/Graphics/WaveFront/Parse')
-rw-r--r-- | src/Graphics/WaveFront/Parse/Common.hs | 19 | ||||
-rw-r--r-- | src/Graphics/WaveFront/Parse/OBJ.hs | 6 |
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 | -------------------------------------------------------------------------------------------------------------------------------------------- |
35 | import Data.Text (Text, pack) | 35 | import Data.Text (Text, pack) |
36 | import Data.Maybe | ||
36 | import qualified Data.Attoparsec.Text as Atto | 37 | import qualified Data.Attoparsec.Text as Atto |
37 | 38 | ||
38 | import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>)) | 39 | import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>)) |
39 | import Linear (V2(..), V3(..)) | 40 | import Linear (V2(..), V3(..),V4(..)) |
40 | 41 | ||
41 | import Graphics.WaveFront.Types | 42 | import Graphics.WaveFront.Types |
42 | 43 | ||
@@ -151,6 +152,20 @@ point2D :: Fractional f => Atto.Parser (V2 f) | |||
151 | point2D = V2 <$> coord <*> coord | 152 | point2D = V2 <$> coord <*> coord |
152 | 153 | ||
153 | 154 | ||
155 | pointTo3 :: Fractional f => Int -> f -> Atto.Parser (V3 f) | ||
156 | pointTo3 3 def = V3 <$> coord <*> coord <*> coord | ||
157 | pointTo3 2 def = V3 <$> coord <*> coord <*> (fromMaybe def <$> optional coord) | ||
158 | pointTo3 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) ) | ||
162 | pointTo3 0 def = fromMaybe (V3 def def def) <$> optional (pointTo3 1 def) | ||
163 | |||
164 | |||
165 | pointTo4 :: Fractional f => Int -> f -> Atto.Parser (V4 f) | ||
166 | pointTo4 4 def = V4 <$> coord <*> coord <*> coord <*> coord | ||
167 | pointTo4 n def = (\(V3 x y z) mw -> V4 x y z $ fromMaybe def mw) <$> pointTo3 n def <*> optional coord | ||
168 | |||
154 | -- | | 169 | -- | |
155 | clamp :: Ord n => n -> n -> n -> Atto.Parser n | 170 | clamp :: Ord n => n -> n -> n -> Atto.Parser n |
156 | clamp lower upper n | 171 | clamp 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 |
165 | clamped :: Integral i => i -> i -> Atto.Parser i | 180 | clamped :: Integral i => i -> i -> Atto.Parser i |
166 | clamped lower upper = Atto.decimal >>= clamp lower upper \ No newline at end of file | 181 | 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 | |||
139 | 139 | ||
140 | -- | Two coordinates, separated by whitespace | 140 | -- | Two coordinates, separated by whitespace |
141 | texcoord :: (Fractional f) => Atto.Parser (OBJToken f Text i m) | 141 | texcoord :: (Fractional f) => Atto.Parser (OBJToken f Text i m) |
142 | texcoord = OBJTexCoord <$> point2D | 142 | texcoord = OBJTexCoord <$> pointTo3 1 0.0 |
143 | 143 | ||
144 | 144 | ||
145 | -- | Three coordinates, separated by whitespace | 145 | -- | Three coordinates, separated by whitespace |
146 | vertex :: (Fractional f) => Atto.Parser (OBJToken f s i m) | 146 | vertex :: (Fractional f) => Atto.Parser (OBJToken f s i m) |
147 | vertex = OBJVertex <$> point3D | 147 | vertex = 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 |
172 | use :: Atto.Parser (OBJToken f Text i m) | 172 | use :: Atto.Parser (OBJToken f Text i m) |
173 | use = UseMTL <$> (space *> name) \ No newline at end of file | 173 | use = UseMTL <$> (space *> name) |