crayne parser: call command.

1 files changed, 24 insertions, 2 deletions

diff --git a/src/Wavefront.hs b/src/Wavefront.hs
index b97c304..deae37b 100644
--- a/src/Wavefront.hs
+++ b/src/Wavefront.hs
@@ -53,6 +53,7 @@ data ObjBuilder m = ObjBuilder
     , deprecated_res   :: [Int] -> m ()
     , bevel            :: Bool -> m ()
     , lod              :: Int -> m ()
+    , call             :: S.ByteString -> [S.ByteString] -> m ()
     , badToken         :: L.ByteString -> m ()
     }
 
@@ -99,6 +100,7 @@ nullBuilder = ObjBuilder
     , deprecated_res   = \is             -> pure ()
     , bevel            = \b              -> pure ()
     , lod              = \lvl            -> pure ()
+    , call             = \obj args       -> pure ()
     , badToken         = \bs             -> pure ()
     }
 
@@ -190,7 +192,7 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
      2      bmat
      3      bsp
      4      bzp
-     5  x   call
+     5      call
      6      cdc
      7      cdp
      8      c_interp
@@ -390,6 +392,26 @@ parseOBJ builder args bs0
 
         "bs" -> parseI deprecated_bsp 4 -- bsp
         "bz" -> parseI deprecated_bzp 4 -- bzp
+        "ca" -> -- call
+                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]
+                                         | ".obj" <- L.take 4 ext ->
+                                                if L.all isSpace (L.take 1 $ L.drop 4 ext)
+                                                    then (fn <> ".obj") : slurpArgs (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
+                            slurpArgs fnn | L.null fnn = []
+                            slurpArgs fnn = case L.break isSpace fnn of
+                                (a,as) -> findToken args a : slurpArgs as
+                        case map L.toStrict $ slurpArgs fnn of
+                            []    -> return ()
+                            fn:as -> call builder fn as
+                        parseOBJ builder args bs'
+
         "cd" -> if lengthLessThan 3 bs || L.index bs 2 /= 'p'
                     then parseI deprecated_cdc 4 -- cdc
                     else parseI deprecated_cdp 4 -- cdp
@@ -571,7 +593,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
+        -- TODO: csh
         _    -> bad bs
     where
         bs = findToken args bs0