module Graphics.Formats.OFF.Simple (
OFF (..)
, Face (..)
, vertexCount
, faceCount
, hasColor
, parseOFF
, readOFFFile
) where
import Control.Applicative hiding ( (<|>), many, optional )
import qualified Data.Vector as V
import Data.Vector ( Vector )
import Numeric
import Text.Parsec
import Text.Parsec.String ( Parser )
type Vertex = (Double, Double, Double)
type Color = (Double, Double, Double)
data Face = Face (Vector Int) (Maybe Color)
deriving (Show, Eq, Ord)
data OFF = OFF {
vertices :: Vector Vertex
, faces :: Vector Face
}
deriving (Show, Eq, Ord)
vertexCount :: OFF -> Int
vertexCount (OFF { vertices }) = V.length vertices
faceCount :: OFF -> Int
faceCount (OFF { faces }) = V.length faces
hasColor :: OFF -> Bool
hasColor (OFF { faces }) =
case faces V.!? 0 of
Just (Face _ (Just _)) -> True
_ -> False
parseHeader :: Parser Bool
parseHeader = string "OFF" *> (char 'C' *> return True
<|> return False)
parseComment :: Parser ()
parseComment = char '#' >> manyTill anyChar newline >> return ()
parseCounts :: Parser (Int, Int)
parseCounts = do
vc <- parseInt
spaces
fc <- parseInt
optional (many (oneOf "\t ") >> parseInt)
return (vc, fc)
<?> "vertex, face, and edge count"
parseVertex :: Parser Vertex
parseVertex = do
[x, y, z] <- count 3 (parseDouble <* spaces)
return (x, y, z)
<?> "x, y, z coordinates"
parseVertices :: Int -> Parser (Vector Vertex)
parseVertices n = V.replicateM n (parseVertex <* eatWhitespace)
<?> show n ++ " vertices"
parseFace :: Parser Face
parseFace = do
numVerts <- parseInt
spaces
verts <- V.replicateM numVerts (parseInt <* spaces)
return $ Face verts Nothing
<?> "vertex indices"
parseFaceC :: Parser Face
parseFaceC = do
(Face verts Nothing) <- parseFace
[r, g, b] <- count 3 (parseDouble <* spaces)
return $ Face verts (Just (r, g, b))
<?> "3 color components"
parseFaces :: Int -> Parser (Vector Face)
parseFaces n = V.replicateM n (parseFace <* eatWhitespace)
<?> show n ++ " faces"
parseFacesC :: Int -> Parser (Vector Face)
parseFacesC n = V.replicateM n (parseFaceC <* eatWhitespace)
<?> show n ++ " faces"
parseOFF :: Parser OFF
parseOFF = do
eatWhitespace
isColor <- parseHeader
eatWhitespace
(numVerts, numFaces) <- parseCounts
eatWhitespace
verts <- parseVertices numVerts
eatWhitespace
faces <- if isColor
then parseFacesC numFaces
else parseFaces numFaces
eatWhitespace >> eof
return $ OFF verts faces
readOFFFile :: FilePath -> IO (Either ParseError OFF)
readOFFFile f = parse parseOFF f <$> readFile f
eatWhitespace :: Parser ()
eatWhitespace = try (spaces >> parseComment >> eatWhitespace)
<|> spaces
<|> return ()
parseInt :: Parser Int
parseInt = do
s <- getInput
case readDec s of
[(n, s')] -> n <$ setInput s'
_ -> empty
parseDouble :: Parser Double
parseDouble = do
s <- getInput
case readSigned readFloat s of
[(n, s')] -> n <$ setInput s'
_ -> empty