From 03b4ed79972046dc1397430ac7d96493eb9c2c3e Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Thu, 13 Jun 2019 19:10:07 -0400
Subject: crayne parser: variable substition in g,o,mtlib commands.

---
 src/Wavefront.hs | 101 +++++++++++++++++++++++++++++++++----------------------
 1 file 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 []
-- 
cgit v1.2.3