Continue adding mutability
This commit is contained in:
+9
-8
@@ -26,6 +26,7 @@ import qualified Data.IntMap.Strict as IM
|
||||
import qualified SDL
|
||||
import qualified Data.Vector.Unboxed.Mutable as UMV
|
||||
import qualified Data.Vector.Mutable as MV
|
||||
import Control.Monad.Primitive
|
||||
|
||||
divideSize :: Int -> Size -> Size
|
||||
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
|
||||
@@ -146,15 +147,15 @@ drawTextureOnFramebuffer fs fbo to = do
|
||||
|
||||
pokeBindFoldable
|
||||
:: PicShads VShader
|
||||
-> UMV.MVector (PrimState IO) Int
|
||||
-> [Verx]
|
||||
-> IO (PicShads Int)
|
||||
pokeBindFoldable shads m = do
|
||||
counts <- UMV.replicate 6 0
|
||||
-> IO ()
|
||||
pokeBindFoldable shads counts m = do
|
||||
shadV <- picShadToMV shads
|
||||
pokeVerxs shadV counts m
|
||||
bindShader shadV counts
|
||||
elist <- vToPicShad counts
|
||||
return elist
|
||||
--elist <- vToPicShad counts
|
||||
--return elist
|
||||
|
||||
zeroCounts :: PicShads Int
|
||||
zeroCounts = PicShads 0 0 0 0 0 0
|
||||
@@ -178,10 +179,10 @@ renderFoldable
|
||||
renderFoldable pdata struct = do
|
||||
pokeStartTicks <- SDL.ticks
|
||||
let shads = _pictureShaders pdata
|
||||
count <- pokeBindFoldable shads struct
|
||||
counts <- UMV.replicate 6 0
|
||||
pokeBindFoldable shads counts struct
|
||||
s <- picShadToMV shads
|
||||
c <- picShadToUMV count
|
||||
MV.imapM_ (drawShaderLay' 0 c) s
|
||||
MV.imapM_ (drawShaderLay' 0 counts) s
|
||||
--sequence_ (drawShaderLay 0 <$> shads <*> count)
|
||||
pokeEndTicks <- SDL.ticks
|
||||
return $ pokeEndTicks - pokeStartTicks
|
||||
|
||||
+1
-13
@@ -23,7 +23,7 @@ import Foreign
|
||||
import Control.Monad
|
||||
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
||||
import Graphics.GL.Core43
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
--import Data.Bifunctor
|
||||
--import Text.RawString.QQ
|
||||
--import Linear.Matrix
|
||||
@@ -41,18 +41,6 @@ bindArrayBuffers numVs theVBO = do
|
||||
(fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO))
|
||||
(_vboPtr theVBO)
|
||||
|
||||
bindArrayBuffersLayer :: Int -> Int -> VBO -> IO ()
|
||||
bindArrayBuffersLayer lay numVs theVBO = do
|
||||
bindBuffer ArrayBuffer $= Just (_vbo theVBO)
|
||||
bufferSubData
|
||||
ArrayBuffer
|
||||
WriteToBuffer
|
||||
(fromIntegral $ floatSize * stride * numSubElements * lay)
|
||||
(fromIntegral $ floatSize * numVs * stride)
|
||||
(_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
|
||||
where
|
||||
stride = sum $ _vboAttribSizes theVBO
|
||||
|
||||
bindShaderLayers :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> IO ()
|
||||
bindShaderLayers shads counts = MV.imapM_ f shads
|
||||
where
|
||||
|
||||
@@ -124,19 +124,6 @@ pokePoint3s ptr vals0 = go vals0 0
|
||||
where
|
||||
off i = n*3 + i
|
||||
|
||||
|
||||
vboFromType :: PicShads VBO -> Int -> VBO
|
||||
{-# INLINE vboFromType #-}
|
||||
vboFromType ps sn = case sn of
|
||||
0 -> _psPoly ps
|
||||
1 -> _psPolyz ps
|
||||
2 -> _psBez ps
|
||||
3 -> _psText ps
|
||||
4 -> _psArc ps
|
||||
5 -> _psEll ps
|
||||
_ -> undefined
|
||||
|
||||
|
||||
pokeLayVerxs :: MV.MVector (PrimState IO) VShader
|
||||
-> UMV.MVector (PrimState IO) Int
|
||||
-> [Verx] -> IO (IM.IntMap (PicShads Int))
|
||||
|
||||
Reference in New Issue
Block a user