WaveFront 0.1.0.2 → 0.1.2.0
raw patch · 6 files changed
+51/−48 lines, 6 filesdep +Cartesiandep ~base
Dependencies added: Cartesian
Dependency ranges changed: base
Files
- README.md +11/−8
- WaveFront.cabal +4/−3
- src/Graphics/WaveFront/Load.hs +4/−2
- src/Graphics/WaveFront/Parsers.hs +28/−19
- src/Graphics/WaveFront/Types.hs +0/−5
- src/Graphics/WaveFront/Utilities.hs +4/−11
README.md view
@@ -3,7 +3,7 @@ This is a personal project, still in its infancy, and I don't expect anybody else to use it. Should somehow happen upon this site, I would however welcome their support and feedback. -##Contents +## Contents Wavefront OBJ parsers and related amenities. Includes purely functional parsers and IO utilities for loading models from files. @@ -13,12 +13,15 @@ I may at some point implement the FFI and add direct OpenGL support, in separate modules. -##Maintainers +## Maintainers Jonatan H Sundqvist -##TODO -There is currently no standalone list of tasks (cf. source files). -- Use Parsec instead (branch off) (?) -- Add sample models and demos -- Add profiling and checks -- GHCi support +## TODO + +See source files (.hs) for additional items. + +- [ ] Use Parsec instead (branch off) (?) +- [ ] Add sample models and demos +- [ ] Add profiling and checks +- [ ] GHCi support +- [ ] Proper ticket system
WaveFront.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.2 +version: 0.1.2.0 -- A short (one-line) description of the package. synopsis: Parsers and utilities for the OBJ WaveFront 3D model format @@ -58,13 +58,14 @@ other-extensions: UnicodeSyntax, TupleSections, ForeignFunctionInterface -- Other library packages from which modules are imported. - build-depends: base <= 4.8.1.0, + build-depends: base == 4.*, lens <= 4.13.0.0, OpenGL, GLUtil, linear, filepath, - containers + containers, + Cartesian -- Directories containing source files. hs-source-dirs: src
src/Graphics/WaveFront/Load.hs view
@@ -38,6 +38,8 @@ import Data.Either (rights, isLeft) +import Control.Lens ((^.), _2) + import Graphics.WaveFront.Types import Graphics.WaveFront.Parsers (parseOBJ, parseMTL, createMTLTable, createModel) import Graphics.WaveFront.Utilities @@ -77,13 +79,13 @@ loadMaterials fns = do mtls <- mapM loadMTL fns -- return . createMTLTable . zip (map (snd . splitFileName) fns) . map tokensOf $ mtls -- - where tokensOf = rights . map second + where tokensOf = rights . map (^._2) -- | Loads an OBJ model from file, including associated materials loadModel :: String -> IO Model loadModel fn = do obj <- loadOBJ fn - materials <- loadMaterials [ (fst $ splitFileName fn) </> name | LibMTL name <- rights $ map second obj ] + materials <- loadMaterials [ (fst $ splitFileName fn) </> name | LibMTL name <- rights $ map (^._2) obj ] return $ createModel obj materials -- where loadWithName name = loadMTL name >>= return . (name,)
src/Graphics/WaveFront/Parsers.hs view
@@ -1,13 +1,14 @@ -- | -- Module : Graphics.WaveFront.Parsers --- Description : descr +-- Description : -- Copyright : (c) Jonatan H Sundqvist, February 8 2015 -- License : MIT -- Maintainer : Jonatan H Sundqvist -- Stability : experimental|stable -- Portability : POSIX (not sure) -- --- Created February 8 2015-- Wavefront - Parsers.hs +-- Created February 8 2015 +-- Wavefront - Parsers.hs -- Migrated to separate project on February 21 2015 -- TODO | - Appropriate container types (eg. bytestring, vector) @@ -27,6 +28,8 @@ -- - Caching (?) -- - Performance, profiling, optimisations -- -- Strict or lazy (eg. with Data.Map) (?) +-- -- Multi-threading +-- -- Appropriate container types -- -- - PrintfArg instances for the types defined in this module -- - Reconciling Cabal and hierarchical modules @@ -66,7 +69,8 @@ facesOf, materialsOf, modelAttributes, tessellate, boundingbox, hasTextures, textures, - MTL(), OBJ(), Model(..), Face(..), Material(..), OBJToken(..), MTLToken(..), MTLTable(..), BoundingBox(..), OBJNoParse(..), MTLNoParse(..), + module Graphics.WaveFront.Types, + BoundingBox(..), Vector(..), createModel, createMTLTable) where @@ -74,18 +78,21 @@ -------------------------------------------------------------------------------------------------------------------------------------------- -- We'll need these -------------------------------------------------------------------------------------------------------------------------------------------- -import Data.List (groupBy, unzip4) -import Data.Maybe (listToMaybe, catMaybes) -import Data.Either (rights) -import Data.Char (isSpace) +import Data.List (groupBy, unzip4) +import Data.Maybe (listToMaybe, catMaybes) +import Data.Either (rights) +import Data.Char (isSpace) import qualified Data.Map as Map import qualified Data.Set as Set import Text.Read (readMaybe, readEither) import Control.Monad (liftM) +import Control.Lens hiding (indices) -- import Southpaw.Utilities.Utilities (pairwise, cuts) +import Cartesian.Space.Types (BoundingBox(..), Vector3D(..)) + import Graphics.WaveFront.Types import Graphics.WaveFront.Utilities @@ -130,9 +137,9 @@ parseOBJRow :: String -> (Int -> OBJRow) -- Maybe OBJToken parseOBJRow ln = parseTokenWith ln $ \ line -> let (attr:values) = words line in case (attr:values) of ("f":_:_:_:_) -> either (Left . noparse . const line) (Right . OBJFace) . sequence . map (ivertex . cuts '/') $ values -- Face - ["v", sx, sy, sz] -> vector (\ [x, y, z] -> OBJVertex x y z) [sx, sy, sz] (noparse line) -- Vertex - ["vn", sx, sy, sz] -> vector (\ [x, y, z] -> OBJNormal x y z) [sx, sy, sz] (noparse line) -- Normal - ["vt", sx, sy] -> vector (\ [x, y] -> OBJTexture x y) [sx, sy] (noparse line) -- Texture + ["v", sx, sy, sz] -> vector (\ [x, y, z] -> OBJVertex x y z) [sx, sy, sz] (noparse line) -- Vertex + ["vn", sx, sy, sz] -> vector (\ [x, y, z] -> OBJNormal x y z) [sx, sy, sz] (noparse line) -- Normal + ["vt", sx, sy] -> vector (\ [x, y] -> OBJTexture x y) [sx, sy] (noparse line) -- Texture ("g":_:_) -> Right $ Group values -- Group ("o":_:_) -> Right $ Object values -- Object ("s":_:_) -> Left $ noparse line -- Smooth shading @@ -230,7 +237,7 @@ -- TODO: Default material, take 'error-handling' function (?) -- facesOf :: [OBJToken] -> MTLTable -> [Either String Face] -facesOf tokens table = reverse . third . foldl update ("", "", []) $ tokens +facesOf tokens table = reverse . (^._3) . foldl update ("", "", []) $ tokens where retrieve lib mat = Map.lookup lib table >>= Map.lookup mat createFace lib mat ind = case retrieve lib mat of Nothing -> Left $ "No such material: " ++ lib ++ "." ++ mat @@ -292,7 +299,7 @@ -- I never knew pattern matching in list comprehensions could be used to filter by constructor -- let rows = parseOBJ data in ([ v | @v(Vertex {}) <- rows], [ v | @v(Vertex {}) <- rows]) createModel :: OBJ -> MTLTable -> Model -createModel tokens thematerials = let modeldata = rights $ map second tokens -- TODO: Vat do vee du viz ze dissidents, kommandant? +createModel tokens thematerials = let modeldata = rights $ map (^._2) tokens -- TODO: Vat do vee du viz ze dissidents, kommandant? in Model { vertices = [ (x, y, z) | OBJVertex x y z <- modeldata ], normals = [ (x, y, z) | OBJNormal x y z <- modeldata ], texcoords = [ (x, y) | OBJTexture x y <- modeldata ], @@ -320,7 +327,7 @@ -- TODO: Better names (?) tessellate :: Face -> Face tessellate face@(Face { indices=ind }) = face { indices=triangles ind } - where triangles (a:rest) =concat $ pairwise (\b c -> [a, b, c]) rest + where triangles (a:rest) = concat $ pairwise (\b c -> [a, b, c]) rest -- | @@ -328,13 +335,15 @@ -- | -boundingbox :: Model -> BoundingBox Float -boundingbox model = BoundingBox { left=minx, right=maxx, bottom=miny, top=maxy, front=maxz, back=minz } +-- TODO: Deal with empty vertex lists (?) +-- boundingbox :: (RealFloat n, Ord n) => Model -> BoundingBox (Vector3D n) +boundingbox :: Model -> BoundingBox (Vector3D Float) +boundingbox model = BoundingBox { centreOf=Vector3D (minx+maxx) (miny+maxy) (minz+maxz) * Vector3D 0.5 0 0, sizeOf=Vector3D (maxx-minx) (maxy-miny) (maxz-minz) } where - minmax (v:alues) = foldr (\val acc -> (min val (fst acc), max val (snd acc))) (v, v) alues - (minx, maxx) = minmax . map (\(x, _, _) -> x) $ vertices model - (miny, maxy) = minmax . map (\(_, y, _) -> y) $ vertices model - (minz, maxz) = minmax . map (\(_, _, z) -> z) $ vertices model -- TODO: Make sure the order is right + minmax :: (Ord o) => [o] -> (o, o) + minmax (v:alues) = foldr (\val acc -> (min val (fst acc), max val (snd acc))) (v, v) alues -- TODO: Factor out + + [(minx, maxx), (miny, maxy), (minz, maxz)] = [ minmax . map (^.f) $ vertices model | f <- [_1, _2, _3]] -- TODO: Make sure the order is right -- Model queries ---------------------------------------------------------------------------------------------------------------------------
src/Graphics/WaveFront/Types.hs view
@@ -179,11 +179,6 @@ objects :: Map.Map [String] (Int, Int) -- TODO: Type synonym } deriving (Show) - --- | --- TODO: Use BoundingBox from Cartesian instead -data BoundingBox n = BoundingBox { left :: n, right :: n, top :: n, bottom :: n, front :: n, back :: n } - -- Foreign --------------------------------------------------------------------------------------------------------------------------------- -- |
src/Graphics/WaveFront/Utilities.hs view
@@ -80,7 +80,9 @@ -- TODO: Higher order function for composing predicates rows :: String -> [String] rows = filter (not . satisfiesAny [null, isComment]) . lines - where satisfiesAny ps x = any ($ x) ps + where + satisfiesAny :: [a -> Bool] -> a -> Bool + satisfiesAny ps x = any ($ x) ps -- | @@ -91,16 +93,7 @@ -- TODO: Generic function for mapping and sequencing readEither (cf. "vt" case in parseOBJRow) (?) vector :: Read r => ([r] -> b) -> [String] -> e -> Either e b vector f coords e = either (Left . const e) (Right) (sequence (map readEither coords) >>= Right . f) --- vector _ _ = Left $ "Wrong number of coordinates for vector" - - --- | -second :: (a, b, c) -> b -second (_, b, _) = b - --- | -third :: (a, b, c) -> c -third (_, _, c) = c +-- vector _ _ = Left $ "Wrong number of coordinates for vector" -- From Southpaw ---------------------------------------------------------------------------------------------------------------------------