1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
module TextureBufferRing where
import Control.Monad
import Data.Int
import Data.IORef
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
import Foreign.Marshal.Array
import Foreign.Storable
import LambdaCube.GL as LC
import LambdaCube.GL.Data (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer)
import LambdaCube.GL.Mesh as LC
import LambdaCube.IR as LC
data Ring = Ring
{ ringMax :: Int
, ringTexture :: TextureBufferData
, ringStart :: IO Int
, ringSize :: IO Int
, pushBack :: Float -> Float -> Float -> IO ()
, popFront :: IO ()
}
newRing :: GLStorage -> Int -> IO Ring
newRing storage cnt = do
let ringCapacity = cnt * 3
tbo <- uploadTextureBufferToGPU ringCapacity
p <- uploadMeshToGPU Mesh
{ mAttributes = Map.singleton "position" $ A_Float $ V.fromList
$ replicate ringCapacity 0.0
, mPrimitive = P_Points
}
obj <- addMeshToObjectArray storage "Points" [] p
LC.updateUniforms storage $ do
"PointBuffer" @= return tbo
rstart <- newIORef 0
rsize <- newIORef 0
return Ring
{ ringMax = cnt * 3
, ringTexture = tbo
, ringStart = readIORef rstart
, ringSize = readIORef rsize
, pushBack = \x y z -> do
start <- readIORef rstart
allocaArray 3 $ \ptr -> do
pokeElemOff ptr 0 x
pokeElemOff ptr 1 y
pokeElemOff ptr 2 z
updateTextureBuffer tbo start 3 ptr
writeIORef rstart (mod (start + 3) ringCapacity)
sz <- readIORef rsize
putStrLn $ "pushBack "++show (sz,start,(x,y,z))
when (sz < ringCapacity) $ do
writeIORef rsize (sz + 3)
, popFront = modifyIORef' rsize $ \s -> if s > 3 then s - 3 else 0
}
updateRingUniforms storage ring = LC.updateUniforms storage $ do
"PointsStart" @= fmap (fromIntegral :: Int -> Int32) (ringStart ring)
"PointsMax" @= return (fromIntegral (ringMax ring) :: Int32)
|
