From f414c3f017a9da40440262bda8aac0486ef6e21b Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sat, 20 Jul 2019 21:03:55 -0400
Subject: Support for renumbering vertices.

---
 src/Wavefront.hs | 45 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 44 insertions(+), 1 deletion(-)

(limited to 'src/Wavefront.hs')

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
          ;import Data.DList                 (DList)
 import Data.Functor.Identity
 import qualified Data.IntMap                as IntMap
+import qualified Data.Text                  as T
 import Data.Text.Encoding                   (decodeUtf8)
 import qualified Data.Vector                as Vector
          ;import Data.Vector                (Vector)
@@ -104,7 +105,7 @@ buildOBJ = nullBuilder
     , mtllib = \xs -> do
         let l = map decodeUtf8 xs
         libs <- gets (objMtlLibs . fst)
-        modifyFirst $ \o -> o { objMtlLibs = libs `DList.append` DList.fromList l }
+        modifyFirst $ \o -> o { objMtlLibs = DList.fromList l `DList.append` libs }
     , groups = \xs -> do
         let g = map decodeUtf8 xs
         modify' $ second $ \e -> e { elGroups = g }
@@ -159,3 +160,45 @@ parseCustom :: Monad m => ObjBuilder m -> (OBJ Count -> m b) -> L.ByteString ->
 parseCustom builder finish bs = do
     counts <- execStateT (parseOBJ (objBookKeeping builder) (ObjConfig IntMap.empty) bs) emptyCounts
     finish counts
+
+data Renumbering = Renumbering
+    { renumV  :: Int -> Int
+    , renumVT :: Int -> Int
+    , renumVN :: Int -> Int
+    , renumVP :: Int -> Int
+    }
+
+renumFrom1 :: Renumbering
+renumFrom1 = Renumbering
+    { renumV  = succ
+    , renumVT = succ
+    , renumVN = succ
+    , renumVP = succ
+    }
+
+addCounts :: OBJ Count -> Renumbering -> Renumbering
+addCounts c r = Renumbering
+    { renumV  = addc (objLocations c) . renumV r
+    , renumVT = addc (objTexCoords c) . renumVT r
+    , renumVN = addc (objNormals c) . renumVN r
+    , renumVP = renumVP r -- TODO
+    }
+
+addc :: Count x -> Int -> Int
+addc (Count c) x = c + x
+
+renumTriple :: Renumbering -> RefTriple -> RefTriple
+renumTriple r (RefTriple v t n) = RefTriple (renumV r v) (renumVT r <$> t) (renumVN r <$> n)
+
+applyRenumbering :: MonadState Renumbering m => ObjBuilder m -> ObjBuilder m
+applyRenumbering builder = builder
+    { face = \ts -> do
+        r <- get
+        face builder $ map (renumTriple r) ts
+    , line = \ts -> do
+        r <- get
+        line builder $ map (renumTriple r) ts
+    , surf = \u0 u1 v0 v1 ts -> do
+        r <- get
+        surf builder u0 u1 v0 v1 $ map (renumTriple r) ts
+    }
-- 
cgit v1.2.3