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

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 as V
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Universe
import Dodge.Render.Lights
import Dodge.Render.ShapePicture
import Dodge.Render.Walls
import Dodge.Shadows
import Dodge.WindowSize
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 -> Universe -> IO ()
doDrawing window u
    | SDL.ScancodeY `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
    | otherwise = doDrawing' window rdata u
  where
    rdata = u ^. preloadData . renderData

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

doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
doDrawing' win pdata u = do
    --sTicks <- SDL.ticks
    checkGLError "during drawing"
    let w = _uvWorld u
        cfig = _uvConfig u
        rot = w ^. wCam . camRot
        camzoom = w ^. wCam . camZoom
        trans = w ^. wCam . camCenter
        wins = V2 (windowXFloat cfig) (windowYFloat cfig)
        (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
        lightPoints = lightsToRender cfig (w ^. wCam) (w ^. cWorld . lWorld)
        viewFroms@(V2 vfx vfy) = w ^. wCam . camViewFrom
        shadV = _pictureShaders pdata
        nFls = w ^. cWorld . numberFloorVerxs
        nchs = w ^. cWorld . numberChasmVerxs
    -- bind as much data into vbos as feasible at this point
    -- count mutable vectors setup
    pokeCounts <- UMV.replicate (numLayers * numShads) 0
    -- attempt to poke in parallel
    let wswp = wallSPics <> worldSPic cfig u
        ws = wswp ^. _1
        wp = wswp ^. _2
    ((nWins, trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
        MP.bindM3
            (\_ a b -> return (a, b))
            ( pokeLayVerxs
                shadV
                pokeCounts
                wp
            )
            ( pokeWallsWindows
                (pdata ^. vboWindows . vboPtr)
                (pdata ^. wallVBO . vboPtr)
                windowPoints
                wallsToPoke
            )
            ( pokeShape
                (drawShadowsByImportance $ cfig ^. graphics_shadow_size)
                (_vboPtr $ _vboShapes pdata)
                (_eboPtr $ _shapeEBO pdata)
                (_eboPtr $ _silhouetteEBO pdata)
                (0, 0, 0)
                ws
            )
    (nCloudVs', nCloudIs') <-
        -- Might want to sort the clouds based on z depth, not sure
        V.foldM'
            (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
            (0, 0)
            (V.fromList $ w ^. cWorld . lWorld . clouds)
    --(sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
    (nCloudVs, nCloudIs) <-
        V.foldM'
            (pokeDust (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
            (nCloudVs', nCloudIs')
            (V.fromList $ w ^. cWorld . lWorld . dusts)

    -- bind wall points, silhouette data, surface geometry
    bufferShaderLayers shadV pokeCounts
    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
    withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $ \ptr ->
        glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
    setViewport _graphics_world_resolution cfig
    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
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
        \ptr -> glDrawBuffers 3 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 chasm shader blocking floor
    glUseProgram (pdata ^. chasmShader . shaderUINT)
    glBindVertexArray $ pdata ^. chasmShader . shaderVAO . vaoName
    glDepthMask GL_FALSE
    glDrawBuffer GL_NONE
    glEnable GL_STENCIL_TEST
    glStencilFunc GL_ALWAYS 0 255
    glStencilOp GL_INCR GL_INCR GL_INCR
    with 0 $ \ptr ->
        glClearNamedFramebufferiv
            (pdata ^. fboBase . _1 . unFBO)
            GL_STENCIL
            0
            ptr
    glDrawArrays
        (_unPrimitiveMode $ pdata ^. chasmShader . shaderPrimitive)
        0
        (fromIntegral nchs)
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
        \ptr -> glDrawBuffers 3 ptr
    glDepthMask GL_TRUE
    --draw floor onto base buffer
    glUseProgram (pdata ^. floorShader . shaderUINT)
    glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
    glStencilFunc GL_EQUAL 0 255
    glDrawArrays
        (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
        0
        (fromIntegral nFls)
    glDisable GL_STENCIL_TEST
    glDisable GL_CULL_FACE
    glEnable GL_BLEND
    --draw lightmap into its own buffer
    createLightMap
        cfig
        (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
    glDisable GL_CULL_FACE
    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    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 pokeCounts
    glDepthMask GL_TRUE
    renderLayer BloomLayer shadV pokeCounts
    -- draw clouds, transparency blocks some alpha
    glDepthMask GL_FALSE
    glBlendColor 0 0 0 0.1 -- using this and GL_CONSTANT_ALPHA below
    -- can allow for some underlighting of the clouds
    glBlendFuncSeparate GL_ZERO GL_ONE GL_CONSTANT_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glUseProgram (pdata ^. cloudShader . shaderUINT)
    glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
    glDrawElements
        (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
        (fromIntegral nCloudIs)
        GL_UNSIGNED_SHORT
        nullPtr
    glDepthMask GL_TRUE

    --setup downscale viewport for blurring bloom
    --setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
    setViewport _graphics_downsize_resolution cfig
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
    glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO)
    glDisable GL_BLEND
    drawShader (_bloomBlurShader pdata) 4
    when (cfig ^. graphics_bloom) $ do
        replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
        glEnable GL_BLEND
    setViewport _graphics_world_resolution cfig
    --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 pokeCounts
    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
        glDepthMask GL_TRUE
        glDepthFunc GL_LESS
        glEnable GL_BLEND
        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        createLightMap
            cfig
            (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 clouds and bloom
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))

    --draw shadowed clouds onto base buffer
    glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
    drawShader (_fullscreenShader pdata) 4

    --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

    --set viewport for radial distortion
    --setViewportSize (round winx) (round winy)
    setViewport (const FullRes) cfig
    glDepthFunc GL_ALWAYS
    glBlendFunc GL_ONE GL_ZERO
    -- perform any radial distortion
    -- this is hideous
    case (getDistortions cfig w, cfig ^. graphics_distortions) of
        (rds, x) | null rds || not x -> 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
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    -- draw the overlay
    --glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO)
    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    renderLayer DebugLayer shadV pokeCounts
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
    withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig)) $
        \ptr -> glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
    glDepthFunc GL_GEQUAL
    glDepthMask GL_TRUE
    with (-1) $ \ptr -> glClearNamedFramebufferfv 0 GL_DEPTH 0 ptr
    renderLayer FixedCoordLayer shadV pokeCounts
    SDL.glSwapWindow win

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

setViewport :: (Config -> ResFactor) -> Config -> IO ()
setViewport f = uncurry (glViewport 0 0) . getWindowSize f