1 files changed, 108 insertions, 0 deletions

diff --git a/src/Graphics/WaveFront/Load.hs b/src/Graphics/WaveFront/Load.hs
new file mode 100644
index 0000000..6d65693
--- /dev/null
+++ b/src/Graphics/WaveFront/Load.hs
@@ -0,0 +1,108 @@
+-- |
+-- Module      : Graphics.WaveFront.Load
+-- Description : Loading (and perhaps writing) OBJ and MTL files
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 26 2015
+
+-- TODO | - Logging
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE UnicodeSyntax #-}
+-- {-# LANGUAGE TupleSections #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- TODO | - Decide on an API
+module Graphics.WaveFront.Load (
+  obj, mtl, materials, model
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import System.FilePath (splitFileName, takeDirectory, (</>))
+
+import           Data.Text (Text)
+import qualified Data.Text    as T
+import qualified Data.Text.IO as T
+import           Data.Vector (Vector)
+
+import Control.Applicative ((<$>))
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Class (lift)
+
+import qualified Data.Attoparsec.Text as Atto
+
+import           Graphics.WaveFront.Types
+import qualified Graphics.WaveFront.Parse as Parse
+import qualified Graphics.WaveFront.Parse.Common as Parse
+import           Graphics.WaveFront.Model (createMTLTable, createModel)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions (IO)
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- Loading data ----------------------------------------------------------------------------------------------------------------------------
+
+-- |
+-- TODO | - Use bytestrings (?)
+--        - Deal with IO and parsing errors
+obj :: (Fractional f, Integral i) => String -> IO (Either String (OBJ f Text i []))
+obj fn = runExceptT $ do
+  lift $ putStrLn $ "Loading obj file: " ++ fn
+  ExceptT $ Atto.parseOnly (Parse.wholeFile Parse.obj) <$> T.readFile fn
+
+
+-- |
+-- TODO | - Use bytestrings (?)
+--        - Merge OBJ and MTL parsers (and plug in format-specific code as needed) (?)
+--        - Deal with IO and parsing errors
+mtl :: (Fractional f) => String -> IO (Either String (MTL f Text []))
+mtl fn = do
+  putStrLn $ "Loading mtl file: " ++ fn
+  Atto.parseOnly (Parse.wholeFile Parse.mtl) <$> T.readFile fn
+
+
+-- |
+-- TODO | - Better names (than 'mtls' and 'fns') (?)
+--        - Refactor, simplify
+--        - Improve path handling (cf. '</>')
+--        - Graceful error handling
+materials :: (Fractional f) => [FilePath] -> IO (Either String (MTLTable f Text))
+materials fns = runExceptT $ do
+  tokens <- mapM (ExceptT . mtl) fns
+  ExceptT . return $ createTableFromMTLs tokens
+  where
+    createTableFromMTLs :: [[MTLToken f Text]] -> Either String (MTLTable f Text)
+    createTableFromMTLs = createMTLTable . zip (map (T.pack . snd . splitFileName) fns)
+
+
+-- | Loads an OBJ model from file, including associated materials
+-- TODO | - Graceful error handling
+model :: (Fractional f, Integral i) => FilePath -> IO (Either String (Model f Text i Vector))
+model fn = runExceptT $ do
+  obj       <- ExceptT $ obj fn
+  materials <- ExceptT $ materials [ fst (splitFileName fn) </> T.unpack name | LibMTL name <- obj ]
+  ExceptT . return $ createModel obj materials (Just $ takeDirectory fn)
+  -- where loadWithName name = mtl name >>= return . (name,)