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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
{-# LANGUAGE LambdaCase, RecordWildCards, DataKinds #-}
module PointPrimitiveRing where
import Control.Monad
import Data.Foldable
import Data.Int
import Data.IORef
import Data.Maybe
import Data.Word
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
;import Data.Vector as V ((!),(//))
import Foreign.C.Types (CPtrdiff)
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import LambdaCube.GL as LC
import LambdaCube.GL.Data -- (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer)
import LambdaCube.GL.Mesh as LC
import LambdaCube.GL.Type
import LambdaCube.IR as LC
import LambdaCube.GL.Util
import LambdaCube.GL.Input.Type
import LambdaCube.GL.Input hiding (createObjectCommands)
-- import Graphics.GL.Core33
import MaskableStream
data Ring = Ring
{ rBufferObject :: Buffer
, rStorage :: GLStorage
, rObject :: Object
, rSize :: IORef CPtrdiff -- Current count of Floats in the ring buffer.
, rBack :: IORef Int -- Where next vector will be added.
, ringCapacity :: CPtrdiff -- Maximum number of floats in buffer.
, rPosition :: AttributeKey (GLVector 3 Float)
}
newRing :: GLStorage -> Int -> IO Ring
newRing storage sz = do
startRef <- newIORef 0
sizeRef <- newIORef 0
gd <- uploadDynamicBuffer sz [Parameter "position" V3F]
let Just k = attributeKey gd "position"
obj <- addToObjectArray storage "Points" [] gd
readIORef (objCommands obj) >>= mapM_ print
-- [[GLSetUniform 0 GLUniform M44F,GLSetVertexAttribArray 0 5 3 5126 0x0000000000000000,GLDrawArrays 0 0 1],[],[],[]]
let bo = streamBuffer $ dStreams gd Map.! "position"
r = Ring
{ rBufferObject = bo
, rStorage = storage
, rObject = obj
, rSize = sizeRef
, rBack = startRef
, ringCapacity = 3 * fromIntegral sz
, rPosition = k
}
updateRingCommands r
return r
updateRingCommands :: Ring -> IO ()
updateRingCommands r = do
back <- fromIntegral <$> readIORef (rBack r)
size <- fmap (fromIntegral . (`div` 3)) $ readIORef $ rSize r
let mask 0 = []
mask cnt = case cnt + back - size of
front | front > cnt -> [(front - cnt,size)]
| otherwise -> [(0,back), (front,cnt - front)]
updateCommands (rStorage r) (rObject r) mask
readIORef (objCommands $ rObject r) >>= mapM_ print
return ()
pushBack :: Ring -> Float -> Float -> Float -> IO ()
pushBack r x y z = do
back <- readIORef $ rBack r
writeIORef (rBack r) (mod (back + 1) (fromIntegral $ ringCapacity r `div` 3))
updateAttributes back $ do
rPosition r @<- V3 x y z -- (fromList [x,y,z] :: Vector Float)
sz <- readIORef (rSize r)
putStrLn $ "pushBack "++show (sz,back,(x,y,z))
when (sz < ringCapacity r) $ do
writeIORef (rSize r) (sz + 3)
updateRingCommands r
updateRingUniforms :: GLStorage -> Ring -> IO ()
updateRingUniforms _ _ = return ()
|
