1 files changed, 167 insertions, 0 deletions

diff --git a/src/Wavefront/Types.hs b/src/Wavefront/Types.hs
new file mode 100644
index 0000000..564f5d5
--- /dev/null
+++ b/src/Wavefront/Types.hs
@@ -0,0 +1,167 @@
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms       #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE UndecidableInstances  #-}
+module Wavefront.Types where
+
+import Data.Kind
+import Data.Text (Text)
+import Numeric.Natural
+import qualified Rank2
+
+data OBJ v = OBJ {
+    objLocations :: v Location
+  , objTexCoords :: v TexCoord
+  , objNormals   :: v Normal
+  , objPoints    :: v (Element Point)
+  , objLines     :: v (Element Line)
+  , objFaces     :: v (Element Face)
+  , objMtlLibs   :: v Text
+  }
+
+type ForThisOBJ (c :: * -> Constraint) v =
+        ( c (v Location)
+        , c (v TexCoord)
+        , c (v Normal)
+        , c (v (Element Point))
+        , c (v (Element Line))
+        , c (v (Element Face))
+        , c (v Text) )
+
+type ForAllOBJ (c :: * -> Constraint) =
+        ( c Location
+        , c TexCoord
+        , c Normal
+        , c (Element Point)
+        , c (Element Line)
+        , c (Element Face)
+        , c Text
+        )
+
+deriving instance ForThisOBJ Eq v => Eq (OBJ v)
+deriving instance ForThisOBJ Show v => Show (OBJ v)
+
+instance Rank2.Functor OBJ where
+    f <$> obj = obj
+        { objLocations = f (objLocations obj)
+        , objTexCoords = f (objTexCoords obj)
+        , objNormals   = f (objNormals obj)
+        , objPoints    = f (objPoints obj)
+        , objLines     = f (objLines obj)
+        , objFaces     = f (objFaces obj)
+        , objMtlLibs   = f (objMtlLibs obj)
+        }
+
+class Rank2.Functor g => Payload c g where
+    mapPayload :: proxy c -> (forall a. c a => p a -> q a) -> g p -> g q
+
+instance ForAllOBJ c => Payload c OBJ where
+    mapPayload _ f obj = obj
+        { objLocations = f (objLocations obj)
+        , objTexCoords = f (objTexCoords obj)
+        , objNormals   = f (objNormals obj)
+        , objPoints    = f (objPoints obj)
+        , objLines     = f (objLines obj)
+        , objFaces     = f (objFaces obj)
+        , objMtlLibs   = f (objMtlLibs obj)
+        }
+
+
+
+-- | A location is a 4-floating vector. You can access to its components by
+-- pattern matching on them:
+--
+-- > let Location x y z w = Location 1 2 3 4
+--
+-- That type is strict and unboxed.
+data Location = Location {
+    locX :: {-# UNPACK #-} !Float
+  , locY :: {-# UNPACK #-} !Float
+  , locZ :: {-# UNPACK #-} !Float
+  , locW :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
+
+-- | A texture coordinate is a 3D-floating vector. You can access to its
+-- components by pattern matching on them:
+--
+-- > let TexCoord r s t = TexCoord 0.1 0.2 0.3
+--
+-- That type is strcit and unboxed.
+data TexCoord = TexCoord {
+    texcoordR :: {-# UNPACK #-} !Float
+  , texcoordS :: {-# UNPACK #-} !Float
+  , texcoordT :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
+
+
+-- | A normal is a 3-floating vector. You can access to its components by
+-- pattern matching on them:
+--
+-- > let Normal nx ny nz = Normal 0.1 0.2 0.3
+--
+-- That type is strict and unboxed.
+data Normal = Normal {
+    norX :: {-# UNPACK #-} !Float
+  , norY :: {-# UNPACK #-} !Float
+  , norZ :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
+
+-- | A point is a single index that references the locations. It’s a canonical
+-- type that truly represents a polygonal point.
+data Point = Point {
+    pointLocIndex :: {-# UNPACK #-} !Int
+  } deriving (Eq,Show)
+
+-- | A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references
+-- the locations and @vti@ indexes the texture coordinates. If @vti ==
+-- 'Nothing'@, then that 'LineIndex' doesn’t have texture coordinates
+-- associated with.
+data LineIndex = LineIndex {
+    lineLocIndex      :: {-# UNPACK #-} !Int
+  , lineTexCoordIndex :: !(Maybe Int)
+  } deriving (Eq,Show)
+
+-- | A line gathers two line indices accessible by pattern matching or
+-- 'lineIndexA' and 'lineIndexB'.
+data Line = Line {
+    lineIndexA :: LineIndex
+  , lineIndexB :: LineIndex
+  } deriving (Eq,Show)
+
+-- | A face index is a triplet of indices. @'FaceIndex' vi vti vni@ is a face
+-- that indexes the locations with @vi@, the texture coordinates with @vti@ and
+-- the normals with @vni@. An index set to 'Nothing' means /no information/.
+-- That is, if @vni == 'Nothing'@, then that 'FaceIndex' doesn’t have a normal
+-- associated with.
+data FaceIndex = FaceIndex {
+    faceLocIndex      :: {-# UNPACK #-} !Int
+  , faceTexCoordIndex :: !(Maybe Int)
+  , faceNorIndex      :: !(Maybe Int)
+  } deriving (Eq,Show)
+
+-- | A face gathers several 'FaceIndex' to build up faces. It has a least three
+-- vertices
+data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Show)
+
+pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face
+pattern Triangle a b c = Face a b c []
+
+pattern Quad :: FaceIndex -> FaceIndex -> FaceIndex -> FaceIndex -> Face
+pattern Quad a b c d = Face a b c [d]
+
+-- | An element holds a value along with the user-defined object’s name (if
+-- any), the associated groups, the used material and the smoothing group the
+-- element belongs to (if any). 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
+  , elSmoothingGroup :: Natural
+  , elValue          :: a
+  } deriving (Eq,Show,Functor)