crayne parser: variable substition in g,o,mtlib commands.

1 files changed, 60 insertions, 41 deletions

diff --git a/src/Wavefront.hs b/src/Wavefront.hs
index 74d0b39..ca4b497 100644
--- a/src/Wavefront.hs
+++ b/src/Wavefront.hs
@@ -147,48 +147,67 @@ findToken (ObjConfig args) bs = case L.dropWhile (\c -> isSpace c || c=='\\') bs
     Just _             -> cs
     Nothing            -> L.empty
 
+findNewLine :: [L.ByteString] -> ObjConfig -> L.ByteString -> (L.ByteString,L.ByteString)
+findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' || c=='#' || c=='\\') bs of
+  (ts,cs) -> case L.uncons cs of
+    Just ('\n',ds)     -> (L.concat $ reverse $ ts : ps,ds)
+    Just ('#',comment) -> findNewLine (ts:ps) o $ L.dropWhile (/='\n') comment
+    Just ('$',ref)     -> case L.splitAt 5 ref of
+                            (refp,ds) -> case I.readDecimal (L.toStrict refp) of
+                                Just (i,es) -> case IntMap.lookup i args of
+                                    Just val -> findNewLine (val:ts:ps) o $ reconsChunk es ds
+                                    _        -> findNewLine (ts:ps) o $ reconsChunk es ds
+                                _ -> findNewLine ("$":ts:ps) o ref
+    Just ('\\',ds)     -> findNewLine (ts:ps) o $ if L.take 1 ds == "\n" then L.drop 1 ds
+                                                                         else ds
+    Nothing            -> (L.concat $ reverse $ ts : ps,L.empty)
+
 {-
 
      1  x   bevel
      2      bmat
-     3      bzp
-     4  x   call
-     5      cdc
-     6  x   c_interp
-     7      con
-     8  x   csh    -- for all except these,
-     9      cstype -- Two chars suffice to distinguish
-    10      ctech
-    11      curv2 -- for all except these,
-    12      curv  -- Two chars suffice to distinguish
-    13      deg
-    14  x   d_interp
-    15      end
-    16      f
-    17      g
-    18      hole
-    19  x   lod
-    20  x   maplib
-    21      mg
-    22      mtllib
-    23      o
-    24      p
-    25      parm
-    26      s
-    27      scrv
-    28  x   shadow_obj
-    29      sp
-    30      stech -- for all except these,
-    31      step  -- Two chars suffice to distinguish
-    32      surf
-    33  x   trace_obj -- for all except these,
-    34      trim      -- Two chars suffice to distinguish
-    35  x   usemap -- for all except these,
-    36      usemtl -- Two chars suffice to distinguish
-    37      v
-    38      vn
-    39      vp
-    40      vt
+     3  x   bsp
+     4      bzp
+     5  x   call
+     6      cdc
+     7  x   cdp
+     8  x   c_interp
+     9      con
+    10  x   csh    -- for all except these,
+    11      cstype -- Two chars suffice to distinguish
+    12      ctech
+    13      curv2 -- for all except these,
+    14      curv  -- Two chars suffice to distinguish
+    15      deg
+    16  x   d_interp
+    17      end
+    18      f
+    19      g
+    20      hole
+    21  x   lod
+    22  x   maplib
+    23      mg
+    24      mtllib
+    25      o
+    26      p
+    27      parm
+    28  x   res
+    29      s
+    30      scrv
+    31  x   shadow_obj
+    32      sp
+    33      stech -- for all except these,
+    34      step  -- Two chars suffice to distinguish
+    35      surf
+    36  x   trace_obj -- for all except these,
+    37      trim      -- Two chars suffice to distinguish
+    38  x   usemap -- for all except these,
+    39      usemtl -- Two chars suffice to distinguish
+    40      v
+    41      vn
+    42      vp
+    43      vt
+
 
 -}
 
@@ -313,7 +332,7 @@ parseOBJ builder args bs0
     | lengthLessThan 2 bs = return ()
     | isSpace (L.index bs 1)  = case L.head bs of
         'f' -> parseT face 2
-        'g' -> case L.break (=='\n') $ L.drop 1 bs of -- Newline required to terminate group name list.
+        'g' -> case findNewLine [] args $ L.drop 1 bs of -- Newline required to terminate group name list.
                 (gn,bs') -> do
                     groups builder (map L.toStrict $ L.words gn)
                     parseOBJ builder args bs'
@@ -323,7 +342,7 @@ parseOBJ builder args bs0
                             parseOBJ builder args bs'
         'v' -> parseV vertex 2
         'o' -> -- o object-name
-               case L.break (=='\n') $ findToken args $ L.drop 1 bs of
+               case findNewLine [] args $ L.drop 1 bs of
                 (objn,bs') -> do
                     objectName builder (L.toStrict objn)
                     parseOBJ builder args bs'
@@ -464,7 +483,7 @@ parseOBJ builder args bs0
                         usemtl builder (L.toStrict mtl)
                         parseOBJ builder args bs'
         "mt" -> -- mtllib
-                case L.break (=='\n') $ next 2 bs of
+                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 []