-- | Contains the central drawing functions for the dodge loop.
module Dodge.Render (
    doDrawing,
) where

--import qualified Data.Vector as V

import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
import Data.List (sortOn)
import qualified Data.Map.Strict as M
import Data.Preload.Render
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Universe
import Dodge.DownscaleSize
import Dodge.Render.Lights
import Dodge.Render.ShapePicture
import Dodge.Render.Walls
import Foreign
import GLHelp
import Geometry
import Graphics.GL.Core45
import MatrixHelper
import Render
import qualified SDL
import Shader
import Shader.Bind
import Shader.Data
import Shader.Poke
import Shader.Poke.Cloud

doDrawing :: SDL.Window -> RenderData -> Universe -> IO ()
doDrawing window rdata u
    | SDL.ScancodeT `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
    | otherwise = doDrawing' window rdata u

doTestDrawing :: RenderData -> Universe -> IO ()
doTestDrawing _ _ = do
    return ()

doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
doDrawing' win pdata u = do
    --sTicks <- SDL.ticks
    checkGLError
    let w = _uvWorld u
        cfig = _uvConfig u
        rot = w ^. cWorld . camPos . camRot
        camzoom = w ^. cWorld . camPos . camZoom
        trans = w ^. cWorld . camPos . camCenter
        wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
        resFact = resFactorNum $ cfig ^. graphics_resolution_factor
        (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
        lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
        viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
        shadV = _pictureShaders pdata
        nFls = w ^. cWorld . numberFloorVerxs
    -- bind as much data into vbos as feasible at this point
    -- count mutable vectors setup
    layerCounts <- UMV.replicate (numLayers * 6) 0
    -- attempt to poke in parallel
    let (ws, wp) = wallSPics <> worldSPic cfig u
    ((nWins, trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
        MP.bindM3
            (\_ a b -> return (a, b))
            ( pokeLayVerxs
                shadV
                layerCounts
                wp
            )
            ( pokeWallsWindows
                (pdata ^. vboWindows . vboPtr)
                (pdata ^. wallVBO . vboPtr)
                windowPoints
                wallsToPoke
            )
            ( pokeShape
                (_vboPtr $ _vboShapes pdata)
                (_eboPtr $ _shapeEBO pdata)
                (_eboPtr $ _silhouetteEBO pdata)
                (0, 0, 0)
                ws
            )
    (nCloudVs, nCloudIs) <-
        foldM
            (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
            (0, 0)
            (sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
    -- bind wall points, silhouette data, surface geometry
    bufferShaderLayers shadV layerCounts
    mapM_
        (uncurry bufferPokedVBO)
        [ (pdata ^. vboWindows, nWins)
        , (pdata ^. wallVBO, trueNWalls)
        , (_vboShapes pdata, nShapeVs)
        , (pdata ^. cloudVBO, nCloudVs)
        ]
    mapM_
        (uncurry bufferEBO)
        [ (_cloudEBO pdata, nCloudIs)
        , (_shapeEBO pdata, nIndices)
        , (_silhouetteEBO pdata, nSilIndices)
        ]
    -- set the coordinate uniform ready for drawing elements using world coordinates
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
    withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $ \ptr ->
        glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase ._1 . unFBO)
    glDepthMask GL_TRUE
    glDisable GL_BLEND
    glDepthFunc GL_LESS
    with 1 $ \ptr ->
        glClearNamedFramebufferfv
            (pdata ^. fboBase . _1 . unFBO)
            GL_DEPTH
            0
            ptr
    -- draw wall occlusions from the camera's point of view
    unless (debugOn Remove_LOS cfig) $ do
        glUseProgram (pdata ^. lightingWallShadShader . shaderUINT)
        glProgramUniform3f
            (pdata ^. lightingWallShadShader . shaderUINT)
            0
            vfx
            vfy
            20
        glProgramUniform1f
            (pdata ^. lightingWallShadShader . shaderUINT)
            1
            1000
        glBindVertexArray $ pdata ^. lightingWallShadShader . shaderVAO . vaoName
        glDrawArrays
            (_unPrimitiveMode $ pdata ^. lightingWallShadShader . shaderPrimitive)
            0
            (fromIntegral trueNWalls)
    -- clear color and normals
    withArray [0, 0, 0, 1] $ \ptr ->
        glClearNamedFramebufferfv
            (pdata ^. fboBase . _1 . unFBO)
            GL_COLOR
            0
            ptr
    withArray [0, 0, 0, 0] $ \ptr ->
        glClearNamedFramebufferfv
            (pdata ^. fboBase . _1 . unFBO)
            GL_COLOR
            2
            ptr
    --draw walls onto base buffer
    -- maybe cull faces? maybe do this before?
    glEnable GL_CULL_FACE
    glCullFace GL_BACK
    glUseProgram (pdata ^. wallShader . shaderUINT)
    glBindVertexArray $ pdata ^. wallShader . shaderVAO . vaoName
    glDrawArrays
        (_unPrimitiveMode $ pdata ^. wallShader . shaderPrimitive)
        0
        (fromIntegral trueNWalls)
    --draw object pictures onto base buffer (are there any?!)
    renderLayer BottomLayer shadV layerCounts
    --draw object shapes onto base buffer
    let fs = _shapeShader pdata
    glUseProgram (_shaderUINT fs)
    glBindVertexArray $ fs ^. shaderVAO . vaoName
    glDrawElements
        (_unPrimitiveMode $ _shaderPrimitive fs)
        (fromIntegral nIndices)
        GL_UNSIGNED_SHORT
        nullPtr
    --draw floor onto base buffer
    glUseProgram (pdata ^. floorShader . shaderUINT)
    glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
    glDrawArrays
        (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
        0
        (fromIntegral nFls)
    glDisable GL_CULL_FACE
    glEnable GL_BLEND
    --draw lightmap into its own buffer
    createLightMap
        cfig
        (u ^. uvConfig . graphics_object_shadows)
        (fromIntegral trueNWalls)
        nSilIndices
        nIndices
        (pdata ^. fboBase . _2 . _2)
        (pdata ^. fboBase . _2 . _3)
        lightPoints
        pdata
    glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
    --apply lightmap to base buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
    glBindTextureUnit 0 (pdata ^. fboLighting . _2 . unTO)
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    drawShader (_fullscreenShader pdata) 4
    with GL_COLOR_ATTACHMENT0 $ \ptr ->
        glInvalidateNamedFramebufferData
            (pdata ^. fboLighting . _1 . unFBO)
            1
            ptr
    --draw bloom onto bloom buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
    withArray [0, 0, 0, 0] $ \ptr ->
        glClearNamedFramebufferfv
            (pdata ^. fboBloom . _1 . unFBO)
            GL_COLOR
            0
            ptr
    glDepthFunc GL_LESS
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glDepthMask GL_FALSE
    renderLayer BloomNoZWrite shadV layerCounts
    glDepthMask GL_TRUE
    renderLayer BloomLayer shadV layerCounts
    --setup downscale viewport for blurring bloom
    --setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
    setViewportSize (round winx `div` downSize) (round winy `div` downSize)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
    glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO)
    glDisable GL_BLEND
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
    glEnable GL_BLEND
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    --draw clouds onto cloud buffer
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthFunc GL_LEQUAL
    glDepthMask GL_FALSE
    --blendFunc $= (SrcAlphaSaturate,One)
    --blendColor $= Color4 0.5 0.5 0.5 0.5
    --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
    --blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
    --glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
    --glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
        glClearNamedFramebufferfv
            (pdata ^. fboCloud . _1 . unFBO)
            GL_COLOR
            0
            ptr
    --    renderLayer MidLayer shadV layerCounts
    glUseProgram (pdata ^. cloudShader . shaderUINT)
    glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
    glDrawElements
        (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
        (fromIntegral nCloudIs)
        GL_UNSIGNED_SHORT
        nullPtr
    drawShader (_windowShader pdata) nWins
    when (_graphics_cloud_shadows cfig) $ do
        ----render transparency depths
        glDepthMask GL_TRUE
        glDepthFunc GL_ALWAYS
        glDisable GL_BLEND
        withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> glDrawBuffers 3 ptr
        withArray [0, 0, 0, 0] $ \ptr ->
            glClearNamedFramebufferfv
                (pdata ^. fboCloud . _1 . unFBO)
                GL_COLOR
                1
                ptr
        withArray [0, 0, 0, 0] $ \ptr ->
            glClearNamedFramebufferfv
                (pdata ^. fboCloud . _1 . unFBO)
                GL_COLOR
                2
                ptr
        glEnable GL_BLEND
        -- we sum the positions weighted by alpha, and sum the alpha
        glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
        -- and sum the normals weighted by alpha
        glBlendFunci 2 GL_SRC_ALPHA GL_ONE
        glUseProgram (pdata ^. cloudShader . shaderUINT)
        glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
        glDepthMask GL_TRUE
        glDrawElements
            (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
            (fromIntegral nCloudIs)
            GL_UNSIGNED_SHORT
            nullPtr
        drawShader (_windowShader pdata) nWins
        glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
        withArray [0, 0, 0, 0] $ \ptr ->
            glClearNamedFramebufferfv
                (pdata ^. fboPos . _1 . unFBO)
                GL_COLOR
                0
                ptr
        glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
        glDepthMask GL_FALSE
        drawShader (pdata ^. alphaDivideShader) 4
        ----draw lightmap for cloud buffer
        glDepthFunc GL_LESS
        glEnable GL_BLEND
        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        createLightMap
            cfig
            (_graphics_object_shadows $ _uvConfig u)
            (fromIntegral trueNWalls)
            nSilIndices
            nIndices
            (pdata ^. fboPos . _2)
            (pdata ^. fboCloud . _2 . _3)
            lightPoints
            pdata
    glInvalidateBufferData (pdata ^. vboShapes . vboName)
    --apply lightmap to cloud buffer
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthMask GL_FALSE
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glDepthFunc GL_ALWAYS
    glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
    glEnable GL_BLEND
    glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    -- bind base buffer for drawing bloom then clouds
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    --Draw blurred bloom onto base buffer
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE
    glBindTextureUnit 0 (_unTO . snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    --draw shadowed clouds onto base buffer
    glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
    drawShader (_fullscreenShader pdata) 4
    --set viewport for radial distortion
    setViewportSize (round winx) (round winy)
    glDepthFunc GL_ALWAYS
    glBlendFunc GL_ONE GL_ZERO
    -- perform any radial distortion
    -- this is hideous
    case getDistortions cfig w of
        [] -> do
            glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
            glBindFramebuffer GL_FRAMEBUFFER 0
            drawShader (_fullscreenShader pdata) 4
        rds -> do
            let bindDrawDist :: Distortion -> IO ()
                bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
                    pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g]
                    bufferPokedVBO (snd $ _barrelShader pdata) 1
                    drawShader (fst $ _barrelShader pdata) 1
                fboList =
                    take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
                        ++ [FBO 0]
                toList = (pdata ^. fboBase . _2 . _1) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
                bindings = zipWith (>>) (map bindFBO fboList) (map (glBindTextureUnit 1 . _unTO) toList)
            zipWithM_ (>>) bindings $ map bindDrawDist rds
    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    renderLayer DebugLayer shadV layerCounts
    -- draw overlay
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. orthonormalMatUBO)
    renderLayer FixedCoordLayer shadV layerCounts
    SDL.glSwapWindow win

getDistortions :: Configuration -> World -> [Distortion]
getDistortions cfig w 
    | cfig ^. graphics_distortions = w ^. cWorld . lWorld . distortions
    | otherwise = []

setViewportSize :: Int -> Int -> IO ()
setViewportSize x y = glViewport 0 0 (fromIntegral x) (fromIntegral y)