wavefront 0.2 → 0.3

raw patch · 6 files changed

+166/−93 lines, 6 filesdep +vector

Dependencies added: vector

Files

• CHANGELOG.md +7/−0
• src/Codec/Wavefront/Element.hs +27/−0
• src/Codec/Wavefront/IO.hs +3/−2
• src/Codec/Wavefront/Lexer.hs +101/−0
• src/Codec/Wavefront/Object.hs +24/−90
• wavefront.cabal +4/−1

@@ -1,3 +1,10 @@+# 0.3++#### Breaking changes++- Changed the interface to manipulate `WavefrontOBJ`. It’s now a dedicated type with `Vector`+  instead of `DList`, which is way better.+ # 0.2  #### Non-breaking changes

@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-----------------------------------------------------------------------------++module Codec.Wavefront.Element (+    -- * Element+    Element(..)+  ) where++import Data.Text ( Text )++-- |An element holds a value along with the user-defined object’s name (if exists), the associated+-- groups and the used material. Those values can be used to sort the data per object or per group+-- and to lookup materials.+data Element a = Element {+    elObject :: Maybe Text+  , elGroups :: [Text]+  , elMtl    :: Maybe Text+  , elValue  :: a+  } deriving (Eq,Show)

@@ -11,11 +11,12 @@  module Codec.Wavefront.IO where -import Codec.Wavefront.Object ( WavefrontOBJ, lexer )+import Codec.Wavefront.Lexer ( lexer )+import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ ) import Codec.Wavefront.Token ( tokenize ) import Control.Monad.IO.Class ( MonadIO(..) ) import qualified Data.Text.IO as T ( readFile )  -- |Extract a 'WavefrontOBJ' from a Wavefront OBJ formatted file. fromFile :: (MonadIO m) => FilePath -> m (Either String WavefrontOBJ)-fromFile fd = liftIO $ fmap (fmap lexer . tokenize) (T.readFile fd)+fromFile fd = liftIO $ fmap (fmap (ctxtToWavefrontOBJ . lexer) . tokenize) (T.readFile fd)

@@ -0,0 +1,101 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-----------------------------------------------------------------------------++module Codec.Wavefront.Lexer where++import Codec.Wavefront.Element+import Codec.Wavefront.Face+import Codec.Wavefront.Line+import Codec.Wavefront.Location+import Codec.Wavefront.Normal+import Codec.Wavefront.Point+import Codec.Wavefront.Token+import Codec.Wavefront.TexCoord+import Data.DList ( DList, append, empty, fromList, snoc )+import Data.Text ( Text )+import Control.Monad.State ( State, execState, gets, modify )+import Data.Foldable ( traverse_ )++-- |The lexer context. The result of lexing a stream of tokens is this exact type.+data Ctxt = Ctxt {+    -- |Locations.+    ctxtLocations :: DList Location+    -- |Texture coordinates.+  , ctxtTexCoords :: DList TexCoord+    -- |Normals.+  , ctxtNormals :: DList Normal+    -- |Points.+  , ctxtPoints :: DList (Element Point)+    -- |Lines.+  , ctxtLines :: DList (Element Line)+    -- |Faces.+  , ctxtFaces :: DList (Element Face)+    -- |Current object.+  , ctxtCurrentObject :: Maybe Text+    -- |Current groups.+  , ctxtCurrentGroups :: [Text]+    -- |Current material.+  , ctxtCurrentMtl :: Maybe Text+    -- |Material libraries.+  , ctxtMtlLibs :: DList Text+  } deriving (Eq,Show)++-- |The empty 'Ctxt'. Such a context exists at the beginning of the token stream and gets altered+-- as we consume tokens.+emptyCtxt :: Ctxt +emptyCtxt = Ctxt {+    ctxtLocations = empty+  , ctxtTexCoords = empty+  , ctxtNormals = empty+  , ctxtPoints = empty+  , ctxtLines = empty+  , ctxtFaces = empty+  , ctxtCurrentObject = Nothing+  , ctxtCurrentGroups = ["default"]+  , ctxtCurrentMtl = Nothing+  , ctxtMtlLibs = empty+  }++-- |The lexer function, consuming tokens and yielding a 'Ctxt'.+lexer :: TokenStream -> Ctxt+lexer stream = execState (traverse_ consume stream) emptyCtxt+  where+    consume tk = case tk of+      TknV v -> do+        locations <- gets ctxtLocations+        modify $ \ctxt -> ctxt { ctxtLocations = locations `snoc` v }+      TknVN vn -> do+        normals <- gets ctxtNormals+        modify $ \ctxt -> ctxt { ctxtNormals = normals `snoc` vn }+      TknVT vt -> do+        texCoords <- gets ctxtTexCoords+        modify $ \ctxt -> ctxt { ctxtTexCoords = texCoords `snoc` vt }+      TknP p -> do+        (pts,element) <- prepareElement ctxtPoints+        modify $ \ctxt -> ctxt { ctxtPoints = pts `append` fmap element (fromList p) }+      TknL l -> do+        (lns,element) <- prepareElement ctxtLines+        modify $ \ctxt -> ctxt { ctxtLines = lns `append` fmap element (fromList l) }+      TknF f -> do+        (fcs,element) <- prepareElement ctxtFaces+        modify $ \ctxt -> ctxt { ctxtFaces = fcs `append` fmap element (fromList f) }+      TknG g -> modify $ \ctxt -> ctxt { ctxtCurrentGroups = g }+      TknO o -> modify $ \ctxt -> ctxt { ctxtCurrentObject = Just o }+      TknMtlLib l -> do+        libs <- gets ctxtMtlLibs+        modify $ \ctxt -> ctxt { ctxtMtlLibs = libs `append` fromList l }+      TknUseMtl mtl -> modify $ \ctxt -> ctxt { ctxtCurrentMtl = Just mtl }++-- Prepare to create a new 'Element' by retrieving its associated list.+prepareElement :: (Ctxt -> DList (Element a)) -> State Ctxt (DList (Element a),a -> Element a)+prepareElement field = do+  (aList,obj,grp,mtl) <- gets $ (\ctxt -> (field ctxt,ctxtCurrentObject ctxt,ctxtCurrentGroups ctxt,ctxtCurrentMtl ctxt))+  pure (aList,Element obj grp mtl)

