1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
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,Ord,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,Ord,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,Ord,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,Ord,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,Ord,Show)
-- | A line gathers two line indices accessible by pattern matching or
-- 'lineIndexA' and 'lineIndexB'.
data Line = Line {
lineIndexA :: LineIndex
, lineIndexB :: LineIndex
} deriving (Eq,Ord,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,Ord,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,Ord,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,Ord,Show,Functor)
|
