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

--import qualified Data.Vector as V

import GLHelp
import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
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.Render.Lights
import Dodge.Render.Picture
import Dodge.Render.Shadow
import Dodge.Render.ShapePicture
import Dodge.Render.Walls
import Foreign
import Geometry
import Graphics.GL.Core45
import MatrixHelper
import Picture.Base
import Render
import qualified SDL
--import qualified SDL
import Shader
import Shader.Bind
import Shader.Data
import Shader.ExtraPrimitive
import Shader.Parameters
import Shader.Poke

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
        (wallPointsCol, 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 w
    ((nWalls, nWins,trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
        MP.bindM3
            (\_ a b -> return (a, b))
            ( pokeLayVerxs
                shadV
                layerCounts
                wp
            )
            ( pokeWallsWindows
                ( pdata ^. vboWalls . vboPtr)
                ( pdata ^. vboWindows . vboPtr)
                ( pdata ^. wallVBO . vboPtr)
                wallPointsCol
                windowPoints
                wallsToPoke
            )
            ( pokeShape
                (_vboPtr $ _vboShapes pdata)
                (_eboPtr $ _shapeEBO pdata)
                (_eboPtr $ _silhouetteEBO pdata)
                (0, 0, 0)
                ws
            )
    -- bind wall points, silhouette data, surface geometry
    bindShaderLayers shadV layerCounts
    uncurry (zipWithM_ bufferPokedVBO) $
        unzip
            [ (pdata ^. vboWalls, nWalls)
            , (pdata ^. vboWindows, nWins)
            , (pdata ^. wallVBO, trueNWalls)
            ]
    bufferPokedVBO (_vboShapes pdata) nShapeVs
    glNamedBufferSubData
        (_eboName $ _shapeEBO pdata)
        0
        (fromIntegral $ glushortSize * nIndices)
        (_eboPtr $ _shapeEBO pdata)
    glNamedBufferSubData
        (_eboName $ _silhouetteEBO pdata)
        0
        (fromIntegral $ glushortSize * nSilIndices)
        (_eboPtr $ _silhouetteEBO pdata)
    -- 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 (_unFBO (fst (_fboBase pdata)))
    glDepthMask GL_TRUE
-- the following clear may not be necessary
    withArray [0,0,0,1] $ \ptr -> glClearNamedFramebufferfv 
        (pdata ^. fboBase . _1 . unFBO)
        GL_COLOR
        0
        ptr
    with 1 $ \ptr -> glClearNamedFramebufferfv 
        (pdata ^. fboBase . _1 . unFBO)
        GL_DEPTH
        0
        ptr

    glDepthFunc GL_LESS
    -- draw wall occlusions from the camera's point of view
    glUseProgram (pdata ^. lightingWallShadShader . shadName)
    glProgramUniform3f (pdata ^. lightingWallShadShader . shadName) 
        0 vfx vfy 20
    glProgramUniform1f (pdata ^. lightingWallShadShader . shadName) 
        1 1000
    glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO . vaoName
    unless (debugOn Remove_LOS cfig) $
        glDrawArrays
            (marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim')
            0
            (fromIntegral nWalls)
    -- clear normals
    withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
        (pdata ^. fboBase . _1 . unFBO)
        GL_COLOR
        2
        ptr
    --draw walls onto base buffer
    glDisable GL_BLEND
    glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
    glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
    -- maybe cull faces? maybe do this before?
    --glEnable GL_CULL_FACE
    --glCullFace GL_BACK
    glUseProgram (pdata ^. wallShader . shadName)
    glBindVertexArray $ pdata ^. wallShader . shadVAO . vaoName
    glDrawArrays
        (marshalEPrimitiveMode $ pdata ^. wallShader . shadPrim')
        0
        (fromIntegral trueNWalls)
    --glDisable GL_CULL_FACE
--    if cfig ^. graphics_wall_textured
--        then renderTextureWalls pdata nWalls
--        else renderBlankWalls pdata nWalls
    --draw object pictures onto base buffer
    renderLayer BottomLayer shadV layerCounts
    --draw object shapes onto base buffer
    let fs = _shapeShader pdata
    glUseProgram (_shadName fs)
    glBindVertexArray $ fs ^. shadVAO . vaoName
--    glEnable GL_CULL_FACE
--    glCullFace GL_BACK
    glDrawElements
        (marshalEPrimitiveMode $ _shadPrim' fs)
        (fromIntegral nIndices)
        GL_UNSIGNED_SHORT
        nullPtr
    glDisable GL_CULL_FACE
    --draw floor onto base buffer
    glUseProgram (pdata ^. floorShader . shadName)
    glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName
    glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
    glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
    glDrawArrays 
        (marshalEPrimitiveMode $ pdata ^. floorShader . shadPrim' ) 
        0 
        (fromIntegral $ nFls)
    glEnable GL_BLEND
    --draw lightmap into its own buffer
    createLightMap
        cfig
        pdata
        lightPoints
        nWalls
        nSilIndices
        nIndices
        (u ^. uvConfig . graphics_object_shadows)
        (pdata ^. fboBase . _2 . _2)
        (drawCPUShadows pdata ws)
    glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
    --apply lightmap to base buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
    glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO)
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    drawShader (fst $ _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))
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
    glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO)
    glDisable GL_BLEND
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 9 $ 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
    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE 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
    drawShader (_windowShader pdata) nWins
--    when (_graphics_cloud_shadows cfig) $ do
--        ----render transparency depths
--        glDepthMask GL_TRUE
--        glDisable GL_BLEND
--        withArray [GL_NONE, GL_COLOR_ATTACHMENT1] $ \ptr -> glDrawBuffers 2 ptr
--        renderLayer MidLayer shadV layerCounts
--        drawShader (_windowShader pdata) nWins
--        ----draw lightmap for cloud buffer
--        glDepthMask GL_FALSE
--        glEnable GL_BLEND
--        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
--        createLightMap
--            cfig
--            pdata
--            lightPoints
--            nWalls
--            nSilIndices
--            nIndices
--            (_graphics_object_shadows $ _uvConfig u)
--            (snd $ snd $ _fboCloud pdata)
--            (drawCPUShadows pdata ws)
    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
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
    glEnable GL_BLEND
    glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
    drawShader (fst $ _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
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
    drawShader (fst $ _fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    --draw shadowed clouds onto base buffer
    glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
    drawShader (fst $ _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
    case w ^. cWorld . lWorld . distortions of
        [] -> do
            bindTO $ pdata ^. fboBase . _2 . _1
            glBindFramebuffer GL_FRAMEBUFFER 0
            drawShader (fst $ _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 bindTO toList)
            glActiveTexture GL_TEXTURE1
            zipWithM_ (>>) bindings $ map bindDrawDist rds
            glActiveTexture GL_TEXTURE1
    glDepthFunc GL_ALWAYS
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    renderLayer DebugLayer shadV layerCounts
    -- draw overlay
    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. orthonormalMatUBO)
    renderLayer FixedCoordLayer shadV layerCounts
    renderFoldable shadV $ fixedCoordPictures u
    glDepthMask GL_TRUE
    when (debugOn Show_ms_frame $ _uvConfig u) $
        renderFoldable
            (_pictureShaders pdata)
            ( setDepth (-1)
                . translate (-0.5) (-0.8)
                . scale 0.0005 0.0005
                $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
            )
    SDL.glSwapWindow win

fpsText :: (Show a, Ord a, Num a) => a -> Picture
fpsText x = color col $ text $ "ms/frame " ++ show x
  where
    col
        | x < 22 = blue
        | x < 30 = green
        | x < 40 = yellow
        | x < 50 = orange
        | otherwise = red

--------------------------------------------------------------------------------
-- note: currently assume there is only one UBO, we only bind it once at setup
--bufferUBO :: GLuint -> [Float] -> IO ()
--bufferUBO ubo mat = withArray mat $ \ptr ->
--    glNamedBufferSubData ubo 0 64 ptr

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


--cullFace $= Nothing