crayne parser: csh command

1 files changed, 26 insertions, 16 deletions

diff --git a/src/Wavefront.hs b/src/Wavefront.hs
index deae37b..6200bf2 100644
--- a/src/Wavefront.hs
+++ b/src/Wavefront.hs
@@ -54,6 +54,7 @@ data ObjBuilder m = ObjBuilder
     , bevel            :: Bool -> m ()
     , lod              :: Int -> m ()
     , call             :: S.ByteString -> [S.ByteString] -> m ()
+    , command          :: Bool -> L.ByteString -> m L.ByteString
     , badToken         :: L.ByteString -> m ()
     }
 
@@ -101,6 +102,7 @@ nullBuilder = ObjBuilder
     , bevel            = \b              -> pure ()
     , lod              = \lvl            -> pure ()
     , call             = \obj args       -> pure ()
+    , command          = \b cmd          -> pure L.empty
     , badToken         = \bs             -> pure ()
     }
 
@@ -197,7 +199,7 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' ||
      7      cdp
      8      c_interp
      9      con
-    10  x   csh    -- for all except these,
+    10      csh    -- for all except these,
     11      cstype -- Two chars suffice to distinguish
     12      ctech
     13      curv2 -- for all except these,
@@ -419,20 +421,29 @@ parseOBJ builder args bs0
                 parseEmbeddedCurves (findToken args) (next 2 bs) $ \ss bs' -> do
                     equivalentCurves builder ss
                     parseOBJ builder args bs'
-        "cs" -> -- cstype
-                let parseRat = parseChar 'r'
-                    parseTyp tok cont | lengthLessThan 3 tok = bad tok
-                                      | otherwise = case L.index tok 2 of
-                        'a' -> cont Bmatrix  $ next 3 tok
-                        'z' -> cont Bezier   $ next 3 tok
-                        'p' -> cont Bspline  $ next 3 tok
-                        'r' -> cont Cardinal $ next 3 tok
-                        'y' -> cont Taylor   $ next 3 tok
-                        _   -> bad tok
-                in parseRat (next 2 bs) $ \isRat bs' -> do
-                    parseTyp bs' $ \typ bs'' -> do
-                        cstype builder isRat typ
-                        parseOBJ builder args bs''
+        "cs" -> if lengthLessThan 3 bs
+                    then bad bs
+                    else case L.index bs 2 of
+                        'h' -> -- csh
+                               let (dash,tok) = L.splitAt 1 $ next 3 bs
+                                   wantsErrorCheck = dash /= "-"
+                               in case findNewLine [] args tok of
+                                (cmd,bs') -> do result <- command builder wantsErrorCheck cmd
+                                                parseOBJ builder args $ result <> bs'
+                        _ -> -- cstype
+                             let parseRat = parseChar 'r'
+                                 parseTyp tok cont | lengthLessThan 3 tok = bad tok
+                                                   | otherwise = case L.index tok 2 of
+                                    'a' -> cont Bmatrix  $ next 3 tok
+                                    'z' -> cont Bezier   $ next 3 tok
+                                    'p' -> cont Bspline  $ next 3 tok
+                                    'r' -> cont Cardinal $ next 3 tok
+                                    'y' -> cont Taylor   $ next 3 tok
+                                    _   -> bad tok
+                             in parseRat (next 2 bs) $ \isRat bs' -> do
+                                    parseTyp bs' $ \typ bs'' -> do
+                                        cstype builder isRat typ
+                                        parseOBJ builder args bs''
         "ct" -> -- ctech
                 let tok = next 2 bs
                 in if lengthLessThan 2 tok
@@ -593,7 +604,6 @@ parseOBJ builder args bs0
                                                         in (fn <> L.take 1 ext <> f) : fs
                         mtllib builder (map L.toStrict $ slurp fnn)
                         parseOBJ builder args bs'
-        -- TODO: csh
         _    -> bad bs
     where
         bs = findToken args bs0