wavefront-obj (empty) → 0.1.0.0
raw patch · 7 files changed
+336/−0 lines, 7 filesdep +attoparsecdep +basedep +containerssetup-changed
Dependencies added: attoparsec, base, containers, hspec, linear, text, transformers, wavefront-obj
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Data/WavefrontObj.hs +34/−0
- src/Data/WavefrontObj/Parsers.hs +101/−0
- src/Data/WavefrontObj/Types.hs +122/−0
- test/Spec.hs +1/−0
- wavefront-obj.cabal +46/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexis Williams (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alexis Williams nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/WavefrontObj.hs view
@@ -0,0 +1,34 @@+{-|+Module : Data.WavefrontObj+Description : Wavefront .obj 3D model loading microlibrary.+Copyright : (c) Alexis Williams 2016+License : BSD3+Maintainer : sasinestro@gmail.com+Stability : experimental+A (very) minimal microlibrary to load 3D geometry from Wavefront .obj files.+-}+module Data.WavefrontObj (+ -- * Types+ WavefrontVertex(..)+ , WavefrontFace'(..), WavefrontFace+ , WavefrontModel'(..), WavefrontModel+ -- * Interface+ , parseWavefrontObj, loadWavefrontObj+ ) where++import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.WavefrontObj.Parsers+import Data.WavefrontObj.Types++{-|+ Takes a 'Text' and gives you either an error message or a 'WavefrontModel' containing the geometry data from the input.+-}+parseWavefrontObj :: T.Text -> (Either String WavefrontModel) +parseWavefrontObj = runWavefrontParser objFileParser++{-|+ A convienence function for the common case of loading a model from a text file on disk.+-}+loadWavefrontObj :: FilePath -> IO (Either String WavefrontModel)+loadWavefrontObj = fmap parseWavefrontObj . T.readFile
+ src/Data/WavefrontObj/Parsers.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.WavefrontObj.Parsers (vertexPointParser, textureCoordParser, vertexNormalParser, faceParser, objFileParser) where++import Control.Applicative+import Control.Monad.Trans.Class+import Data.Attoparsec.Text+import Data.Maybe+import Data.WavefrontObj.Types+import Linear+import Linear.Affine++vertexPointParser :: WavefrontParser ()+vertexPointParser = do+ lift $ char 'v'+ lift skipSpace+ x <- lift double+ lift skipSpace+ y <- lift double+ lift skipSpace+ z <- lift double+ lift (skipWhile $ not . isEndOfLine)+ appendVertexPoint $ P (V3 x y z)++textureCoordParser :: WavefrontParser ()+textureCoordParser = do+ lift $ string "vt"+ lift skipSpace+ u <- lift double+ lift skipSpace+ v <- lift double+ lift (skipWhile $ not . isEndOfLine)+ appendTextureCoordinate $ P (V2 u v)++vertexNormalParser :: WavefrontParser ()+vertexNormalParser = do+ lift $ string "vn"+ lift skipSpace+ x <- lift double+ lift skipSpace+ y <- lift double+ lift skipSpace+ z <- lift double+ lift (skipWhile $ not . isEndOfLine)+ appendVertexNormal $ V3 x y z++faceParser :: WavefrontParser WavefrontFace+faceParser = do+ lift $ char 'f'+ lift $ skipSpace+ vertices <- (vertexWithPointTextureCoordNormal <|> vertexWithPointNormal <|> vertexWithPointTextureCoord <|> vertexWithPoint) `sepBy` lift space+ lift (skipWhile $ not . isEndOfLine)+ return $ WavefrontFace vertices+ where+ vertexWithPoint :: WavefrontParser WavefrontVertex+ vertexWithPoint = do+ vertexPointIdx <- lift $ signed decimal++ vertexPoint <- getVertexPoint vertexPointIdx+ return $ WavefrontVertex vertexPoint Nothing Nothing+ vertexWithPointTextureCoord :: WavefrontParser WavefrontVertex+ vertexWithPointTextureCoord = do+ vertexPointIdx <- lift (signed decimal)+ lift $ char '/'+ textureCoordinateIdx <- lift (signed decimal)++ vertexPoint <- getVertexPoint vertexPointIdx+ textureCoordinate <- getTextureCoordinate textureCoordinateIdx+ return $ WavefrontVertex vertexPoint (Just textureCoordinate) Nothing+ vertexWithPointNormal :: WavefrontParser WavefrontVertex+ vertexWithPointNormal = do+ vertexPointIdx <- lift (signed decimal)+ lift $ string "//"+ vertexNormalIdx <- lift (signed decimal)++ vertexPoint <- getVertexPoint vertexPointIdx+ vertexNormal <- getVertexNormal vertexNormalIdx+ return $ WavefrontVertex vertexPoint Nothing (Just vertexNormal)+ vertexWithPointTextureCoordNormal :: WavefrontParser WavefrontVertex+ vertexWithPointTextureCoordNormal = do+ vertexPointIdx <- lift (signed decimal)+ lift $ char '/'+ textureCoordinateIdx <- lift (signed decimal)+ lift $ char '/'+ vertexNormalIdx <- lift (signed decimal)++ vertexPoint <- getVertexPoint vertexPointIdx+ textureCoordinate <- getTextureCoordinate textureCoordinateIdx+ vertexNormal <- getVertexNormal vertexNormalIdx+ return $ WavefrontVertex vertexPoint (Just textureCoordinate) (Just vertexNormal)++objFileParser :: WavefrontParser WavefrontModel+objFileParser = do+ faces <- ((vertexPointParser *> pure Nothing) + <|> (textureCoordParser *> pure Nothing)+ <|> (vertexNormalParser *> pure Nothing)+ <|> (commentParser *> pure Nothing)+ <|> (Just <$> faceParser))+ `sepBy` (lift $ some endOfLine)+ return $ WavefrontModel (catMaybes faces)+ where+ commentParser = lift $ char '#' *> (skipWhile $ not . isEndOfLine)
+ src/Data/WavefrontObj/Types.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Data.WavefrontObj.Types (+ WavefrontParser+ , runWavefrontParser+ , debugWavefrontParser+ , WavefrontVertex(..)+ , WavefrontFace'(..)+ , WavefrontFace+ , WavefrontModel'(..)+ , WavefrontModel+ , getVertexPoint+ , appendVertexPoint+ , getTextureCoordinate+ , appendTextureCoordinate+ , getVertexNormal+ , appendVertexNormal+ ) where++import Control.Applicative+import Control.Monad.Trans.State.Strict+import Data.Attoparsec.Text+import Data.Sequence ((|>))+import qualified Data.Sequence as S+import qualified Data.Text as T+import Linear.Affine+import Linear.V2+import Linear.V3++type WavefrontParser a = StateT WavefrontState Parser a++runWavefrontParser :: WavefrontParser a -> T.Text -> Either String a+runWavefrontParser p = parseOnly (evalStateT p emptyWavefrontState)++debugWavefrontParser :: WavefrontParser a -> T.Text -> Either String (a, WavefrontState)+debugWavefrontParser p = parseOnly (runStateT p emptyWavefrontState)++data WavefrontState = WavefrontState {+ _vertexPoints :: !(S.Seq (Point V3 Double))+ , _textureCoordinates :: !(S.Seq (Point V2 Double))+ , _vertexNormals :: !(S.Seq (V3 Double))+ }+ deriving (Show, Eq)++emptyWavefrontState :: WavefrontState+emptyWavefrontState = WavefrontState (S.empty) (S.empty) (S.empty)++{-|+ Contains the data for an individual vertex, with the world-space coordinate, (optional) texture-space coordinate, and the (optional) precalculated normal vector.++ TODO: Add an option to add normals for models without them(?).+-}+data WavefrontVertex = WavefrontVertex {+ _vertexPoint :: !(Point V3 Double)+ , _textureCoordinate :: !(Maybe (Point V2 Double))+ , _vertexNormal :: !(Maybe (V3 Double))+ }+ deriving (Show, Eq)++-- | The underlying datatype to store the vertices for a face.+newtype WavefrontFace' a = WavefrontFace [a]+ deriving (Show, Eq, Functor, Foldable)++-- | An alias to make the the type signatures look nicer while still allowing the instances that you would want (without pulling in mono-traversable).+type WavefrontFace = WavefrontFace' WavefrontVertex++-- | Models are not exactly complicated in this system, just a list of faces.+newtype WavefrontModel' a = WavefrontModel [a]+ deriving (Show, Eq, Functor, Foldable)++-- | Another alias to beautify type signatures.+type WavefrontModel = WavefrontModel' WavefrontFace++--++getVertexPoint :: (Monad m) => Int -> StateT WavefrontState m (Point V3 Double)+getVertexPoint idx' = do+ vertexPoints <- _vertexPoints <$> get+ let idx = if idx' > 0+ then idx'+ else idx' + (S.length vertexPoints) + 1+ if (idx > S.length vertexPoints) || (idx <= 0)+ then fail $ "Invalid model! Vertex point at index " ++ show idx' ++ " doesn't exist."+ else return $ S.index vertexPoints (idx - 1)++appendVertexPoint :: (Monad m) => Point V3 Double -> StateT WavefrontState m ()+appendVertexPoint p = do+ curState <- get+ put $ curState { _vertexPoints = (_vertexPoints curState) |> p }++--++getTextureCoordinate :: (Monad m) => Int -> StateT WavefrontState m (Point V2 Double)+getTextureCoordinate idx' = do+ textureCoordinates <- _textureCoordinates <$> get+ let idx = if idx' > 0+ then idx'+ else idx' + (S.length textureCoordinates) + 1+ if (idx > S.length textureCoordinates) || (idx <= 0)+ then fail $ "Invalid model! Texture coordinate at index " ++ show idx' ++ " doesn't exist."+ else return $ S.index textureCoordinates (idx - 1)++appendTextureCoordinate :: (Monad m) => Point V2 Double -> StateT WavefrontState m ()+appendTextureCoordinate t = do+ curState <- get+ put $ curState { _textureCoordinates = (_textureCoordinates curState) |> t }++--++getVertexNormal :: (Monad m) => Int -> StateT WavefrontState m (V3 Double)+getVertexNormal idx' = do+ vertexNormals <- _vertexNormals <$> get+ let idx = if idx' > 0+ then idx'+ else idx' + (S.length vertexNormals) + 1+ if (idx > S.length vertexNormals) || (idx <= 0)+ then fail $ "Invalid model! Vertex normal at index " ++ show idx' ++ " doesn't exist."+ else return $ S.index vertexNormals (idx - 1)++appendVertexNormal :: (Monad m) => V3 Double -> StateT WavefrontState m ()+appendVertexNormal n = do+ curState <- get+ put $ curState { _vertexNormals = (_vertexNormals curState) |> n }
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ wavefront-obj.cabal view
@@ -0,0 +1,46 @@+name: wavefront-obj+version: 0.1.0.0+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Copyright: (c) 2016 Alexis Williams+maintainer: sasinestro@gmail.com+homepage: https://github.com/sasinestro/wavefront-obj#readme+synopsis: Wavefront .obj file loader+description:+ See <https://github.com/SASinestro/wavefront-obj/blob/master/README.md>.+category: Graphics+author: Alexis Williams++source-repository head+ type: git+ location: https://github.com/sasinestro/wavefront-obj++library+ exposed-modules:+ Data.WavefrontObj+ build-depends:+ base >=4.7 && <5,+ containers >=0.5.7.1 && <0.6,+ text >=1.2.0.6 && <1.3,+ transformers >=0.3.0.0 && <0.6,+ attoparsec >=0.12.1.5 && <0.14,+ linear >=1.20.5 && <1.21+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules:+ Data.WavefrontObj.Types+ Data.WavefrontObj.Parsers++test-suite wavefront-obj-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-depends:+ base >=4.9.0.0 && <4.10,+ linear >=1.20.5 && <1.21,+ wavefront-obj >=0.1.0.0 && <0.2,+ hspec >=2.1.5 && <2.4+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N