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 * max 1 nchasmvxs * floatSize) chptr 0
    -- note the max 1, prevents trying to create empty buffer storage
    checkGLError "during postWorldLoad"
    return $
        cw & uvWorld . cWorld . numberFloorVerxs .~ nfloorvxs
            & uvWorld . cWorld . numberChasmVerxs .~ nchasmvxs
            & preloadData . renderData . floorVBO . vboName .~ newfloorbo
            & preloadData . renderData . chasmVBO . vboName .~ newchbo