crayne parser: maplib,c_interp,d_interp keywords

1 files changed, 42 insertions, 5 deletions

diff --git a/src/Wavefront.hs b/src/Wavefront.hs
index 84edd6d..208e5bf 100644
--- a/src/Wavefront.hs
+++ b/src/Wavefront.hs
@@ -43,6 +43,9 @@ data ObjBuilder m = ObjBuilder
     , step             :: [Int] -> m ()
     , points           :: [Int] -> m ()
     , usemap           :: Maybe S.ByteString -> m ()
+    , maplib           :: [S.ByteString] -> m ()
+    , c_interp         :: Bool -> m ()
+    , d_interp         :: Bool -> m ()
     , badToken         :: L.ByteString -> m ()
     }
 
@@ -79,6 +82,9 @@ nullBuilder = ObjBuilder
     , step             = \is             -> pure ()
     , points           = \is             -> pure ()
     , usemap           = \map            -> pure ()
+    , maplib           = \fns            -> pure ()
+    , c_interp         = \b              -> pure ()
+    , d_interp         = \b              -> pure ()
     , badToken         = \bs             -> pure ()
     }
 
@@ -173,7 +179,7 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
      5  x   call
      6      cdc
      7  x   cdp
-     8  x   c_interp
+     8      c_interp
      9      con
     10  x   csh    -- for all except these,
     11      cstype -- Two chars suffice to distinguish
@@ -181,13 +187,13 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
     13      curv2 -- for all except these,
     14      curv  -- Two chars suffice to distinguish
     15      deg
-    16  x   d_interp
+    16      d_interp
     17      end
     18      f
     19      g
     20      hole
     21  x   lod
-    22  x   maplib
+    22      maplib
     23      mg
     24      mtllib
     25      o
@@ -210,7 +216,6 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
     42      vp
     43      vt
 
-
 -}
 
 nextToken :: (L.ByteString -> L.ByteString) -> L.ByteString -> L.ByteString
@@ -419,7 +424,23 @@ parseOBJ builder args bs0
                                         let u0:v0:_ = vs ++ repeat 0.0
                                         curv builder u0 v0 is
                                         parseOBJ builder args bs''
+        "c_" -> -- c_interp
+                let tok = findToken args (next 2 bs)
+                in if lengthLessThan 2 tok
+                    then bad tok
+                    else let flag = case L.index tok 1 of
+                                    'f' -> c_interp builder False -- off
+                                    _   -> c_interp builder True  -- on
+                          in parseOBJ builder args (next 2 tok)
         "de" -> parseI deg 3
+        "d_" -> -- d_interp
+                let tok = findToken args (next 2 bs)
+                in if lengthLessThan 2 tok
+                    then bad tok
+                    else let flag = case L.index tok 1 of
+                                    'f' -> d_interp builder False -- off
+                                    _   -> d_interp builder True  -- on
+                          in parseOBJ builder args (next 2 tok)
         "en" -> do endFreeForm builder
                    parseOBJ builder args (next 2 bs)
         "ho" -> -- hole
@@ -499,6 +520,22 @@ parseOBJ builder args bs0
                                                                         else Just (L.toStrict mtl)
                                 _   -> usemtl builder (L.toStrict mtl)
                             parseOBJ builder args bs'
+        "ma" -> -- maplib
+                case findNewLine [] args $ next 2 bs of
+                    (fnn,bs') -> do
+                        let slurp fnn = case L.break (=='.') fnn of
+                                (fn,ext) | L.null (L.drop 1 ext) -> if L.null fn then []
+                                                                                 else [fn]
+                                         | ext <- L.take 4 ext
+                                           -- XXX What is the map library extension?
+                                         , ext `elem` [".map",".mtl",".obj"] ->
+                                                if L.all isSpace (L.take 1 $ L.drop 4 ext)
+                                                    then (fn <> ext) : slurp (findToken args $ L.drop 4 ext)
+                                                    else let f:fs = slurp (L.drop 3 ext) in (fn <> L.take 3 ext <> f) : fs
+                                         | otherwise -> let (f:fs) = slurp (L.drop 1 ext)
+                                                        in (fn <> L.take 1 ext <> f) : fs
+                        maplib builder (map L.toStrict $ slurp fnn)
+                        parseOBJ builder args bs'
         "mt" -> -- mtllib
                 case findNewLine [] args $ next 2 bs of
                     (fnn,bs') -> do
@@ -513,7 +550,7 @@ parseOBJ builder args bs0
                                                         in (fn <> L.take 1 ext <> f) : fs
                         mtllib builder (map L.toStrict $ slurp fnn)
                         parseOBJ builder args bs'
-        -- TODO: call,csh,c_interp,d_interp,lod,shadow_obj,trace_obj,bevel
+        -- TODO: call,csh,lod,shadow_obj,trace_obj,bevel
         _    -> bad bs
     where
         bs = findToken args bs0