1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
-- |
-- Module : Graphics.WaveFront.Parse.Common
-- Description :
-- Copyright : (c) Jonatan H Sundqvist, October 2 2016
-- License : MIT
-- Maintainer : Jonatan H Sundqvist
-- Stability : experimental|stable
-- Portability : POSIX (not sure)
-- TODO | - Fully polymorphic (even in the string and list types) (?)
-- -
-- SPEC | -
-- -
--------------------------------------------------------------------------------------------------------------------------------------------
-- GHC Extensions
--------------------------------------------------------------------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------------------------------------------------------------------
-- Section
--------------------------------------------------------------------------------------------------------------------------------------------
module Graphics.WaveFront.Parse.Common where
--------------------------------------------------------------------------------------------------------------------------------------------
-- We'll need these
--------------------------------------------------------------------------------------------------------------------------------------------
import Data.Text (Text, pack)
import Data.Maybe
import qualified Data.Attoparsec.Text as Atto
import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>))
import Linear (V2(..), V3(..),V4(..))
import Graphics.WaveFront.Types
--------------------------------------------------------------------------------------------------------------------------------------------
-- Functions (pure)
--------------------------------------------------------------------------------------------------------------------------------------------
-- Jon's little helpers --------------------------------------------------------------------------------------------------------------------
-- | Consumes all input, including any leading or trailing comments and whitespace
-- TODO | - Rename (?)
wholeFile :: Atto.Parser a -> Atto.Parser a
wholeFile p = cutToTheChase *> p <* cutToTheChase <* Atto.endOfInput
-- | Skips any leading comments, line breaks and empty lines
-- TODO | - Rename (?)
-- - Skip whitespace
cutToTheChase :: Atto.Parser ()
cutToTheChase = Atto.skipMany ((comment *> pure ()) <|> (Atto.satisfy isLinearSpace *> pure ()) <|> Atto.endOfLine)
-- | OBJ rows may be separated by one or more lines of comments and whitespace, or empty lines.
-- TODO | - Make sure this is right
lineSeparator :: Atto.Parser ()
lineSeparator = Atto.skipMany1 $ ignore space *> ignore comment *> Atto.endOfLine
-- | Parses a comment (from the '#' to end of the line), possibly preceded by whitespace
-- TODO | - Break out the whitespace part (?)
comment :: Atto.Parser Text
comment = Atto.skipSpace *> Atto.char '#' *> Atto.takeTill (\c -> (c == '\r') || (c == '\n')) -- TODO: Is the newline consumed (?)
-- | Tries the given parser, falls back to 'Nothing' if it fails
-- TODO | - Use 'try' to enforce backtracking (?)
optional :: Atto.Parser a -> Atto.Parser (Maybe a)
optional p = Atto.option Nothing (Just <$> p)
-- | Like Atto.skipMany, except it skips one match at the most
ignore :: Atto.Parser a -> Atto.Parser ()
ignore p = optional p *> pure ()
-- |
atleast :: Int -> Atto.Parser a -> Atto.Parser [a]
atleast n p = liftA2 (++) (Atto.count n p) (Atto.many' p)
-- | Skips atleast one white space character (not including newlines and carriage returns)
space :: Atto.Parser ()
space = Atto.skipMany1 (Atto.satisfy isLinearSpace)
-- | Predicate for linear space (eg. whitespace besides newlines)
-- TODO | - Unicode awareness (cf. Data.Char.isSpace)
-- - Come up with a better name (?)
isLinearSpace :: Char -> Bool
isLinearSpace c = (c == ' ') || (c == '\t')
-- | One or more letters (cf. 'Atto.letter' for details)
word :: Atto.Parser Text
word = pack <$> Atto.many1 Atto.letter
-- | Used for texture, material, object and group names (and maybe others that I have yet to think of)
-- TODO | - Use Unicode groups, make more robust (?)
name :: Atto.Parser Text
name = pack <$> Atto.many1 (Atto.satisfy $ \c -> (c /= ' ') && (c /= '\t') && (c /= '\r') && (c /= '\n'))
-- | Parses the strings "off" (False) and "on" (True)
toggle :: Atto.Parser Bool
toggle = (Atto.string "off" *> pure False) <|> (Atto.string "on" *> pure True)
-- | Wraps a parser in a '(' and a ')', with no whitespace in between
parenthesised :: Atto.Parser a -> Atto.Parser a
parenthesised p = Atto.char '(' *> p <* Atto.char ')'
-- TODO | - Allow scientific notation (?)
-- |
coord :: Fractional f => Atto.Parser f
coord = space *> (parenthesised Atto.rational <|> Atto.rational)
-- | A single colour channel
-- TODO | - Clamp to [0,1] (cf. partial from monadplus) (?)
-- - Can channels be parenthesised (?)
channel :: Fractional f => Atto.Parser f
channel = space *> (parenthesised Atto.rational <|> Atto.rational)
-- | A colour with three or four channels (RGB[A])
colour :: Fractional f => Atto.Parser (Colour f)
colour = Colour <$> channel <*> channel <*> channel <*> Atto.option 1 channel
-- | A point in 3D space
point3D :: Fractional f => Atto.Parser (V3 f)
point3D = V3 <$> coord <*> coord <*> coord
-- | A point in 2D space
point2D :: Fractional f => Atto.Parser (V2 f)
point2D = V2 <$> coord <*> coord
pointTo3 :: Fractional f => Int -> f -> Atto.Parser (V3 f)
pointTo3 3 def = V3 <$> coord <*> coord <*> coord
pointTo3 2 def = V3 <$> coord <*> coord <*> (fromMaybe def <$> optional coord)
pointTo3 1 def = (\x m -> case m of { Just (y,z) -> V3 x y z; Nothing -> V3 x def def })
<$> coord <*> optional ( do y <- coord
z <- fromMaybe def <$> optional coord
return (y,z) )
pointTo3 0 def = fromMaybe (V3 def def def) <$> optional (pointTo3 1 def)
pointTo4 :: Fractional f => Int -> f -> Atto.Parser (V4 f)
pointTo4 4 def = V4 <$> coord <*> coord <*> coord <*> coord
pointTo4 n def = (\(V3 x y z) mw -> V4 x y z $ fromMaybe def mw) <$> pointTo3 n def <*> optional coord
-- |
clamp :: Ord n => n -> n -> n -> Atto.Parser n
clamp lower upper n
| between lower upper n = pure n
| otherwise = fail "Number not in range"
where
between lw up n = (lower <= n) && (n <= upper)
-- between 0 <. n <. 5
-- |
-- TODO | - Clean up and generalise
clamped :: Integral i => i -> i -> Atto.Parser i
clamped lower upper = Atto.decimal >>= clamp lower upper
|
