diff options
author | Joe Crayne <joe@jerkface.net> | 2019-05-19 02:16:30 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-05-19 02:16:30 -0400 |
commit | 04fc039177d49e1f5f57ce0f61216870d4f723ab (patch) | |
tree | 5ed07577fb0e505df057fcb0330a6cc17730451c /MaskableStream.hs | |
parent | b00e114facc43d94aebefa103caa7df61b39d246 (diff) |
Allow multiple attributes for dynamic buffer.
Diffstat (limited to 'MaskableStream.hs')
-rw-r--r-- | MaskableStream.hs | 43 |
1 files changed, 33 insertions, 10 deletions
diff --git a/MaskableStream.hs b/MaskableStream.hs index e6628e6..831a6e2 100644 --- a/MaskableStream.hs +++ b/MaskableStream.hs | |||
@@ -1,4 +1,4 @@ | |||
1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} | 1 | {-# LANGUAGE LambdaCase, RecordWildCards, KindSignatures, GADTs #-} |
2 | 2 | ||
3 | -- TODO: Formulate this module as a patch against lambdacube-gl. | 3 | -- TODO: Formulate this module as a patch against lambdacube-gl. |
4 | 4 | ||
@@ -18,6 +18,10 @@ import Foreign.C.Types (CPtrdiff) | |||
18 | import Foreign.Marshal | 18 | import Foreign.Marshal |
19 | import Foreign.Ptr | 19 | import Foreign.Ptr |
20 | import Foreign.Storable | 20 | import Foreign.Storable |
21 | import Data.Dependent.Sum | ||
22 | import Data.Some | ||
23 | import Data.GADT.Show | ||
24 | import GHC.TypeLits | ||
21 | 25 | ||
22 | import LambdaCube.GL as LC | 26 | import LambdaCube.GL as LC |
23 | import LambdaCube.GL.Data -- (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer) | 27 | import LambdaCube.GL.Data -- (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer) |
@@ -186,23 +190,42 @@ updateCommands input obj mask = do | |||
186 | return obj | 190 | return obj |
187 | 191 | ||
188 | 192 | ||
193 | componentCount :: GLABI c -> Int | ||
194 | componentCount x@(IsGLVector _) = fromIntegral $ natVal $ vectorLength x | ||
195 | componentCount x@(IsGLMatrix _) = let (r,c) = matrixDimensions x | ||
196 | in fromIntegral (natVal r) * fromIntegral (natVal c) | ||
197 | |||
189 | -- TODO: Add flexibility. | 198 | -- TODO: Add flexibility. |
190 | -- Currently this allocates a buffer consisting of a single named vertex attribute that | 199 | -- Currently this allocates a buffer consisting of a single named vertex attribute that |
191 | -- must be of type V3F. | 200 | -- must be of type V3F. |
192 | uploadDynamicBuffer :: Int -> String -> IO GPUData | 201 | uploadDynamicBuffer :: Int -> [Parameter] -> IO GPUData |
193 | uploadDynamicBuffer sz attrname = do | 202 | uploadDynamicBuffer sz params = do |
194 | bo <- alloca $! \pbo -> glGenBuffers 1 pbo >> peek pbo | 203 | bo <- alloca $! \pbo -> glGenBuffers 1 pbo >> peek pbo |
195 | glBindBuffer GL_ARRAY_BUFFER bo | 204 | glBindBuffer GL_ARRAY_BUFFER bo |
196 | let bufsize = 3 * fromIntegral sz | 205 | let (mkstreams, mkarrays) = unzip $ mapMaybe attrInfo params |
197 | byteCount = 4 * bufsize | 206 | attrInfo (Parameter n typ) = do |
198 | glBufferData GL_ARRAY_BUFFER byteCount nullPtr GL_DYNAMIC_DRAW | 207 | atyp <- toStreamType typ |
208 | This tt <- witnessType typ | ||
209 | let abi = glABI tt | ||
210 | cnt = componentCount abi | ||
211 | arrtyp = let go :: GLPointerType typ -> ArrayType | ||
212 | go = \case GLPrimUInt -> ArrWord32 | ||
213 | GLPrimInt -> ArrInt32 | ||
214 | GLPrimFloat -> ArrFloat | ||
215 | in case abi of { IsGLVector p -> go p ; IsGLMatrix p -> go p } | ||
216 | return ( \b i -> (n, Stream atyp b i 0 sz) | ||
217 | , \offset -> ArrayDesc arrtyp (cnt * sz) offset (4 * sz * cnt)) | ||
218 | streams = zipWith ($ buffer) mkstreams [0..] | ||
219 | arrays = foldr mk (const []) mkarrays 0 | ||
220 | where mk f fin offset = let a = f offset | ||
221 | in a : fin (offset + arrSize a) | ||
222 | buffer = Buffer (V.fromList arrays) bo | ||
223 | byteCount = sum $ map arrSize arrays | ||
224 | glBufferData GL_ARRAY_BUFFER (fromIntegral byteCount) nullPtr GL_DYNAMIC_DRAW | ||
199 | glBindBuffer GL_ARRAY_BUFFER 0 | 225 | glBindBuffer GL_ARRAY_BUFFER 0 |
200 | let buffer = Buffer (V.singleton $ ArrayDesc ArrFloat (fromIntegral bufsize) 0 (fromIntegral byteCount)) | 226 | let gd = GPUData PointList (Map.fromList streams) Nothing [buffer] |
201 | bo | ||
202 | gd = GPUData PointList (Map.singleton attrname $ Stream Attribute_V3F buffer 0 0 sz) Nothing [buffer] | ||
203 | return gd | 227 | return gd |
204 | 228 | ||
205 | |||
206 | incrementalUpdateBuffer :: MonadIO m => Buffer -> GLintptr -> GLsizeiptr -> Ptr a -> m () | 229 | incrementalUpdateBuffer :: MonadIO m => Buffer -> GLintptr -> GLsizeiptr -> Ptr a -> m () |
207 | incrementalUpdateBuffer b byteoffset bytecount ptr = do | 230 | incrementalUpdateBuffer b byteoffset bytecount ptr = do |
208 | glBindBuffer GL_ARRAY_BUFFER (bufGLObj b) | 231 | glBindBuffer GL_ARRAY_BUFFER (bufGLObj b) |