40 lines
1.6 KiB
Haskell
40 lines
1.6 KiB
Haskell
module Dodge.WorldLoad (postUniverseLoadSideEffect) where
|
|
|
|
import GLHelp
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Preload.Render
|
|
import Dodge.Data.Universe
|
|
import Graphics.GL.Core45
|
|
import Shader.Data
|
|
import Shader.Parameters
|
|
import Shader.Poke.Floor
|
|
import Foreign.Marshal
|
|
|
|
postUniverseLoadSideEffect :: Universe -> Universe
|
|
postUniverseLoadSideEffect =
|
|
uvIOEffects %~ (\f uv -> postWorldLoad (uv ^. preloadData . renderData) uv >>= f)
|
|
|
|
postWorldLoad :: RenderData -> Universe -> IO Universe
|
|
postWorldLoad rdata cw = do
|
|
let floorbo = rdata ^. floorVBO . vboName
|
|
floorptr = rdata ^. floorVBO . vboPtr
|
|
chbo = rdata ^. chasmVBO . vboName
|
|
chptr = rdata ^. chasmVBO . vboPtr
|
|
glInvalidateBufferData floorbo
|
|
glInvalidateBufferData chbo
|
|
withArray [floorbo,chbo] $ glDeleteBuffers 2
|
|
[newfloorbo,newchbo] <- glCreate glGenBuffers 2
|
|
nfloorvxs <- foldM (pokeTile floorptr) 0 (cw ^. uvWorld . cWorld . cwTiles)
|
|
glBindBufferBase GL_SHADER_STORAGE_BUFFER 8 newfloorbo
|
|
glNamedBufferStorage newfloorbo (fromIntegral $ 8 * nfloorvxs * floatSize) floorptr 0
|
|
nchasmvxs <- foldM (pokeChasm chptr) 0 (cw ^. uvWorld . cWorld . chasms)
|
|
glBindBufferBase GL_SHADER_STORAGE_BUFFER 7 newchbo
|
|
glNamedBufferStorage newchbo (fromIntegral $ 2 * nchasmvxs * floatSize) chptr 0
|
|
checkGLError "during postWorldLoad"
|
|
return $
|
|
cw & uvWorld . cWorld . numberFloorVerxs .~ nfloorvxs
|
|
& uvWorld . cWorld . numberChasmVerxs .~ nchasmvxs
|
|
& preloadData . renderData . floorVBO . vboName .~ newfloorbo
|
|
& preloadData . renderData . chasmVBO . vboName .~ newchbo
|