diff options
author | Joe Crayne <joe@jerkface.net> | 2019-06-14 02:02:00 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-06-14 02:03:25 -0400 |
commit | 773075e9dd7f0b29d00eee72bdeac5510d340b3a (patch) | |
tree | 81901062f3ce179d6f99b68705998070932e2b11 /src | |
parent | b84c528097bd4d3b93b0f174e093e694c0b2db37 (diff) |
crayne parser: csh command
Diffstat (limited to 'src')
-rw-r--r-- | src/Wavefront.hs | 42 |
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 | |||
54 | , bevel :: Bool -> m () | 54 | , bevel :: Bool -> m () |
55 | , lod :: Int -> m () | 55 | , lod :: Int -> m () |
56 | , call :: S.ByteString -> [S.ByteString] -> m () | 56 | , call :: S.ByteString -> [S.ByteString] -> m () |
57 | , command :: Bool -> L.ByteString -> m L.ByteString | ||
57 | , badToken :: L.ByteString -> m () | 58 | , badToken :: L.ByteString -> m () |
58 | } | 59 | } |
59 | 60 | ||
@@ -101,6 +102,7 @@ nullBuilder = ObjBuilder | |||
101 | , bevel = \b -> pure () | 102 | , bevel = \b -> pure () |
102 | , lod = \lvl -> pure () | 103 | , lod = \lvl -> pure () |
103 | , call = \obj args -> pure () | 104 | , call = \obj args -> pure () |
105 | , command = \b cmd -> pure L.empty | ||
104 | , badToken = \bs -> pure () | 106 | , badToken = \bs -> pure () |
105 | } | 107 | } |
106 | 108 | ||
@@ -197,7 +199,7 @@ findNewLine ps o@(ObjConfig args) bs = case L.break (\c -> c=='\n' || c=='\\' || | |||
197 | 7 cdp | 199 | 7 cdp |
198 | 8 c_interp | 200 | 8 c_interp |
199 | 9 con | 201 | 9 con |
200 | 10 x csh -- for all except these, | 202 | 10 csh -- for all except these, |
201 | 11 cstype -- Two chars suffice to distinguish | 203 | 11 cstype -- Two chars suffice to distinguish |
202 | 12 ctech | 204 | 12 ctech |
203 | 13 curv2 -- for all except these, | 205 | 13 curv2 -- for all except these, |
@@ -419,20 +421,29 @@ parseOBJ builder args bs0 | |||
419 | parseEmbeddedCurves (findToken args) (next 2 bs) $ \ss bs' -> do | 421 | parseEmbeddedCurves (findToken args) (next 2 bs) $ \ss bs' -> do |
420 | equivalentCurves builder ss | 422 | equivalentCurves builder ss |
421 | parseOBJ builder args bs' | 423 | parseOBJ builder args bs' |
422 | "cs" -> -- cstype | 424 | "cs" -> if lengthLessThan 3 bs |
423 | let parseRat = parseChar 'r' | 425 | then bad bs |
424 | parseTyp tok cont | lengthLessThan 3 tok = bad tok | 426 | else case L.index bs 2 of |
425 | | otherwise = case L.index tok 2 of | 427 | 'h' -> -- csh |
426 | 'a' -> cont Bmatrix $ next 3 tok | 428 | let (dash,tok) = L.splitAt 1 $ next 3 bs |
427 | 'z' -> cont Bezier $ next 3 tok | 429 | wantsErrorCheck = dash /= "-" |
428 | 'p' -> cont Bspline $ next 3 tok | 430 | in case findNewLine [] args tok of |
429 | 'r' -> cont Cardinal $ next 3 tok | 431 | (cmd,bs') -> do result <- command builder wantsErrorCheck cmd |
430 | 'y' -> cont Taylor $ next 3 tok | 432 | parseOBJ builder args $ result <> bs' |
431 | _ -> bad tok | 433 | _ -> -- cstype |
432 | in parseRat (next 2 bs) $ \isRat bs' -> do | 434 | let parseRat = parseChar 'r' |
433 | parseTyp bs' $ \typ bs'' -> do | 435 | parseTyp tok cont | lengthLessThan 3 tok = bad tok |
434 | cstype builder isRat typ | 436 | | otherwise = case L.index tok 2 of |
435 | parseOBJ builder args bs'' | 437 | 'a' -> cont Bmatrix $ next 3 tok |
438 | 'z' -> cont Bezier $ next 3 tok | ||
439 | 'p' -> cont Bspline $ next 3 tok | ||
440 | 'r' -> cont Cardinal $ next 3 tok | ||
441 | 'y' -> cont Taylor $ next 3 tok | ||
442 | _ -> bad tok | ||
443 | in parseRat (next 2 bs) $ \isRat bs' -> do | ||
444 | parseTyp bs' $ \typ bs'' -> do | ||
445 | cstype builder isRat typ | ||
446 | parseOBJ builder args bs'' | ||
436 | "ct" -> -- ctech | 447 | "ct" -> -- ctech |
437 | let tok = next 2 bs | 448 | let tok = next 2 bs |
438 | in if lengthLessThan 2 tok | 449 | in if lengthLessThan 2 tok |
@@ -593,7 +604,6 @@ parseOBJ builder args bs0 | |||
593 | in (fn <> L.take 1 ext <> f) : fs | 604 | in (fn <> L.take 1 ext <> f) : fs |
594 | mtllib builder (map L.toStrict $ slurp fnn) | 605 | mtllib builder (map L.toStrict $ slurp fnn) |
595 | parseOBJ builder args bs' | 606 | parseOBJ builder args bs' |
596 | -- TODO: csh | ||
597 | _ -> bad bs | 607 | _ -> bad bs |
598 | where | 608 | where |
599 | bs = findToken args bs0 | 609 | bs = findToken args bs0 |