-- | -- Module : Graphics.WaveFront.Types -- Description : -- Copyright : (c) Jonatan H Sundqvist, 2015 -- License : MIT -- Maintainer : Jonatan H Sundqvist -- Stability : experimental|stable -- Portability : POSIX (not sure) -- -- Created October 30 2015 -- TODO | - -- - -- SPEC | - -- - -------------------------------------------------------------------------------------------------------------------------------------------- -- GHC Pragmas -------------------------------------------------------------------------------------------------------------------------------------------- {-# LANGUAGE DuplicateRecordFields #-} -- I love GHC 8.0 {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DeriveFoldable #-} -------------------------------------------------------------------------------------------------------------------------------------------- -- API -------------------------------------------------------------------------------------------------------------------------------------------- module Graphics.WaveFront.Types where -------------------------------------------------------------------------------------------------------------------------------------------- -- We'll need these -------------------------------------------------------------------------------------------------------------------------------------------- import Data.Functor.Classes (Show1) --Eq1, Show1, showsPrec1, eq1) import Data.Map as M import Data.Set as S (Set) import Linear (V2(..), V3(..)) -------------------------------------------------------------------------------------------------------------------------------------------- -- Types -------------------------------------------------------------------------------------------------------------------------------------------- -- OBJ parser types ------------------------------------------------------------------------------------------------------------------------ -- TODO | - Add strictness annotations (?) -- | Represents a single (valid) OBJ token -- -- TODO | - Polymorphic numerical types (?) -- - Add context, metadata (eg. line numbers, filename) (?) -- - Naming scheme (added OBJ prefix to prevent name clashes; cf. Face type) -- - Comment token (preserve comments in parser output or remove them) (?) -- -- - Cover the entire spec (http://www.martinreddy.net/gfx/3d/OBJ.spec) -- (and handle unimplemented attributes gracefully) data OBJToken f s i m = OBJVertex (V3 f) | OBJNormal (V3 f) | OBJTexCoord (V2 f) | OBJFace (m (VertexIndices i)) | -- TODO: Associate material with each face, handle absent indices Line i i | -- Line (I'm assuming the arguments are indices to the endpoint vertices) UseMTL s | -- TODO: Rename (eg. 'UseMaterial') (?) LibMTL s | -- SmoothShading Bool | -- s -- TODO: Use OBJ prefix (?) Group (Set s) | -- TODO: Do grouped faces have to be consecutive? Object (Set s) -- TODO: What is the difference between group and object? -- deriving (Show, Eq) -- TODO: Derive Read (?) -- | -- TODO: Rename (?) -- TODO: Use union instead of Maybe (?) data VertexIndices i = VertexIndices { fIvertex :: i, fItexcoord :: Maybe i, fInormal :: Maybe i } deriving (Show, Eq) -- | Output type of the OBJ parser. -- -- TODO | - Rename (?) -- - Use Integral for line number (?) -- type OBJ f s i m = m (OBJToken f s i m) -- MTL parser types ------------------------------------------------------------------------------------------------------------------------ -- | Represents a single (valid) MTL token -- -- TODO | - Is the alpha channel optional, ignored, disallowed? -- - Include support for ('Ns', 'Ni', 'd', 'Tr', 'illum') -- - Assume no colours have an alpha channel, since transparency is handled by the 'd' attribute (?) data MTLToken f s = Ambient (Colour f) | -- Ka Diffuse (Colour f) | -- Kd Specular (Colour f) | -- Ks SpecularExponent f | -- Ns (TODO: Find out exactly what this entails) Illum Illumination | -- illum (TODO: Find out what this means) Dissolve f | -- d (Dissolve; transparency) Refraction f | -- Ni (Index of refraction; optical_density) MapDiffuse s | -- map_Kd MapAmbient s | -- map_Ka NewMaterial s -- newmtl deriving (Show, Eq) -- | -- 0. Color on and Ambient off -- 1. Color on and Ambient on -- 2. Highlight on -- 3. Reflection on and Ray trace on -- 4. Transparency: Glass on, Reflection: Ray trace on -- 5. Reflection: Fresnel on and Ray trace on -- 6. Transparency: Refraction on, Reflection: Fresnel off and Ray trace on -- 7. Transparency: Refraction on, Reflection: Fresnel on and Ray trace on -- 8. Reflection on and Ray trace off -- 9. Transparency: Glass on, Reflection: Ray trace off -- 10. Casts shadows onto invisible surfaces type Illumination = Int -- | Output type of the MTL parser. Currently a list of line number and token (or error string) pairs -- TODO | - Add type for processed MTL (eg. a map between names and materials) type MTL f s m = m (MTLToken f s) -- (line number, MTL token, comment) -- | type MTLTable f s = M.Map s (M.Map s (Material f s)) -- Model ----------------------------------------------------------------------------------------------------------------------------------- type Vertices f m = m (V3 f) type TexCoords f m = m (Maybe (V2 f)) type Normals f m = m (Maybe (V3 f)) type Materials f s m = m (Material f s) -- API types ------------------------------------------------------------------------------------------------------------------------------- -- | -- TODO | - Validation (eg. length ivertices == length == ivertices == length itextures if length isn't 0) -- - Pack indices in a tuple (eg. indices :: [(Int, Int, Int)]) (?) -- - Use (String, String) for the names of the mtl file and material instead of Material (?) -- - Use types so as not to confuse the indices (eg. newtype INormal, newtype ITexcoord) data Face f s i m = Face { fIndices :: m (VertexIndices i), fMaterial :: Material f s } --deriving (Show, Eq) -- | -- TODO | - Use a type from the colour package instead (?) data Colour f = Colour { fRed :: f, fGreen :: f, fBlue :: f, fAlpha :: f } deriving (Show, Eq, Functor, Foldable) -- | -- TODO | - Do all materials have an ambient, a diffuse and a specular colour (?) -- - Support more attributes (entire spec) (?) -- - Lenses (?) data Material f s = Material { fAmbient :: Colour f, fDiffuse :: Colour f, fSpecular :: Colour f, fTexture :: Maybe s } deriving (Show, Eq) -- | Abstract representation of an OBJ model with associated MTL definitions. -- -- TODO | - Rename (?) -- - Include metadata, comments, rejected data (?) -- - Separate type for processed OBJTokens (ie. token + context) -- - Perform index lookups (?) -- - Reconsider the types (especially of the materials) -- - Rename accessor functions (eg. texcoords instead of textures) (?) -- -- fTextures :: Set s, -- data Model f s i m = Model { data Model f s i m = Model { fVertices :: m (V3 f), fNormals :: m (V3 f), fTexcoords :: m (V2 f), fFaces :: m (Face f s i m), fMaterials :: MTLTable f s, -- TODO: Type synonym (?) fGroups :: M.Map (Set s) (i, i), -- TODO: Type synonym fObjects :: M.Map (Set s) (i, i), -- TODO: Type synonym fRoot :: Maybe FilePath -- This is where we should look for related assets } -- deriving (Show, Eq) -- Monomorphic defaults -------------------------------------------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------------------------------------------------------- -- TODO: Use Show1, Eq1, etc. (?) -- deriving instance (Show1 m) => Show1 (m a) -- deriving instance (Show1 m) => Show1 (m a) -- deriving instance (Show1 m) => Show1 (m a) -- TODO: Clean this up -- showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS deriving instance (Show1 m, Show (m f), Show (m (V2 f)), Show (m (V3 f)), Show (m (Face f s i m)), Show (m s), Show f, Show s, Show i) => Show (Model f s i m) -- where showsPrec = showsPrec1 deriving instance (Show1 m, Show (m f), Show (m (VertexIndices i)), Show (m (V3 f)), Show (m s), Show f, Show s, Show i) => Show (Face f s i m) -- where showsPrec = _ deriving instance (Show1 m, Show (m f), Show (m (VertexIndices i)), Show (m (V3 f)), Show (m s), Show f, Show s, Show i) => Show (OBJToken f s i m) -- where showsPrec = _