summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL/Mesh.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL/Mesh.hs')
-rw-r--r--src/LambdaCube/GL/Mesh.hs13
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 (
15import Control.Applicative 15import Control.Applicative
16import Control.Monad 16import Control.Monad
17import Data.Binary 17import Data.Binary
18import Data.ByteString.Char8 (ByteString)
19import Foreign.Ptr 18import Foreign.Ptr
20import Data.Int 19import Data.Int
21import Foreign.Storable 20import Foreign.Storable
@@ -23,10 +22,10 @@ import Foreign.Marshal.Utils
23import System.IO.Unsafe 22import System.IO.Unsafe
24import Data.Map (Map) 23import Data.Map (Map)
25import qualified Data.Map as Map 24import qualified Data.Map as Map
26import qualified Data.ByteString.Char8 as SB
27import qualified Data.ByteString.Lazy as LB
28import qualified Data.Vector.Storable as V 25import qualified Data.Vector.Storable as V
29import qualified Data.Vector.Storable.Mutable as MV 26import qualified Data.Vector.Storable.Mutable as MV
27import qualified Data.ByteString.Char8 as SB
28import qualified Data.ByteString.Lazy as LB
30 29
31import LambdaCube.GL 30import LambdaCube.GL
32import LambdaCube.GL.Type as T 31import LambdaCube.GL.Type as T
@@ -56,7 +55,7 @@ data MeshPrimitive
56 55
57data Mesh 56data 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
64data GPUData 63data 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
77saveMesh :: String -> Mesh -> IO () 76saveMesh :: String -> Mesh -> IO ()
78saveMesh n m = LB.writeFile n (encode m) 77saveMesh n m = LB.writeFile n (encode m)
79 78
80addMeshToObjectArray :: GLStorage -> ByteString -> [ByteString] -> Mesh -> IO Object 79addMeshToObjectArray :: GLStorage -> String -> [String] -> Mesh -> IO Object
81addMeshToObjectArray input slotName objUniNames (Mesh _ _ (Just (GPUData prim streams indices))) = do 80addMeshToObjectArray 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)
109meshAttrToStream b i (A_Int v) = Stream Attribute_Int b i 0 (V.length v) 108meshAttrToStream b i (A_Int v) = Stream Attribute_Int b i 0 (V.length v)
110meshAttrToStream b i (A_Word v) = Stream Attribute_Word b i 0 (V.length v) 109meshAttrToStream b i (A_Word v) = Stream Attribute_Word b i 0 (V.length v)
111 110
112updateMesh :: Mesh -> [(ByteString,MeshAttribute)] -> Maybe MeshPrimitive -> IO () 111updateMesh :: Mesh -> [(String,MeshAttribute)] -> Maybe MeshPrimitive -> IO ()
113updateMesh (Mesh dMA dMP (Just (GPUData _ dS dI))) al mp = do 112updateMesh (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