summaryrefslogtreecommitdiff
path: root/src/Wavefront.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Wavefront.hs')
-rw-r--r--src/Wavefront.hs45
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)
12import Data.Functor.Identity 12import Data.Functor.Identity
13import qualified Data.IntMap as IntMap 13import qualified Data.IntMap as IntMap
14import qualified Data.Text as T
14import Data.Text.Encoding (decodeUtf8) 15import Data.Text.Encoding (decodeUtf8)
15import qualified Data.Vector as Vector 16import 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 ->
159parseCustom builder finish bs = do 160parseCustom 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
164data Renumbering = Renumbering
165 { renumV :: Int -> Int
166 , renumVT :: Int -> Int
167 , renumVN :: Int -> Int
168 , renumVP :: Int -> Int
169 }
170
171renumFrom1 :: Renumbering
172renumFrom1 = Renumbering
173 { renumV = succ
174 , renumVT = succ
175 , renumVN = succ
176 , renumVP = succ
177 }
178
179addCounts :: OBJ Count -> Renumbering -> Renumbering
180addCounts 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
187addc :: Count x -> Int -> Int
188addc (Count c) x = c + x
189
190renumTriple :: Renumbering -> RefTriple -> RefTriple
191renumTriple r (RefTriple v t n) = RefTriple (renumV r v) (renumVT r <$> t) (renumVN r <$> n)
192
193applyRenumbering :: MonadState Renumbering m => ObjBuilder m -> ObjBuilder m
194applyRenumbering 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 }