Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Char8 as T hiding(length)
import qualified Data.ByteString.Lazy.Char8 as Tl
import qualified Data.Attoparsec.ByteString.Lazy as Al
--import qualified Data.ByteString.Lazy.IO as TIO
import Control.Monad
import Data.Char(isAlphaNum)
import System.Environment
import qualified Data.ByteString.Internal as BS (c2w, w2c)
isHorizontalSpace' = isHorizontalSpace . BS.c2w
-- | Point represents a vertex of the triangle
data Point a = Point !a !a !a deriving Show
-- | Vector for a given class
data Vector a = Vector !a !a !a deriving Show
-- | Parse coordinate tripliet.
coordinates :: (Fractional a) => ByteString -> (a -> a -> a -> b) -> Parser b
coordinates s f = do
skipSpace
string s
!x <- coordinate
!y <- coordinate
!z <- coordinate
return $! f x y z
where
coordinate = skipWhile isHorizontalSpace' *> fmap realToFrac double
{-# INLINE coordinates #-}
type RawFacet a = (Vector a, Point a, Point a, Point a)
-- | Parse a facet. The facet comprises of a normal, and three vertices
facet :: Fractional a => Parser (RawFacet a)
facet = (,,,) <$> beginFacet
<* (skipSpace *> "outer loop")
<*> vertexPoint
<*> vertexPoint
<*> vertexPoint
<* (skipSpace <* "endloop" <* endFacet )
<?> "facet"
where
beginFacet = skipSpace <* "facet" *> coordinates "normal" Vector
endFacet = skipSpace <* string "endfacet"
vertexPoint = coordinates "vertex" Point
{-# INLINE facet #-}
rawFacets :: Fractional a => Parser [RawFacet a]
rawFacets = beginSolid *> many' facet <* endSolid
where
solidName = option "default" (skipWhile isHorizontalSpace' *> fmap T.pack (many1 $ satisfy isAlphaNum) )
beginSolid = skipSpace <* "solid" *> solidName <?> "start solid"
endSolid = skipSpace <* "endsolid" <?> "end solid"
-- | Read text STL file. STL extensions for color etc. are not supported in this version.
readByteStringSTL :: Fractional a => FilePath -> IO (Either String [RawFacet a])
readByteStringSTL path = liftM (Al.eitherResult . Al.parse rawFacets) (Tl.readFile path)
main :: IO Int
main = do
(path:_) <- getArgs
Prelude.putStrLn $ "Parsing STL file: " ++ path
s <- readByteStringSTL path
Prelude.putStrLn "Parsing complete"
case s of
Left error -> Prelude.putStrLn error
Right s -> do
Prelude.putStrLn $ "Num facets : " ++ show (length s)
return 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.