diff options
author | Joe Crayne <joe@jerkface.net> | 2019-06-14 20:41:03 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-06-14 20:41:03 -0400 |
commit | 98aa7d7177aaf46171b095bbb28e2f1e868323c5 (patch) | |
tree | b62a6866386ce8199d675a09180583c0b8150b61 /src/Wavefront | |
parent | 913a569f9c5176c436d6abffbba64b7a98cbac86 (diff) |
Reorganizing.
Diffstat (limited to 'src/Wavefront')
-rw-r--r-- | src/Wavefront/Types.hs | 167 |
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 @@ | |||
1 | {-# LANGUAGE ConstraintKinds #-} | ||
2 | {-# LANGUAGE DeriveFunctor #-} | ||
3 | {-# LANGUAGE FlexibleInstances #-} | ||
4 | {-# LANGUAGE KindSignatures #-} | ||
5 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
6 | {-# LANGUAGE PatternSynonyms #-} | ||
7 | {-# LANGUAGE RankNTypes #-} | ||
8 | {-# LANGUAGE StandaloneDeriving #-} | ||
9 | {-# LANGUAGE UndecidableInstances #-} | ||
10 | module Wavefront.Types where | ||
11 | |||
12 | import Data.Kind | ||
13 | import Data.Text (Text) | ||
14 | import Numeric.Natural | ||
15 | import qualified Rank2 | ||
16 | |||
17 | data OBJ v = OBJ { | ||
18 | objLocations :: v Location | ||
19 | , objTexCoords :: v TexCoord | ||
20 | , objNormals :: v Normal | ||
21 | , objPoints :: v (Element Point) | ||
22 | , objLines :: v (Element Line) | ||
23 | , objFaces :: v (Element Face) | ||
24 | , objMtlLibs :: v Text | ||
25 | } | ||
26 | |||
27 | type ForThisOBJ (c :: * -> Constraint) v = | ||
28 | ( c (v Location) | ||
29 | , c (v TexCoord) | ||
30 | , c (v Normal) | ||
31 | , c (v (Element Point)) | ||
32 | , c (v (Element Line)) | ||
33 | , c (v (Element Face)) | ||
34 | , c (v Text) ) | ||
35 | |||
36 | type ForAllOBJ (c :: * -> Constraint) = | ||
37 | ( c Location | ||
38 | , c TexCoord | ||
39 | , c Normal | ||
40 | , c (Element Point) | ||
41 | , c (Element Line) | ||
42 | , c (Element Face) | ||
43 | , c Text | ||
44 | ) | ||
45 | |||
46 | deriving instance ForThisOBJ Eq v => Eq (OBJ v) | ||
47 | deriving instance ForThisOBJ Show v => Show (OBJ v) | ||
48 | |||
49 | instance Rank2.Functor OBJ where | ||
50 | f <$> obj = obj | ||
51 | { objLocations = f (objLocations obj) | ||
52 | , objTexCoords = f (objTexCoords obj) | ||
53 | , objNormals = f (objNormals obj) | ||
54 | , objPoints = f (objPoints obj) | ||
55 | , objLines = f (objLines obj) | ||
56 | , objFaces = f (objFaces obj) | ||
57 | , objMtlLibs = f (objMtlLibs obj) | ||
58 | } | ||
59 | |||
60 | class Rank2.Functor g => Payload c g where | ||
61 | mapPayload :: proxy c -> (forall a. c a => p a -> q a) -> g p -> g q | ||
62 | |||
63 | instance ForAllOBJ c => Payload c OBJ where | ||
64 | mapPayload _ f obj = obj | ||
65 | { objLocations = f (objLocations obj) | ||
66 | , objTexCoords = f (objTexCoords obj) | ||
67 | , objNormals = f (objNormals obj) | ||
68 | , objPoints = f (objPoints obj) | ||
69 | , objLines = f (objLines obj) | ||
70 | , objFaces = f (objFaces obj) | ||
71 | , objMtlLibs = f (objMtlLibs obj) | ||
72 | } | ||
73 | |||
74 | |||
75 | |||
76 | -- | A location is a 4-floating vector. You can access to its components by | ||
77 | -- pattern matching on them: | ||
78 | -- | ||
79 | -- > let Location x y z w = Location 1 2 3 4 | ||
80 | -- | ||
81 | -- That type is strict and unboxed. | ||
82 | data Location = Location { | ||
83 | locX :: {-# UNPACK #-} !Float | ||
84 | , locY :: {-# UNPACK #-} !Float | ||
85 | , locZ :: {-# UNPACK #-} !Float | ||
86 | , locW :: {-# UNPACK #-} !Float | ||
87 | } deriving (Eq,Show) | ||
88 | |||
89 | -- | A texture coordinate is a 3D-floating vector. You can access to its | ||
90 | -- components by pattern matching on them: | ||
91 | -- | ||
92 | -- > let TexCoord r s t = TexCoord 0.1 0.2 0.3 | ||
93 | -- | ||
94 | -- That type is strcit and unboxed. | ||
95 | data TexCoord = TexCoord { | ||
96 | texcoordR :: {-# UNPACK #-} !Float | ||
97 | , texcoordS :: {-# UNPACK #-} !Float | ||
98 | , texcoordT :: {-# UNPACK #-} !Float | ||
99 | } deriving (Eq,Show) | ||
100 | |||
101 | |||
102 | -- | A normal is a 3-floating vector. You can access to its components by | ||
103 | -- pattern matching on them: | ||
104 | -- | ||
105 | -- > let Normal nx ny nz = Normal 0.1 0.2 0.3 | ||
106 | -- | ||
107 | -- That type is strict and unboxed. | ||
108 | data Normal = Normal { | ||
109 | norX :: {-# UNPACK #-} !Float | ||
110 | , norY :: {-# UNPACK #-} !Float | ||
111 | , norZ :: {-# UNPACK #-} !Float | ||
112 | } deriving (Eq,Show) | ||
113 | |||
114 | -- | A point is a single index that references the locations. It’s a canonical | ||
115 | -- type that truly represents a polygonal point. | ||
116 | data Point = Point { | ||
117 | pointLocIndex :: {-# UNPACK #-} !Int | ||
118 | } deriving (Eq,Show) | ||
119 | |||
120 | -- | A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references | ||
121 | -- the locations and @vti@ indexes the texture coordinates. If @vti == | ||
122 | -- 'Nothing'@, then that 'LineIndex' doesn’t have texture coordinates | ||
123 | -- associated with. | ||
124 | data LineIndex = LineIndex { | ||
125 | lineLocIndex :: {-# UNPACK #-} !Int | ||
126 | , lineTexCoordIndex :: !(Maybe Int) | ||
127 | } deriving (Eq,Show) | ||
128 | |||
129 | -- | A line gathers two line indices accessible by pattern matching or | ||
130 | -- 'lineIndexA' and 'lineIndexB'. | ||
131 | data Line = Line { | ||
132 | lineIndexA :: LineIndex | ||
133 | , lineIndexB :: LineIndex | ||
134 | } deriving (Eq,Show) | ||
135 | |||
136 | -- | A face index is a triplet of indices. @'FaceIndex' vi vti vni@ is a face | ||
137 | -- that indexes the locations with @vi@, the texture coordinates with @vti@ and | ||
138 | -- the normals with @vni@. An index set to 'Nothing' means /no information/. | ||
139 | -- That is, if @vni == 'Nothing'@, then that 'FaceIndex' doesn’t have a normal | ||
140 | -- associated with. | ||
141 | data FaceIndex = FaceIndex { | ||
142 | faceLocIndex :: {-# UNPACK #-} !Int | ||
143 | , faceTexCoordIndex :: !(Maybe Int) | ||
144 | , faceNorIndex :: !(Maybe Int) | ||
145 | } deriving (Eq,Show) | ||
146 | |||
147 | -- | A face gathers several 'FaceIndex' to build up faces. It has a least three | ||
148 | -- vertices | ||
149 | data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Show) | ||
150 | |||
151 | pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face | ||
152 | pattern Triangle a b c = Face a b c [] | ||
153 | |||
154 | pattern Quad :: FaceIndex -> FaceIndex -> FaceIndex -> FaceIndex -> Face | ||
155 | pattern Quad a b c d = Face a b c [d] | ||
156 | |||
157 | -- | An element holds a value along with the user-defined object’s name (if | ||
158 | -- any), the associated groups, the used material and the smoothing group the | ||
159 | -- element belongs to (if any). Those values can be used to sort the data per | ||
160 | -- object or per group and to lookup materials. | ||
161 | data Element a = Element { | ||
162 | elObject :: Maybe Text | ||
163 | , elGroups :: [Text] | ||
164 | , elMtl :: Maybe Text | ||
165 | , elSmoothingGroup :: Natural | ||
166 | , elValue :: a | ||
167 | } deriving (Eq,Show,Functor) | ||