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

import Picture.Base
import qualified SDL
import qualified Data.Vector as V
import Dodge.Render.Shadow
import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
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.ShapePicture
import Dodge.Render.Walls
import Foreign
import Geometry
import Graphics.GL.Core45
import MatrixHelper
import Render
--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 win pdata u = do
--    sTicks <- SDL.ticks
    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) = wallsToDraw w
        lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
        viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
        shadV = _pictureShaders pdata
        lwShad = _lightingWallShadShader pdata
    -- 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 , nFls),(nShapeVs, nIndices, nSilIndices) )
    ((nWalls, nWins, nFls), (nShapeVs, nIndices, nSilIndices)) <-
        MP.bindM3
            (\_ a b -> return (a, b))
            ( pokeLayVerxs
                shadV
                layerCounts
                wp
            )
            ( pokeWallsWindowsFloor
                (shadVBOptr $ _wallTextureShader pdata)
                (shadVBOptr $ _windowShader pdata)
                (shadVBOptr $ _textureArrayShader pdata)
                wallPointsCol
                windowPoints
                (w ^. cWorld . floorTiles)
            )
            ( pokeShape
                (_vboPtr $ _vaoVBO $ _shadVAO' $ _shapeShader pdata)
                (_eboPtr $ _shapeEBO pdata)
                (_eboPtr $ _silhouetteEBO pdata)
                (0, 0, 0)
                ws
            )
    -- bind wall points, silhouette data, surface geometry
    bindShaderLayers shadV layerCounts
    uncurry bindShaderBuffers $
        unzip
            [ (_wallTextureShader pdata, nWalls)
            , (_shapeShader pdata, nShapeVs)
            , (_windowShader pdata, nWins)
            , (_textureArrayShader pdata, nFls)
            ]
    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
    bufferUBO (pdata ^. matUBO) $ perspectiveMatrixb rot camzoom trans wins viewFroms
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    --bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    glClearColor 0 0 0 0
    glClear $ sum [GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT]
    glDepthFunc GL_LESS
    -- draw wall occlusions from the camera's point of view
--    currentProgram $= lwShad ^? shadProg -- Just (_shadProg lwShad)
--    uniform (_shadUnis lwShad V.! 0) $= viewFrom3d
    glUseProgram (lwShad ^. shadProg')
    glUniform3f (_shadUnis' lwShad V.! 0) vfx vfy 20
    --bindVertexArrayObject $= lwShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwShad)
    glBindVertexArray $ lwShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO lwShad)
    unless (debugOn Remove_LOS cfig) $
        glDrawArrays
            (marshalEPrimitiveMode $ _shadPrim' lwShad)
            0
            (fromIntegral nWalls)
    --draw walls onto base buffer
    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
    --currentProgram $= Just (_shadProg fs)
    glUseProgram (_shadProg' fs)
    --bindVertexArrayObject $= fs ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO fs)
    glBindVertexArray $ fs ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO fs)
    glDrawElements
        (marshalEPrimitiveMode $ _shadPrim' fs)
        (fromIntegral nIndices)
        GL_UNSIGNED_SHORT
        nullPtr
    --draw floor onto base buffer
    --    nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
    drawShader (_textureArrayShader pdata) nFls
    --draw lightmap into its own buffer
    --bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
    createLightMap
        pdata
        lightPoints
        nWalls
        nSilIndices
        nIndices
        --(_graphics_object_shadows $ _uvConfig u)
        (u ^. uvConfig . graphics_object_shadows)
        (snd $ snd $ pdata ^. fboBase)
        (drawCPUShadows pdata ws)
    glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE 
    glClearColor 0 0 0 0
    --apply lightmap to base buffer
    --bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata)
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
    --textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    --textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
    glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO) -- Just (snd $ _fboLighting pdata)
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    drawShader (_fullscreenShader pdata) 4
    --draw bloom onto bloom buffer
    --bindFramebuffer Framebuffer $= pdata ^. fboBloom . _1 --fst (_fboBloom pdata)
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
    glClear GL_COLOR_BUFFER_BIT
    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
    --glDepthMask GL_TRUE
    --setup downscale viewport for blurring bloom
    setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
    --bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
    --textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
    glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) -- Just (snd $ _fboBloom pdata)
    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
    --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthFunc GL_LEQUAL
    glDepthMask GL_FALSE
    glClearColor 0.5 0.5 0.5 0
    --glBlendFunc GL_SRC_ALPHASaturate,One)
    --blendColor $= Color4 0.5 0.5 0.5 0.5
    --glBlendFuncSeparate GL_SRC_ALPHASaturate,One) , (One,GL_ONE_MINUS_SRC_ALPHA))
    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
    --drawBuffers $= [FBOColorAttachment 0, NoBuffers]
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glClear GL_COLOR_BUFFER_BIT
    renderLayer MidLayer shadV layerCounts
    --renderWindows pdata windowPoints
    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
        --drawBuffers $= [NoBuffers, FBOColorAttachment 1]
        renderLayer MidLayer shadV layerCounts
        drawShader (_windowShader pdata) nWins
        ----draw lightmap for cloud buffer
        glDepthMask GL_FALSE
        glEnable GL_BLEND
        --bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        createLightMap
            pdata
            lightPoints
            nWalls
            nSilIndices
            nIndices
            (_graphics_object_shadows $ _uvConfig u)
            (snd $ snd $ _fboCloud pdata)
            (drawCPUShadows pdata ws)
        glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE 
        glClearColor 0 0 0 0
    --apply lightmap to cloud buffer
    glClearColor 0 0 0 0
    --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthMask GL_FALSE
    --drawBuffers $= [FBOColorAttachment 0, NoBuffers]
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glDepthFunc GL_ALWAYS
    --textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
    glEnable GL_BLEND
    --glBlendFunc GL_ZERO, GL_ONE_MINUS_SRC_ALPHA)
    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
    --bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    --Draw blurred bloom onto base buffer
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE
    --textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    --draw shadowed clouds onto base buffer
    --textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
    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
    case w ^. cWorld . lWorld . distortions of
        [] -> do
            bindTO $ fst $ snd $ _fboBase pdata
            glBindFramebuffer GL_FRAMEBUFFER 0
            --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
            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]
                    bindShaderBuffers [_barrelShader pdata] [1]
                    drawShader (_barrelShader pdata) 1
                fboList =
                    take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
                        -- ++ [defaultFramebufferObject]
                        ++ [FBO 0]
                toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
                bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
            glActiveTexture GL_TEXTURE1
            --activeTexture $= TextureUnit 1
            zipWithM_ (>>) bindings $ map bindDrawDist rds
            --activeTexture $= TextureUnit 0
            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
    bufferUBO (pdata ^. matUBO) $ isoMatrix 0 1 (V2 0 0) (V2 2 2)
    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
--    eTicks <- SDL.ticks
--    return (eTicks - sTicks)

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)

renderBlankWalls ::
    RenderData ->
    -- | number of walls
    Int ->
    IO ()
renderBlankWalls pdata nWalls = do
    glEnable GL_CULL_FACE
    glCullFace GL_BACK
    --cullFace $= Just Back
    drawShader (_wallBlankShader pdata) nWalls
    glDisable GL_CULL_FACE
    --cullFace $= Nothing

renderTextureWalls ::
    RenderData ->
    -- | number of walls
    Int ->
    IO ()
renderTextureWalls pdata nWalls = do
    --cullFace $= Just Back
    glEnable GL_CULL_FACE
    glCullFace GL_BACK
    drawShader (_wallTextureShader pdata) nWalls
    glDisable GL_CULL_FACE
    --cullFace $= Nothing