{- |
Contains the central drawing functions for the dodge loop. -}
module Dodge.Render 
    ( doDrawing
    )
  where
import Dodge.Data
import Dodge.Config.Data
import Dodge.Base.Window
import Dodge.Render.Picture
import Dodge.Render.Shape
import Geometry
import Render
import Data.Preload.Render
import Shader
import Shader.Poke
import Shader.Bind
import Shader.Data
import MatrixHelper
import Shader.ExtraPrimitive
import Shader.Parameters

import Foreign
import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
import qualified SDL
import qualified Data.Vector.Unboxed.Mutable as UMV
import Graphics.GL.Core43

doDrawing :: RenderData -> World -> IO Word32
doDrawing pdata w = do
    sTicks <- SDL.ticks
    let rot     = _cameraRot w
        camzoom    = _cameraZoom w
        trans = _cameraCenter w
        wins@(V2 winx winy)  = V2 (getWindowX w) (getWindowY w)
        resFact = w ^. config . resolution_factor
        (wallPointsCol,windowPoints) = wallsAndWindows w
        lightPoints     = lightsForGloom w
        viewFroms@(V2 vfx vfy) = _cameraViewFrom w
        viewFrom3d = Vector3 vfx vfy 20
        shadV = _pictureShaders pdata
    -- bind as much data into vbos as feasible at this point
    -- pictures setup
    layerCounts <- UMV.replicate (6*6) 0
    -- attempt to do this poking in parallel
    (nWalls,(nShapeVs,nIndices,nSilIndices)) <- MP.bindM3 (\ _ a b -> return (a,b))
        -- pictures poking
        ( pokeBindFoldableLayer shadV layerCounts $ worldPictures w )
        -- poke wall points and colors
        ( poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol )
        ( pokeShape 
            (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
            (_eboPtr $ _shapeEBO pdata)
            (_eboPtr $ _silhouetteEBO pdata)
            $ worldShape w
        )
    -- bind wall points, silhouette data, surface geometry
    uncurry bindShaderBuffers $ unzip
        [ ( _wallTextureShader pdata, nWalls)
        , (_shapeShader pdata, nShapeVs)
        ]
    bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
    bufferSubData
        ElementArrayBuffer
        WriteToBuffer
        0
        (fromIntegral $ glushortSize * nIndices)
        (_eboPtr $ _shapeEBO pdata)
    bindBuffer ElementArrayBuffer $= Just (_ebo $ _silhouetteEBO pdata)
    bufferSubData
        ElementArrayBuffer
        WriteToBuffer
        0
        (fromIntegral $ glushortSize * nSilIndices)
        (_eboPtr $ _silhouetteEBO pdata)
    -- set the coordinate uniform ready for drawing elements using world coordinates
    bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    clearColor $= Color4 0 0 0 0
    clear [ColorBuffer,DepthBuffer]
    depthFunc $= Just Less
    -- draw wall occlusions from the camera's point of view
    currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata)
    uniform (head $  _shadUnis $ _lightingOccludeShader pdata) $= viewFrom3d
    drawShader (_lightingOccludeShader pdata) nWalls
    --draw walls onto base buffer
    if w ^. config . wall_textured
        then renderTextureWalls pdata nWalls
        else renderBlankWalls pdata nWalls
    --draw object pictures onto base buffer
    renderLayer 0 shadV layerCounts
    --draw object shpaes onto base buffer
    let fs = _shapeShader pdata
    currentProgram $= Just (_shadProg fs)
    bindVertexArrayObject $= 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)
    bindShaderBuffers [_textureArrayShader pdata] [nTextArrayVs]
    drawShader (_textureArrayShader pdata) nTextArrayVs
    --draw lightmap into its own buffer
    bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
    createLightMap pdata lightPoints nWalls nSilIndices nIndices (snd $ snd $ _fboBase pdata)
    colorMask $= Color4 Enabled Enabled Enabled Enabled
    clearColor $= Color4 0 0 0 0
    --apply lightmap to base buffer
    bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    blend $= Enabled
    blendFunc $= (Zero, OneMinusSrcColor)
    drawShader (_fullscreenShader pdata) 4
    --draw bloom onto bloom buffer
    bindFramebuffer Framebuffer $= fst (_fboBloom pdata)
    clear [ColorBuffer]
    depthFunc $= Just Less
    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    depthMask $= Disabled
    renderLayer 3 shadV layerCounts
    depthMask $= Enabled
    renderLayer 1 shadV layerCounts
    --depthMask $= Enabled
    --setup downscale viewport for blurring bloom
    setViewportSize (round winx `div` (2*resFact)) (round winy `div` (2*resFact))
    bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
    depthFunc $= Just Always
    textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
    blend $= Disabled
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
    blend $= Enabled
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    --draw clouds
    bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    depthFunc $= Just Lequal
    depthMask $= Disabled
    clearColor $= Color4 0.5 0.5 0.5 0
    --blendFunc $= (SrcAlphaSaturate,One)
    --blendColor $= Color4 0.5 0.5 0.5 0.5
    --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
    blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha))
    drawBuffers $= [FBOColorAttachment 0,NoBuffers]
    clear [ColorBuffer]
    renderLayer 2 shadV layerCounts
    renderWindows pdata windowPoints
    when (_cloud_shadows $ _config w) $ do
        ----render transparency depths
        depthMask $= Enabled
        blend $= Disabled
        drawBuffers $= [NoBuffers,FBOColorAttachment 1]
        renderLayer 2 shadV layerCounts
        renderWindows pdata windowPoints
        ----draw lightmap for cloud buffer
        depthMask $= Disabled
        blend $= Enabled
        bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
        createLightMap pdata lightPoints nWalls nSilIndices nIndices (snd $ snd $ _fboCloud pdata)
        colorMask $= Color4 Enabled Enabled Enabled Enabled
        clearColor $= Color4 0 0 0 0
    --apply lightmap to cloud buffer
    clearColor $= Color4 0 0 0 0
    bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    depthMask $= Disabled
    drawBuffers $= [FBOColorAttachment 0,NoBuffers]
    depthFunc $= Just Always
    textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    blend $= Enabled
    --blendFunc $= (Zero, OneMinusSrcAlpha)
    blendFuncSeparate $= ((Zero, OneMinusSrcColor),(Zero, One))
    drawShader (_fullscreenShader pdata) 4
    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
    --Draw blurred bloom onto base buffer
    bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    blend $= Enabled
    blendFunc $= (SrcAlpha, One)
    textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
    --draw shadowed clouds onto base buffer
    textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
    drawShader (_fullscreenShader pdata) 4
    --set viewport for radial distortion
    setViewportSize (round winx) (round winy)
    depthFunc $= Just Always
    blendFunc $= (One,Zero)
    -- perform any radial distortion
    case _radDistortion w of
        [] -> do
            bindTO $ fst $ snd $ _fboBase pdata
            bindFramebuffer Framebuffer $= defaultFramebufferObject
            --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
            drawShader (_fullscreenShader pdata) 4
        rds -> do
            let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO ()
                bindDrawDist ( 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]
                toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata,snd $ _fbo3 pdata])
                bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
            activeTexture $= TextureUnit 1
            zipWithM_ (>>) bindings $ map bindDrawDist rds
            activeTexture $= TextureUnit 0
    -- draw overlay
    depthFunc $= Just Always
    depthMask $= Disabled
    blend $= Enabled
    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
    renderLayer 4 shadV layerCounts
    bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2)
    renderFoldable shadV $ fixedCoordPictures w
    depthMask $= Enabled
    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

setViewportSize :: Int -> Int -> IO ()
setViewportSize x y = viewport $= 
    ( Position 0 0
    , Size (fromIntegral x) (fromIntegral y)
    )

renderBlankWalls 
    :: RenderData 
    -> Int -- ^ number of walls
    -> IO ()
renderBlankWalls pdata nWalls = do
    cullFace $= Just Back
    drawShader (_wallBlankShader pdata) nWalls
    cullFace $= Nothing

renderWindows 
    :: RenderData 
    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
    -> IO ()
renderWindows pdata wps = do
    n <- poke224s (shadVBOptr $ _windowShader pdata) wps
    bindShaderBuffers [_windowShader pdata] [n]
    currentProgram $= Just (_shadProg $ _windowShader pdata)
    --cullFace $= Just Back
    drawShader (_windowShader pdata) n
    --cullFace $= Nothing

renderTextureWalls 
    :: RenderData 
    -> Int   -- ^ number of walls
    -> IO ()
renderTextureWalls pdata nWalls = do
    cullFace $= Just Back
    drawShader (_wallTextureShader pdata) nWalls
    cullFace $= Nothing

