diff options
author | Joe Crayne <joe@jerkface.net> | 2019-05-14 17:52:40 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-05-14 17:52:40 -0400 |
commit | f5d4a74e9a4b23917b97f48bde529cb21e3ec152 (patch) | |
tree | e46037115608c455b738b864ab2f70cc4162f14c /MeshSketch.hs | |
parent | b24d6672ff055208f6c0a85a01c43d17d8de9226 (diff) |
Factor TEXTURE_BUFFER-based ring buffer into module.
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 46 |
1 files changed, 2 insertions, 44 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs index 9425890..16c8284 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -48,6 +48,7 @@ import LoadMesh | |||
48 | import InfinitePlane | 48 | import InfinitePlane |
49 | import MtlParser (ObjMaterial(..)) | 49 | import MtlParser (ObjMaterial(..)) |
50 | import Matrix | 50 | import Matrix |
51 | import TextureBufferRing | ||
51 | 52 | ||
52 | 53 | ||
53 | prettyDebug :: GL.DebugMessage -> String | 54 | prettyDebug :: GL.DebugMessage -> String |
@@ -139,48 +140,6 @@ mkFullscreenToggle w = do | |||
139 | if b then windowFullscreen w | 140 | if b then windowFullscreen w |
140 | else windowUnfullscreen w | 141 | else windowUnfullscreen w |
141 | 142 | ||
142 | data Ring = Ring | ||
143 | { ringMax :: Int | ||
144 | , ringTexture :: TextureBufferData | ||
145 | , ringStart :: IO Int | ||
146 | , ringSize :: IO Int | ||
147 | , pushBack :: Float -> Float -> Float -> IO () | ||
148 | , popFront :: IO () | ||
149 | } | ||
150 | |||
151 | newRing :: GLStorage -> Int -> IO Ring | ||
152 | newRing storage cnt = do | ||
153 | let ringCapacity = cnt * 3 | ||
154 | tbo <- uploadTextureBufferToGPU ringCapacity | ||
155 | p <- uploadMeshToGPU Mesh | ||
156 | { mAttributes = Map.singleton "position" $ A_Float $ V.fromList | ||
157 | $ replicate ringCapacity 0.0 | ||
158 | , mPrimitive = P_Points | ||
159 | } | ||
160 | obj <- addMeshToObjectArray storage "Points" [] p | ||
161 | LC.updateUniforms storage $ do | ||
162 | "PointBuffer" @= return tbo | ||
163 | rstart <- newIORef 0 | ||
164 | rsize <- newIORef 0 | ||
165 | return Ring | ||
166 | { ringMax = cnt * 3 | ||
167 | , ringTexture = tbo | ||
168 | , ringStart = readIORef rstart | ||
169 | , ringSize = readIORef rsize | ||
170 | , pushBack = \x y z -> do | ||
171 | start <- readIORef rstart | ||
172 | allocaArray 3 $ \ptr -> do | ||
173 | pokeElemOff ptr 0 x | ||
174 | pokeElemOff ptr 1 y | ||
175 | pokeElemOff ptr 2 z | ||
176 | updateTextureBuffer tbo start 3 ptr | ||
177 | writeIORef rstart (mod (start + 3) ringCapacity) | ||
178 | sz <- readIORef rsize | ||
179 | putStrLn $ "pushBack "++show (sz,start,(x,y,z)) | ||
180 | when (sz < ringCapacity) $ do | ||
181 | writeIORef rsize (sz + 3) | ||
182 | , popFront = modifyIORef' rsize $ \s -> if s > 3 then s - 3 else 0 | ||
183 | } | ||
184 | 143 | ||
185 | uploadState :: IsWidget glarea => MeshData -> glarea -> GLStorage -> IO State | 144 | uploadState :: IsWidget glarea => MeshData -> glarea -> GLStorage -> IO State |
186 | uploadState obj glarea storage = do | 145 | uploadState obj glarea storage = do |
@@ -263,8 +222,7 @@ setUniforms gl storage st = do | |||
263 | LC.updateUniforms storage $ do | 222 | LC.updateUniforms storage $ do |
264 | "CameraPosition" @= return (pos :: Vector Float) | 223 | "CameraPosition" @= return (pos :: Vector Float) |
265 | "ViewProjection" @= return (mvp :: Matrix Float) | 224 | "ViewProjection" @= return (mvp :: Matrix Float) |
266 | "PointsStart" @= fmap (fromIntegral :: Int -> Int32) (ringStart $ stRingBuffer st) | 225 | updateRingUniforms storage (stRingBuffer st) |
267 | "PointsMax" @= return (fromIntegral (ringMax $ stRingBuffer st) :: Int32) | ||
268 | 226 | ||
269 | data MeshSketch = MeshSketch | 227 | data MeshSketch = MeshSketch |
270 | { mmWidget :: GLArea | 228 | { mmWidget :: GLArea |