diff options
Diffstat (limited to 'src/Wavefront.hs')
-rw-r--r-- | src/Wavefront.hs | 45 |
1 files changed, 44 insertions, 1 deletions
diff --git a/src/Wavefront.hs b/src/Wavefront.hs index 638b849..32959d4 100644 --- a/src/Wavefront.hs +++ b/src/Wavefront.hs | |||
@@ -11,6 +11,7 @@ import qualified Data.DList as DList | |||
11 | ;import Data.DList (DList) | 11 | ;import Data.DList (DList) |
12 | import Data.Functor.Identity | 12 | import Data.Functor.Identity |
13 | import qualified Data.IntMap as IntMap | 13 | import qualified Data.IntMap as IntMap |
14 | import qualified Data.Text as T | ||
14 | import Data.Text.Encoding (decodeUtf8) | 15 | import Data.Text.Encoding (decodeUtf8) |
15 | import qualified Data.Vector as Vector | 16 | import qualified Data.Vector as Vector |
16 | ;import Data.Vector (Vector) | 17 | ;import Data.Vector (Vector) |
@@ -104,7 +105,7 @@ buildOBJ = nullBuilder | |||
104 | , mtllib = \xs -> do | 105 | , mtllib = \xs -> do |
105 | let l = map decodeUtf8 xs | 106 | let l = map decodeUtf8 xs |
106 | libs <- gets (objMtlLibs . fst) | 107 | libs <- gets (objMtlLibs . fst) |
107 | modifyFirst $ \o -> o { objMtlLibs = libs `DList.append` DList.fromList l } | 108 | modifyFirst $ \o -> o { objMtlLibs = DList.fromList l `DList.append` libs } |
108 | , groups = \xs -> do | 109 | , groups = \xs -> do |
109 | let g = map decodeUtf8 xs | 110 | let g = map decodeUtf8 xs |
110 | modify' $ second $ \e -> e { elGroups = g } | 111 | modify' $ second $ \e -> e { elGroups = g } |
@@ -159,3 +160,45 @@ parseCustom :: Monad m => ObjBuilder m -> (OBJ Count -> m b) -> L.ByteString -> | |||
159 | parseCustom builder finish bs = do | 160 | parseCustom builder finish bs = do |
160 | counts <- execStateT (parseOBJ (objBookKeeping builder) (ObjConfig IntMap.empty) bs) emptyCounts | 161 | counts <- execStateT (parseOBJ (objBookKeeping builder) (ObjConfig IntMap.empty) bs) emptyCounts |
161 | finish counts | 162 | finish counts |
163 | |||
164 | data Renumbering = Renumbering | ||
165 | { renumV :: Int -> Int | ||
166 | , renumVT :: Int -> Int | ||
167 | , renumVN :: Int -> Int | ||
168 | , renumVP :: Int -> Int | ||
169 | } | ||
170 | |||
171 | renumFrom1 :: Renumbering | ||
172 | renumFrom1 = Renumbering | ||
173 | { renumV = succ | ||
174 | , renumVT = succ | ||
175 | , renumVN = succ | ||
176 | , renumVP = succ | ||
177 | } | ||
178 | |||
179 | addCounts :: OBJ Count -> Renumbering -> Renumbering | ||
180 | addCounts c r = Renumbering | ||
181 | { renumV = addc (objLocations c) . renumV r | ||
182 | , renumVT = addc (objTexCoords c) . renumVT r | ||
183 | , renumVN = addc (objNormals c) . renumVN r | ||
184 | , renumVP = renumVP r -- TODO | ||
185 | } | ||
186 | |||
187 | addc :: Count x -> Int -> Int | ||
188 | addc (Count c) x = c + x | ||
189 | |||
190 | renumTriple :: Renumbering -> RefTriple -> RefTriple | ||
191 | renumTriple r (RefTriple v t n) = RefTriple (renumV r v) (renumVT r <$> t) (renumVN r <$> n) | ||
192 | |||
193 | applyRenumbering :: MonadState Renumbering m => ObjBuilder m -> ObjBuilder m | ||
194 | applyRenumbering builder = builder | ||
195 | { face = \ts -> do | ||
196 | r <- get | ||
197 | face builder $ map (renumTriple r) ts | ||
198 | , line = \ts -> do | ||
199 | r <- get | ||
200 | line builder $ map (renumTriple r) ts | ||
201 | , surf = \u0 u1 v0 v1 ts -> do | ||
202 | r <- get | ||
203 | surf builder u0 u1 v0 v1 $ map (renumTriple r) ts | ||
204 | } | ||