diff options
author | Joe Crayne <joe@jerkface.net> | 2019-06-17 19:41:06 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-06-17 19:41:06 -0400 |
commit | eb13dbaed4a2e6483870f09dfc4e5a7f743e664f (patch) | |
tree | aee5ee51f3c61a8263bc8e2e742e5d07afada7af | |
parent | 7c729b343a7fa340909caa9424dc68039ded2de7 (diff) |
Ord instances + more exports.
-rw-r--r-- | src/Wavefront.hs | 49 | ||||
-rw-r--r-- | src/Wavefront/Types.hs | 18 |
2 files changed, 42 insertions, 25 deletions
diff --git a/src/Wavefront.hs b/src/Wavefront.hs index 51a0e6b..2131d96 100644 --- a/src/Wavefront.hs +++ b/src/Wavefront.hs | |||
@@ -48,12 +48,15 @@ objBookKeeping builder = (lift Rank2.<$> builder) | |||
48 | , points = \xs -> do | 48 | , points = \xs -> do |
49 | n <- gets objLocations | 49 | n <- gets objLocations |
50 | lift $ points builder $ fixupRef n <$> xs | 50 | lift $ points builder $ fixupRef n <$> xs |
51 | incrementCount objPoints $ \x o -> o { objPoints = x } | ||
51 | , line = \ts -> do | 52 | , line = \ts -> do |
52 | o <- get | 53 | o <- get |
53 | lift $ line builder $ fixupTriple o <$> ts | 54 | lift $ line builder $ fixupTriple o <$> ts |
55 | incrementCount objLines $ \x o -> o { objLines = x } | ||
54 | , face = \ts -> do | 56 | , face = \ts -> do |
55 | o <- get | 57 | o <- get |
56 | lift $ face builder $ fixupTriple o <$> ts | 58 | lift $ face builder $ fixupTriple o <$> ts |
59 | incrementCount objFaces $ \x o -> o { objFaces = x } | ||
57 | } | 60 | } |
58 | 61 | ||
59 | mkv :: [Double] -> Location | 62 | mkv :: [Double] -> Location |
@@ -115,26 +118,40 @@ buildOBJ = nullBuilder | |||
115 | modify $ second $ \e -> e { elSmoothingGroup = fromIntegral x } | 118 | modify $ second $ \e -> e { elSmoothingGroup = fromIntegral x } |
116 | } | 119 | } |
117 | 120 | ||
118 | parse :: L.ByteString -> OBJ Vector | 121 | blankElement :: Element () |
119 | parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj | 122 | blankElement = Element |
120 | where | ||
121 | b = objBookKeeping buildOBJ | ||
122 | ls = OBJ | ||
123 | { objLocations = DList.empty | ||
124 | , objTexCoords = DList.empty | ||
125 | , objNormals = DList.empty | ||
126 | , objPoints = DList.empty | ||
127 | , objLines = DList.empty | ||
128 | , objFaces = DList.empty | ||
129 | , objMtlLibs = DList.empty | ||
130 | } | ||
131 | c = Rank2.fmap (const $ Count 0) ls :: OBJ Count | ||
132 | el = Element | ||
133 | { elObject = Nothing | 123 | { elObject = Nothing |
134 | , elGroups = [] | 124 | , elGroups = [] |
135 | , elMtl = Nothing | 125 | , elMtl = Nothing |
136 | , elSmoothingGroup = 0 | 126 | , elSmoothingGroup = 0 |
137 | , elValue = () | 127 | , elValue = () |
138 | } | 128 | } |
129 | |||
130 | emptyCounts :: OBJ Count | ||
131 | emptyCounts = OBJ | ||
132 | { objLocations = Count 0 | ||
133 | , objTexCoords = Count 0 | ||
134 | , objNormals = Count 0 | ||
135 | , objPoints = Count 0 | ||
136 | , objLines = Count 0 | ||
137 | , objFaces = Count 0 | ||
138 | , objMtlLibs = Count 0 | ||
139 | } | ||
140 | |||
141 | mzeroOBJ :: MonadPlus m => OBJ m | ||
142 | mzeroOBJ = OBJ | ||
143 | { objLocations = mzero | ||
144 | , objTexCoords = mzero | ||
145 | , objNormals = mzero | ||
146 | , objPoints = mzero | ||
147 | , objLines = mzero | ||
148 | , objFaces = mzero | ||
149 | , objMtlLibs = mzero | ||
150 | } | ||
151 | |||
152 | parse :: L.ByteString -> OBJ Vector | ||
153 | parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj | ||
154 | where | ||
155 | b = objBookKeeping buildOBJ | ||
139 | substvars = ObjConfig IntMap.empty | 156 | substvars = ObjConfig IntMap.empty |
140 | (obj,_) = execState (runStateT (parseOBJ b substvars bs) c) (ls,el) | 157 | (obj,_) = execState (runStateT (parseOBJ b substvars bs) emptyCounts) (mzeroOBJ,blankElement) |
diff --git a/src/Wavefront/Types.hs b/src/Wavefront/Types.hs index 564f5d5..2e49ba9 100644 --- a/src/Wavefront/Types.hs +++ b/src/Wavefront/Types.hs | |||
@@ -84,7 +84,7 @@ data Location = Location { | |||
84 | , locY :: {-# UNPACK #-} !Float | 84 | , locY :: {-# UNPACK #-} !Float |
85 | , locZ :: {-# UNPACK #-} !Float | 85 | , locZ :: {-# UNPACK #-} !Float |
86 | , locW :: {-# UNPACK #-} !Float | 86 | , locW :: {-# UNPACK #-} !Float |
87 | } deriving (Eq,Show) | 87 | } deriving (Eq,Ord,Show) |
88 | 88 | ||
89 | -- | A texture coordinate is a 3D-floating vector. You can access to its | 89 | -- | A texture coordinate is a 3D-floating vector. You can access to its |
90 | -- components by pattern matching on them: | 90 | -- components by pattern matching on them: |
@@ -96,7 +96,7 @@ data TexCoord = TexCoord { | |||
96 | texcoordR :: {-# UNPACK #-} !Float | 96 | texcoordR :: {-# UNPACK #-} !Float |
97 | , texcoordS :: {-# UNPACK #-} !Float | 97 | , texcoordS :: {-# UNPACK #-} !Float |
98 | , texcoordT :: {-# UNPACK #-} !Float | 98 | , texcoordT :: {-# UNPACK #-} !Float |
99 | } deriving (Eq,Show) | 99 | } deriving (Eq,Ord,Show) |
100 | 100 | ||
101 | 101 | ||
102 | -- | A normal is a 3-floating vector. You can access to its components by | 102 | -- | A normal is a 3-floating vector. You can access to its components by |
@@ -109,13 +109,13 @@ data Normal = Normal { | |||
109 | norX :: {-# UNPACK #-} !Float | 109 | norX :: {-# UNPACK #-} !Float |
110 | , norY :: {-# UNPACK #-} !Float | 110 | , norY :: {-# UNPACK #-} !Float |
111 | , norZ :: {-# UNPACK #-} !Float | 111 | , norZ :: {-# UNPACK #-} !Float |
112 | } deriving (Eq,Show) | 112 | } deriving (Eq,Ord,Show) |
113 | 113 | ||
114 | -- | A point is a single index that references the locations. It’s a canonical | 114 | -- | A point is a single index that references the locations. It’s a canonical |
115 | -- type that truly represents a polygonal point. | 115 | -- type that truly represents a polygonal point. |
116 | data Point = Point { | 116 | data Point = Point { |
117 | pointLocIndex :: {-# UNPACK #-} !Int | 117 | pointLocIndex :: {-# UNPACK #-} !Int |
118 | } deriving (Eq,Show) | 118 | } deriving (Eq,Ord,Show) |
119 | 119 | ||
120 | -- | A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references | 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 == | 121 | -- the locations and @vti@ indexes the texture coordinates. If @vti == |
@@ -124,14 +124,14 @@ data Point = Point { | |||
124 | data LineIndex = LineIndex { | 124 | data LineIndex = LineIndex { |
125 | lineLocIndex :: {-# UNPACK #-} !Int | 125 | lineLocIndex :: {-# UNPACK #-} !Int |
126 | , lineTexCoordIndex :: !(Maybe Int) | 126 | , lineTexCoordIndex :: !(Maybe Int) |
127 | } deriving (Eq,Show) | 127 | } deriving (Eq,Ord,Show) |
128 | 128 | ||
129 | -- | A line gathers two line indices accessible by pattern matching or | 129 | -- | A line gathers two line indices accessible by pattern matching or |
130 | -- 'lineIndexA' and 'lineIndexB'. | 130 | -- 'lineIndexA' and 'lineIndexB'. |
131 | data Line = Line { | 131 | data Line = Line { |
132 | lineIndexA :: LineIndex | 132 | lineIndexA :: LineIndex |
133 | , lineIndexB :: LineIndex | 133 | , lineIndexB :: LineIndex |
134 | } deriving (Eq,Show) | 134 | } deriving (Eq,Ord,Show) |
135 | 135 | ||
136 | -- | A face index is a triplet of indices. @'FaceIndex' vi vti vni@ is a face | 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 | 137 | -- that indexes the locations with @vi@, the texture coordinates with @vti@ and |
@@ -142,11 +142,11 @@ data FaceIndex = FaceIndex { | |||
142 | faceLocIndex :: {-# UNPACK #-} !Int | 142 | faceLocIndex :: {-# UNPACK #-} !Int |
143 | , faceTexCoordIndex :: !(Maybe Int) | 143 | , faceTexCoordIndex :: !(Maybe Int) |
144 | , faceNorIndex :: !(Maybe Int) | 144 | , faceNorIndex :: !(Maybe Int) |
145 | } deriving (Eq,Show) | 145 | } deriving (Eq,Ord,Show) |
146 | 146 | ||
147 | -- | A face gathers several 'FaceIndex' to build up faces. It has a least three | 147 | -- | A face gathers several 'FaceIndex' to build up faces. It has a least three |
148 | -- vertices | 148 | -- vertices |
149 | data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Show) | 149 | data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Ord,Show) |
150 | 150 | ||
151 | pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face | 151 | pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face |
152 | pattern Triangle a b c = Face a b c [] | 152 | pattern Triangle a b c = Face a b c [] |
@@ -164,4 +164,4 @@ data Element a = Element { | |||
164 | , elMtl :: Maybe Text | 164 | , elMtl :: Maybe Text |
165 | , elSmoothingGroup :: Natural | 165 | , elSmoothingGroup :: Natural |
166 | , elValue :: a | 166 | , elValue :: a |
167 | } deriving (Eq,Show,Functor) | 167 | } deriving (Eq,Ord,Show,Functor) |