diff options
Diffstat (limited to 'src/LambdaCube/GL/Mesh.hs')
-rw-r--r-- | src/LambdaCube/GL/Mesh.hs | 13 |
1 files changed, 6 insertions, 7 deletions
diff --git a/src/LambdaCube/GL/Mesh.hs b/src/LambdaCube/GL/Mesh.hs index 553e2e8..f8521dd 100644 --- a/src/LambdaCube/GL/Mesh.hs +++ b/src/LambdaCube/GL/Mesh.hs | |||
@@ -15,7 +15,6 @@ module LambdaCube.GL.Mesh ( | |||
15 | import Control.Applicative | 15 | import Control.Applicative |
16 | import Control.Monad | 16 | import Control.Monad |
17 | import Data.Binary | 17 | import Data.Binary |
18 | import Data.ByteString.Char8 (ByteString) | ||
19 | import Foreign.Ptr | 18 | import Foreign.Ptr |
20 | import Data.Int | 19 | import Data.Int |
21 | import Foreign.Storable | 20 | import Foreign.Storable |
@@ -23,10 +22,10 @@ import Foreign.Marshal.Utils | |||
23 | import System.IO.Unsafe | 22 | import System.IO.Unsafe |
24 | import Data.Map (Map) | 23 | import Data.Map (Map) |
25 | import qualified Data.Map as Map | 24 | import qualified Data.Map as Map |
26 | import qualified Data.ByteString.Char8 as SB | ||
27 | import qualified Data.ByteString.Lazy as LB | ||
28 | import qualified Data.Vector.Storable as V | 25 | import qualified Data.Vector.Storable as V |
29 | import qualified Data.Vector.Storable.Mutable as MV | 26 | import qualified Data.Vector.Storable.Mutable as MV |
27 | import qualified Data.ByteString.Char8 as SB | ||
28 | import qualified Data.ByteString.Lazy as LB | ||
30 | 29 | ||
31 | import LambdaCube.GL | 30 | import LambdaCube.GL |
32 | import LambdaCube.GL.Type as T | 31 | import LambdaCube.GL.Type as T |
@@ -56,7 +55,7 @@ data MeshPrimitive | |||
56 | 55 | ||
57 | data Mesh | 56 | data Mesh |
58 | = Mesh | 57 | = Mesh |
59 | { mAttributes :: Map ByteString MeshAttribute | 58 | { mAttributes :: Map String MeshAttribute |
60 | , mPrimitive :: MeshPrimitive | 59 | , mPrimitive :: MeshPrimitive |
61 | , mGPUData :: Maybe GPUData | 60 | , mGPUData :: Maybe GPUData |
62 | } | 61 | } |
@@ -64,7 +63,7 @@ data Mesh | |||
64 | data GPUData | 63 | data GPUData |
65 | = GPUData | 64 | = GPUData |
66 | { dPrimitive :: Primitive | 65 | { dPrimitive :: Primitive |
67 | , dStreams :: Map ByteString (Stream Buffer) | 66 | , dStreams :: Map String (Stream Buffer) |
68 | , dIndices :: Maybe (IndexStream Buffer) | 67 | , dIndices :: Maybe (IndexStream Buffer) |
69 | } | 68 | } |
70 | 69 | ||
@@ -77,7 +76,7 @@ loadMesh n = uploadMeshToGPU =<< loadMesh' n | |||
77 | saveMesh :: String -> Mesh -> IO () | 76 | saveMesh :: String -> Mesh -> IO () |
78 | saveMesh n m = LB.writeFile n (encode m) | 77 | saveMesh n m = LB.writeFile n (encode m) |
79 | 78 | ||
80 | addMeshToObjectArray :: GLStorage -> ByteString -> [ByteString] -> Mesh -> IO Object | 79 | addMeshToObjectArray :: GLStorage -> String -> [String] -> Mesh -> IO Object |
81 | addMeshToObjectArray input slotName objUniNames (Mesh _ _ (Just (GPUData prim streams indices))) = do | 80 | addMeshToObjectArray input slotName objUniNames (Mesh _ _ (Just (GPUData prim streams indices))) = do |
82 | -- select proper attributes | 81 | -- select proper attributes |
83 | let Just (ObjectArraySchema slotPrim slotStreams) = Map.lookup slotName $! objectArrays $! schema input | 82 | let Just (ObjectArraySchema slotPrim slotStreams) = Map.lookup slotName $! objectArrays $! schema input |
@@ -109,7 +108,7 @@ meshAttrToStream b i (A_M44F v) = Stream Attribute_M44F b i 0 (V.length v) | |||
109 | meshAttrToStream b i (A_Int v) = Stream Attribute_Int b i 0 (V.length v) | 108 | meshAttrToStream b i (A_Int v) = Stream Attribute_Int b i 0 (V.length v) |
110 | meshAttrToStream b i (A_Word v) = Stream Attribute_Word b i 0 (V.length v) | 109 | meshAttrToStream b i (A_Word v) = Stream Attribute_Word b i 0 (V.length v) |
111 | 110 | ||
112 | updateMesh :: Mesh -> [(ByteString,MeshAttribute)] -> Maybe MeshPrimitive -> IO () | 111 | updateMesh :: Mesh -> [(String,MeshAttribute)] -> Maybe MeshPrimitive -> IO () |
113 | updateMesh (Mesh dMA dMP (Just (GPUData _ dS dI))) al mp = do | 112 | updateMesh (Mesh dMA dMP (Just (GPUData _ dS dI))) al mp = do |
114 | -- check type match | 113 | -- check type match |
115 | let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2 | 114 | let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2 |