summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-06-17 19:41:06 -0400
committerJoe Crayne <joe@jerkface.net>2019-06-17 19:41:06 -0400
commiteb13dbaed4a2e6483870f09dfc4e5a7f743e664f (patch)
treeaee5ee51f3c61a8263bc8e2e742e5d07afada7af
parent7c729b343a7fa340909caa9424dc68039ded2de7 (diff)
Ord instances + more exports.
-rw-r--r--src/Wavefront.hs49
-rw-r--r--src/Wavefront/Types.hs18
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
59mkv :: [Double] -> Location 62mkv :: [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
118parse :: L.ByteString -> OBJ Vector 121blankElement :: Element ()
119parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj 122blankElement = 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
130emptyCounts :: OBJ Count
131emptyCounts = 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
141mzeroOBJ :: MonadPlus m => OBJ m
142mzeroOBJ = OBJ
143 { objLocations = mzero
144 , objTexCoords = mzero
145 , objNormals = mzero
146 , objPoints = mzero
147 , objLines = mzero
148 , objFaces = mzero
149 , objMtlLibs = mzero
150 }
151
152parse :: L.ByteString -> OBJ Vector
153parse 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.
116data Point = Point { 116data 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 {
124data LineIndex = LineIndex { 124data 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'.
131data Line = Line { 131data 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
149data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Show) 149data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Ord,Show)
150 150
151pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face 151pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face
152pattern Triangle a b c = Face a b c [] 152pattern 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)