diff options
-rw-r--r-- | src/Wavefront.hs | 27 | ||||
-rw-r--r-- | src/Wavefront/Types.hs (renamed from src/Data/Wavefront.hs) | 16 | ||||
-rw-r--r-- | wavefront-obj.cabal | 2 |
3 files changed, 24 insertions, 21 deletions
diff --git a/src/Wavefront.hs b/src/Wavefront.hs index 6195eee..1fc8ec3 100644 --- a/src/Wavefront.hs +++ b/src/Wavefront.hs | |||
@@ -1,7 +1,7 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | 1 | {-# LANGUAGE FlexibleContexts #-} |
2 | module Wavefront where | 2 | module Wavefront where |
3 | 3 | ||
4 | import Data.Wavefront | 4 | import Wavefront.Types |
5 | import Wavefront.Lex | 5 | import Wavefront.Lex |
6 | 6 | ||
7 | import Control.Arrow | 7 | import Control.Arrow |
@@ -16,10 +16,13 @@ import qualified Data.Vector as Vector | |||
16 | ;import Data.Vector (Vector) | 16 | ;import Data.Vector (Vector) |
17 | import qualified Rank2 | 17 | import qualified Rank2 |
18 | 18 | ||
19 | type WavefrontOBJ = OBJ Vector | ||
20 | |||
19 | newtype Count x = Count Int | 21 | newtype Count x = Count Int |
20 | 22 | ||
21 | updateCount :: MonadState s m => (s -> Count x) -> (Count x -> s -> s) -> m () | 23 | |
22 | updateCount field setField = do | 24 | incrementCount :: MonadState s m => (s -> Count x) -> (Count x -> s -> s) -> m () |
25 | incrementCount field setField = do | ||
23 | Count c0 <- gets field | 26 | Count c0 <- gets field |
24 | let c = succ c0 | 27 | let c = succ c0 |
25 | c `seq` modify (setField $ Count c) | 28 | c `seq` modify (setField $ Count c) |
@@ -28,20 +31,20 @@ fixupRef :: Count x -> Int -> Int | |||
28 | fixupRef (Count n) x | x > 0 = x - 1 -- Renumber from 0. | 31 | fixupRef (Count n) x | x > 0 = x - 1 -- Renumber from 0. |
29 | | otherwise = n + x -- Negative values are relative. | 32 | | otherwise = n + x -- Negative values are relative. |
30 | 33 | ||
31 | fixupTriple :: WavefrontOBJ Count -> RefTriple -> RefTriple | 34 | fixupTriple :: OBJ Count -> RefTriple -> RefTriple |
32 | fixupTriple o (RefTriple v t n) = | 35 | fixupTriple o (RefTriple v t n) = |
33 | RefTriple (fixupRef (objLocations o) v) | 36 | RefTriple (fixupRef (objLocations o) v) |
34 | (fixupRef (objTexCoords o) <$> t) | 37 | (fixupRef (objTexCoords o) <$> t) |
35 | (fixupRef (objNormals o) <$> n) | 38 | (fixupRef (objNormals o) <$> n) |
36 | 39 | ||
37 | objBookKeeping :: Monad m => ObjBuilder m -> ObjBuilder (StateT (WavefrontOBJ Count) m) | 40 | objBookKeeping :: Monad m => ObjBuilder m -> ObjBuilder (StateT (OBJ Count) m) |
38 | objBookKeeping builder = (lift Rank2.<$> builder) | 41 | objBookKeeping builder = (lift Rank2.<$> builder) |
39 | { vertex = \xs -> do lift $ vertex builder xs | 42 | { vertex = \xs -> do lift $ vertex builder xs |
40 | updateCount objLocations $ \x o -> o { objLocations = x } | 43 | incrementCount objLocations $ \x o -> o { objLocations = x } |
41 | , vertexT = \xs -> do lift $ vertexT builder xs | 44 | , vertexT = \xs -> do lift $ vertexT builder xs |
42 | updateCount objTexCoords $ \x o -> o { objTexCoords = x } | 45 | incrementCount objTexCoords $ \x o -> o { objTexCoords = x } |
43 | , vertexN = \xs -> do lift $ vertexN builder xs | 46 | , vertexN = \xs -> do lift $ vertexN builder xs |
44 | updateCount objNormals $ \x o -> o { objNormals = x } | 47 | incrementCount objNormals $ \x o -> o { objNormals = x } |
45 | , points = \xs -> do | 48 | , points = \xs -> do |
46 | n <- gets objLocations | 49 | n <- gets objLocations |
47 | lift $ points builder $ fixupRef n <$> xs | 50 | lift $ points builder $ fixupRef n <$> xs |
@@ -75,7 +78,7 @@ elemental element x = fmap (const x) element | |||
75 | modifyFirst :: MonadState (c, d) m => (c -> c) -> m () | 78 | modifyFirst :: MonadState (c, d) m => (c -> c) -> m () |
76 | modifyFirst = modify' . first | 79 | modifyFirst = modify' . first |
77 | 80 | ||
78 | buildOBJ :: ObjBuilder (State (WavefrontOBJ DList,Element ())) | 81 | buildOBJ :: ObjBuilder (State (OBJ DList,Element ())) |
79 | buildOBJ = (nullBuilder $ pure ()) | 82 | buildOBJ = (nullBuilder $ pure ()) |
80 | { vertex = \xs -> modifyFirst $ \o -> o { objLocations = objLocations o `DList.snoc` mkv xs } | 83 | { vertex = \xs -> modifyFirst $ \o -> o { objLocations = objLocations o `DList.snoc` mkv xs } |
81 | , vertexT = \xs -> modifyFirst $ \o -> o { objTexCoords = objTexCoords o `DList.snoc` mkt xs } | 84 | , vertexT = \xs -> modifyFirst $ \o -> o { objTexCoords = objTexCoords o `DList.snoc` mkt xs } |
@@ -112,11 +115,11 @@ buildOBJ = (nullBuilder $ pure ()) | |||
112 | modify $ second $ \e -> e { elSmoothingGroup = fromIntegral x } | 115 | modify $ second $ \e -> e { elSmoothingGroup = fromIntegral x } |
113 | } | 116 | } |
114 | 117 | ||
115 | parse :: L.ByteString -> WavefrontOBJ Vector | 118 | parse :: L.ByteString -> OBJ Vector |
116 | parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj | 119 | parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj |
117 | where | 120 | where |
118 | b = objBookKeeping buildOBJ | 121 | b = objBookKeeping buildOBJ |
119 | ls = WavefrontOBJ | 122 | ls = OBJ |
120 | { objLocations = DList.empty | 123 | { objLocations = DList.empty |
121 | , objTexCoords = DList.empty | 124 | , objTexCoords = DList.empty |
122 | , objNormals = DList.empty | 125 | , objNormals = DList.empty |
@@ -125,7 +128,7 @@ parse bs = Rank2.fmap (Vector.fromList . DList.toList) obj | |||
125 | , objFaces = DList.empty | 128 | , objFaces = DList.empty |
126 | , objMtlLibs = DList.empty | 129 | , objMtlLibs = DList.empty |
127 | } | 130 | } |
128 | c = Rank2.fmap (const $ Count 0) ls :: WavefrontOBJ Count | 131 | c = Rank2.fmap (const $ Count 0) ls :: OBJ Count |
129 | el = Element | 132 | el = Element |
130 | { elObject = Nothing | 133 | { elObject = Nothing |
131 | , elGroups = [] | 134 | , elGroups = [] |
diff --git a/src/Data/Wavefront.hs b/src/Wavefront/Types.hs index 2284d38..564f5d5 100644 --- a/src/Data/Wavefront.hs +++ b/src/Wavefront/Types.hs | |||
@@ -7,14 +7,14 @@ | |||
7 | {-# LANGUAGE RankNTypes #-} | 7 | {-# LANGUAGE RankNTypes #-} |
8 | {-# LANGUAGE StandaloneDeriving #-} | 8 | {-# LANGUAGE StandaloneDeriving #-} |
9 | {-# LANGUAGE UndecidableInstances #-} | 9 | {-# LANGUAGE UndecidableInstances #-} |
10 | module Data.Wavefront where | 10 | module Wavefront.Types where |
11 | 11 | ||
12 | import Data.Kind | 12 | import Data.Kind |
13 | import Data.Text (Text) | 13 | import Data.Text (Text) |
14 | import Numeric.Natural | 14 | import Numeric.Natural |
15 | import qualified Rank2 | 15 | import qualified Rank2 |
16 | 16 | ||
17 | data WavefrontOBJ v = WavefrontOBJ { | 17 | data OBJ v = OBJ { |
18 | objLocations :: v Location | 18 | objLocations :: v Location |
19 | , objTexCoords :: v TexCoord | 19 | , objTexCoords :: v TexCoord |
20 | , objNormals :: v Normal | 20 | , objNormals :: v Normal |
@@ -24,7 +24,7 @@ data WavefrontOBJ v = WavefrontOBJ { | |||
24 | , objMtlLibs :: v Text | 24 | , objMtlLibs :: v Text |
25 | } | 25 | } |
26 | 26 | ||
27 | type ForThisWavefrontOBJ (c :: * -> Constraint) v = | 27 | type ForThisOBJ (c :: * -> Constraint) v = |
28 | ( c (v Location) | 28 | ( c (v Location) |
29 | , c (v TexCoord) | 29 | , c (v TexCoord) |
30 | , c (v Normal) | 30 | , c (v Normal) |
@@ -33,7 +33,7 @@ type ForThisWavefrontOBJ (c :: * -> Constraint) v = | |||
33 | , c (v (Element Face)) | 33 | , c (v (Element Face)) |
34 | , c (v Text) ) | 34 | , c (v Text) ) |
35 | 35 | ||
36 | type ForAllWavefrontOBJ (c :: * -> Constraint) = | 36 | type ForAllOBJ (c :: * -> Constraint) = |
37 | ( c Location | 37 | ( c Location |
38 | , c TexCoord | 38 | , c TexCoord |
39 | , c Normal | 39 | , c Normal |
@@ -43,10 +43,10 @@ type ForAllWavefrontOBJ (c :: * -> Constraint) = | |||
43 | , c Text | 43 | , c Text |
44 | ) | 44 | ) |
45 | 45 | ||
46 | deriving instance ForThisWavefrontOBJ Eq v => Eq (WavefrontOBJ v) | 46 | deriving instance ForThisOBJ Eq v => Eq (OBJ v) |
47 | deriving instance ForThisWavefrontOBJ Show v => Show (WavefrontOBJ v) | 47 | deriving instance ForThisOBJ Show v => Show (OBJ v) |
48 | 48 | ||
49 | instance Rank2.Functor WavefrontOBJ where | 49 | instance Rank2.Functor OBJ where |
50 | f <$> obj = obj | 50 | f <$> obj = obj |
51 | { objLocations = f (objLocations obj) | 51 | { objLocations = f (objLocations obj) |
52 | , objTexCoords = f (objTexCoords obj) | 52 | , objTexCoords = f (objTexCoords obj) |
@@ -60,7 +60,7 @@ instance Rank2.Functor WavefrontOBJ where | |||
60 | class Rank2.Functor g => Payload c g where | 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 | 61 | mapPayload :: proxy c -> (forall a. c a => p a -> q a) -> g p -> g q |
62 | 62 | ||
63 | instance ForAllWavefrontOBJ c => Payload c WavefrontOBJ where | 63 | instance ForAllOBJ c => Payload c OBJ where |
64 | mapPayload _ f obj = obj | 64 | mapPayload _ f obj = obj |
65 | { objLocations = f (objLocations obj) | 65 | { objLocations = f (objLocations obj) |
66 | , objTexCoords = f (objTexCoords obj) | 66 | , objTexCoords = f (objTexCoords obj) |
diff --git a/wavefront-obj.cabal b/wavefront-obj.cabal index d4df055..5baa231 100644 --- a/wavefront-obj.cabal +++ b/wavefront-obj.cabal | |||
@@ -15,7 +15,7 @@ extra-source-files: CHANGELOG.md | |||
15 | 15 | ||
16 | library | 16 | library |
17 | exposed-modules: Wavefront.Lex | 17 | exposed-modules: Wavefront.Lex |
18 | , Data.Wavefront | 18 | , Wavefront.Types |
19 | , Wavefront | 19 | , Wavefront |
20 | -- other-modules: | 20 | -- other-modules: |
21 | other-extensions: ConstraintKinds | 21 | other-extensions: ConstraintKinds |