{- |
Contains the central drawing functions for the dodge loop. -}
module Dodge.Render 
    ( doDrawing
    )
  where
import Dodge.Data
import Dodge.Config.Data
import Dodge.Base
--import Dodge.Render.HUD
--import Dodge.Render.MenuScreen
import Dodge.Render.Picture
--import Dodge.Render.PerspectiveMatrix
--import Geometry
import Geometry.Data
--import Picture
import Render
import Data.Preload.Render
import Picture.Data
import Picture.Tree
import Shader
import Shader.Data
import Shader.Poke
import MatrixHelper
--import Polyhedra.Data
import Polyhedra

import Foreign
--import Control.Applicative
--import Control.Monad.State
import Control.Lens
import Control.Monad
import qualified Control.Foldl as F
--import Data.Tuple.Extra
--import Data.List
--import Data.Bifunctor
--import Data.Function
--import qualified Data.IntMap.Strict as IM
--import qualified Data.Map as M
--import qualified Data.Set as S
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
import qualified SDL

doDrawing :: RenderData -> World -> IO Word32
doDrawing pdata w = do
    sTicks <- SDL.ticks
    let rot     = _cameraRot w
        camzoom    = _cameraZoom w
        trans = _cameraCenter w
        wins    = (getWindowX w,getWindowY w)
        wallPointsCol   = wallsPointsAndCols w
        windowPoints    = wallsWindows w
        lightPoints     = lightsForGloom w
        --viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
        viewFroms = _cameraViewFrom w
        pic = worldPictures w
        wallPoints = map fst wallPointsCol
    -- set the coordinate uniform ready for drawing elements using world coordinates
    bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
    bindFramebuffer Framebuffer $= (fst $ _fboBase pdata)
    clearColor $= Color4 0 0 0 0
    clear [ColorBuffer,DepthBuffer]
    depthFunc $= Just Less
    if w ^. config . wall_textured
        then renderTextureWalls pdata wallPointsCol
        else renderBlankWalls pdata wallPointsCol
--    _ <- setWallDepth pdata wallPoints (viewFromx,viewFromy)
    _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w)
    _ <- renderFoldable pdata $ picToLTree (Just 0) pic
    _ <- renderShader (_textureArrayShader pdata) (_floorTiles w)

    bindFramebuffer Framebuffer $= (fst $ _fboBloom pdata)
    clear [ColorBuffer]
    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    _ <- renderFoldable pdata $ picToLTree (Just 1) pic
    bindFramebuffer Framebuffer $= (fst $ _fboColor pdata)
    clear [ColorBuffer]
    depthMask $= Disabled
    _ <- renderFoldable pdata $ picToLTree (Just 3) pic
    _ <- renderFoldable pdata $ picToLTree (Just 4) pic
    _ <- renderFoldable pdata $ picToLTree (Just 5) pic
    depthMask $= Enabled
    --bindFramebuffer Framebuffer $= (fst3 $ _fbo2 pdata)
    bindFramebuffer Framebuffer $= (fst $ _fboFourth1 pdata)
    viewport $= (Position 0 0, Size 300 300)
    depthFunc $= Just Always
    --blend $= Disabled
    textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
    --clear [ColorBuffer]
    --blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    --blendFuncSeparate $= ((Zero,One), (Zero,SrcAlpha))
    --drawShader (_fullscreenAlphaHalveShader pdata) 4
    --blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    --drawShader (_bloomBlurShader pdata) 4
    --blendFuncSeparate $= ((Zero,One),(Zero,SrcAlpha))
    blendFunc $= (One,One)
    blendEquation $= FuncReverseSubtract
    drawShader (_fullscreenAlphaHalveShader pdata) 4
    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    blendEquation $= FuncAdd
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 5 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata)
    --replicateM_ 5 $ pingPongBlur pdata
    --blend $= Enabled
    viewport $= (Position 0 0, Size (round $ fst wins) (round $ snd wins))

    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)

    bindFramebuffer Framebuffer $= (fst $ _fboLighting pdata)
    let scPol = screenPolygon w
    createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints
        (foregroundPics w) scPol
    colorMask $= Color4 Enabled Enabled Enabled Enabled
    clearColor $= Color4 0 0 0 0

    bindShaderBuffers [_fullscreenShader pdata] [4]

    --bindFramebuffer Framebuffer $= defaultFramebufferObject
    blend $= Disabled
    depthMask $= Disabled
    depthFunc $= Just Always
    --textureBinding Texture2D $= Just (snd $ head $ fst $ _fbos pdata)
    --drawShader (_fullscreenShader pdata) 4

    bindFramebuffer Framebuffer $= (fst $ _fboBase pdata)
    --drawShader (_fullscreenShader pdata) 4
    --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
    textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    blend $= Enabled
    blendFunc $= (Zero, OneMinusSrcAlpha)
    drawShader (_fullscreenShader pdata) 4
    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)

    textureBinding Texture2D $= Just (snd $ _fboColor pdata)
    drawShader (_colorBlurShader pdata) 4
    --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
    textureBinding Texture2D $= Just (snd $ _fboFourth1 pdata)
    drawShader (_fullscreenShader pdata) 4

    depthFunc $= Just Lequal
    _ <- renderFoldable pdata $ picToLTree (Just 2) pic
    renderBlankWalls pdata windowPoints

    depthFunc $= Just Always
    bindFramebuffer Framebuffer $= defaultFramebufferObject
    clear [ColorBuffer]
    textureBinding Texture2D $= Just (snd $ _fboBase pdata)
    drawShader (_fullscreenShader pdata) 4

    -- draw overlay
    bufferUBO $ isoMatrix 0 1 (0,0) (2,2)
    --depthFunc $= Just Always
    depthMask $= Enabled
    blend $= Enabled
    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    _ <- renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)

    eTicks <- SDL.ticks
    return (eTicks - sTicks)

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

renderBlankWalls 
    :: RenderData 
    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
--    -> GLmatrix GLfloat 
    -> IO ()
renderBlankWalls pdata wps = do
    n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
    bindShaderBuffers [_wallBlankShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
    cullFace $= Just Back
    drawShader (_wallBlankShader pdata) n
    cullFace $= Nothing

renderTextureWalls 
    :: RenderData 
    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
    -> IO ()
renderTextureWalls pdata wps = do
    n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
    bindShaderBuffers [_wallTextureShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
    cullFace $= Just Back
    drawShader (_wallTextureShader pdata) n
    cullFace $= Nothing