@@ -9,113 +9,47 @@ -- ----------------------------------------------------------------------------- -module Codec.Wavefront.Object (-    -- * Context and elements-    Ctxt(..)-  , emptyCtxt-  , Element(..)-  , lexer-    -- * Wavefront OBJ-  , WavefrontOBJ-  ) where+module Codec.Wavefront.Object where +import Codec.Wavefront.Element import Codec.Wavefront.Face+import Codec.Wavefront.Lexer ( Ctxt(..) ) import Codec.Wavefront.Line import Codec.Wavefront.Location import Codec.Wavefront.Normal import Codec.Wavefront.Point-import Codec.Wavefront.Token import Codec.Wavefront.TexCoord-import Control.Monad.State ( State, execState, gets, modify )-import Data.DList ( DList, append, empty, fromList, snoc )+import Data.DList ( DList, toList ) import Data.Text ( Text )-import Data.Foldable ( traverse_ )---- |An element holds a value along with the user-defined object’s name (if exists), the associated--- groups and the used material. Those values can be used to sort the data per object or per group--- and to lookup materials.-data Element a = Element {-    elObject :: Maybe Text-  , elGroups :: [Text]-  , elMtl    :: Maybe Text-  , elValue  :: a-  } deriving (Eq,Show)+import Data.Vector ( Vector, fromList ) --- |The lexer context. The result of lexing a stream of tokens is this exact type.-data Ctxt = Ctxt {+data WavefrontOBJ = WavefrontOBJ {     -- |Locations.-    ctxtLocations :: DList Location+    objLocations :: Vector Location     -- |Texture coordinates.-  , ctxtTexCoords :: DList TexCoord+  , objTexCoords :: Vector TexCoord     -- |Normals.-  , ctxtNormals :: DList Normal+  , objNormals :: Vector Normal     -- |Points.-  , ctxtPoints :: DList (Element Point)+  , objPoints :: Vector (Element Point)     -- |Lines.-  , ctxtLines :: DList (Element Line)+  , objLines :: Vector (Element Line)     -- |Faces.-  , ctxtFaces :: DList (Element Face)-    -- |Current object.-  , ctxtCurrentObject :: Maybe Text-    -- |Current groups.-  , ctxtCurrentGroups :: [Text]-    -- |Current material.-  , ctxtCurrentMtl :: Maybe Text+  , objFaces :: Vector (Element Face)     -- |Material libraries.-  , ctxtMtlLibs :: DList Text+  , objMtlLibs :: Vector Text   } deriving (Eq,Show) --- |Wavefront OBJ type.-type WavefrontOBJ = Ctxt---- |The empty 'Ctxt'. Such a context exists at the beginning of the token stream and gets altered--- as we consume tokens.-emptyCtxt :: Ctxt -emptyCtxt = Ctxt {-    ctxtLocations = empty-  , ctxtTexCoords = empty-  , ctxtNormals = empty-  , ctxtPoints = empty-  , ctxtLines = empty-  , ctxtFaces = empty-  , ctxtCurrentObject = Nothing-  , ctxtCurrentGroups = ["default"]-  , ctxtCurrentMtl = Nothing-  , ctxtMtlLibs = empty+ctxtToWavefrontOBJ :: Ctxt -> WavefrontOBJ+ctxtToWavefrontOBJ ctxt = WavefrontOBJ {+    objLocations = fromDList (ctxtLocations ctxt)+  , objTexCoords = fromDList (ctxtTexCoords ctxt)+  , objNormals = fromDList (ctxtNormals ctxt)+  , objPoints = fromDList (ctxtPoints ctxt)+  , objLines = fromDList (ctxtLines ctxt)+  , objFaces = fromDList (ctxtFaces ctxt)+  , objMtlLibs = fromDList (ctxtMtlLibs ctxt)   } --- |The lexer function, consuming tokens and yielding a 'Ctxt'.-lexer :: TokenStream -> Ctxt-lexer stream = execState (traverse_ consume stream) emptyCtxt-  where-    consume tk = case tk of-      TknV v -> do-        locations <- gets ctxtLocations-        modify $ \ctxt -> ctxt { ctxtLocations = locations `snoc` v }-      TknVN vn -> do-        normals <- gets ctxtNormals-        modify $ \ctxt -> ctxt { ctxtNormals = normals `snoc` vn }-      TknVT vt -> do-        texCoords <- gets ctxtTexCoords-        modify $ \ctxt -> ctxt { ctxtTexCoords = texCoords `snoc` vt }-      TknP p -> do-        (pts,element) <- prepareElement ctxtPoints-        modify $ \ctxt -> ctxt { ctxtPoints = pts `append` fmap element (fromList p) }-      TknL l -> do-        (lns,element) <- prepareElement ctxtLines-        modify $ \ctxt -> ctxt { ctxtLines = lns `append` fmap element (fromList l) }-      TknF f -> do-        (fcs,element) <- prepareElement ctxtFaces-        modify $ \ctxt -> ctxt { ctxtFaces = fcs `append` fmap element (fromList f) }-      TknG g -> modify $ \ctxt -> ctxt { ctxtCurrentGroups = g }-      TknO o -> modify $ \ctxt -> ctxt { ctxtCurrentObject = Just o }-      TknMtlLib l -> do-        libs <- gets ctxtMtlLibs-        modify $ \ctxt -> ctxt { ctxtMtlLibs = libs `append` fromList l }-      TknUseMtl mtl -> modify $ \ctxt -> ctxt { ctxtCurrentMtl = Just mtl }---- Prepare to create a new 'Element' by retrieving its associated list.-prepareElement :: (Ctxt -> DList (Element a)) -> State Ctxt (DList (Element a),a -> Element a)-prepareElement field = do-  (aList,obj,grp,mtl) <- gets $ (\ctxt -> (field ctxt,ctxtCurrentObject ctxt,ctxtCurrentGroups ctxt,ctxtCurrentMtl ctxt))-  pure (aList,Element obj grp mtl)+fromDList :: DList a -> Vector a+fromDList = fromList . toList

@@ -1,5 +1,5 @@ name:                wavefront-version:             0.2+version:             0.3 synopsis:            Wavefront OBJ loader description:         A Wavefront OBJ loader. Currently supports polygonal information. More could                      be added if needed (like curves and surface) if people contribute. Feel free@@ -25,6 +25,7 @@   ghc-options:         -W -Wall    exposed-modules:     Codec.Wavefront+                     , Codec.Wavefront.Element                      , Codec.Wavefront.Face                      , Codec.Wavefront.IO                      , Codec.Wavefront.Line@@ -35,6 +36,7 @@                      , Codec.Wavefront.TexCoord    other-modules:       Codec.Wavefront.Token+                     , Codec.Wavefront.Lexer    default-extensions:  OverloadedStrings @@ -45,6 +47,7 @@                      , mtl          >= 2.2  && < 2.3                      , text         >= 1.2  && < 1.3                      , transformers >= 0.4  && < 0.5+                     , vector       >= 0.11 && < 0.12    hs-source-dirs:      src