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
89
|
{-# LANGUAGE LambdaCase, RecordWildCards #-}
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.
, rStart :: IORef CPtrdiff -- Float-index where next vector will be added. TODO: rename this.
, ringCapacity :: CPtrdiff -- Maximum number of floats in buffer.
}
newRing :: GLStorage -> Int -> IO Ring
newRing storage sz = do
startRef <- newIORef 0
sizeRef <- newIORef 0
gd <- uploadDynamicBuffer sz "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
, rStart = startRef
, ringCapacity = 3 * fromIntegral sz
}
updateRingCommands r
return r
updateRingCommands :: Ring -> IO ()
updateRingCommands r = do
start <- fmap (fromIntegral . (`div` 3)) $ readIORef $ rStart r
size <- fmap (fromIntegral . (`div` 3)) $ readIORef $ rSize r
let mask 0 = []
mask cnt = case cnt + start - size of
st | st > cnt -> [(st - cnt,size)]
| otherwise -> [(0,start), (st,cnt - st)]
updateCommands (rStorage r) (rObject r) mask
readIORef (objCommands $ rObject r) >>= mapM_ print
return ()
pushBack :: Ring -> Float -> Float -> Float -> IO ()
pushBack r x y z = allocaArray 3 $ \ptr -> do
pokeElemOff ptr 0 x
pokeElemOff ptr 1 y
pokeElemOff ptr 2 z
start <- readIORef $ rStart r
writeIORef (rStart r) (mod (start + 3) (ringCapacity r))
incrementalUpdateBuffer (rBufferObject r) (4*start) (4*3) ptr
-- glFlush
-- glFinish
sz <- readIORef (rSize r)
putStrLn $ "pushBack "++show (sz,start,(x,y,z))
when (sz < ringCapacity r) $ do
writeIORef (rSize r) (sz + 3)
updateRingCommands r
updateRingUniforms :: GLStorage -> Ring -> IO ()
updateRingUniforms _ _ = return ()
|
