module Render
    where
import Shader
import Shader.Data
import Shader.Poke
--import MatrixHelper
import Data.Preload.Render
import Picture.Data
--import Picture.Tree
import Geometry
import Geometry.Data
import Polyhedra.Data
import Polyhedra

--import Control.Lens
import Control.Monad
import qualified Control.Foldl as F
import Foreign hiding (rotate)
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
--import Data.Foldable
import Data.Tuple.Extra
--import qualified Data.IntMap.Strict as IM
import qualified SDL

setWallDepth
    :: RenderData
    -> [(Point2,Point2)]    -- ^ Wall points
    -> (Float,Float)        -- ^ View from point
    -> IO Word32
setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
    startTicks <- SDL.ticks
    colorMask $= Color4 Disabled Disabled Disabled Disabled
    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]

    currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
    -- reseting this uniform appears to be necessary
    uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
            $= Vector2 viewFromx viewFromy  
--    cullFace $= Just Front
    drawShader (_lightingOccludeShader pdata) nWalls
    colorMask $= Color4 Enabled Enabled Enabled Enabled
    endTicks <- SDL.ticks
    return $ endTicks - startTicks

divideSize :: Int -> Size -> Size
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)

{- | 
Determine where light is shining in the world.
Note that this currently (1/5/2021) sets the bound framebuffer to fbo2.
The lightmap itself is rendered into this buffer.  -}
createLightMap 
    :: RenderData 
    -> Int                  -- Resolution division
    -> [(Point2,Point2)]    -- Wall pairs
    -> [(Point3,Float,Float)]             -- Lights
    -> (Float,Float)        -- View from position
    -> [Polyhedra]          -- foreground geometry
    -> [Point2]
    -> IO ()
createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics scPol = do
    -- get viewport size so we can reset it later
    (vppos,vpsize) <- get viewport
    -- set the viewport size to that of the render buffer
    viewport $= (vppos, divideSize resDiv vpsize)
    bindFramebuffer Framebuffer $= _spareFBO pdata
    -- store wall and light positions into buffer
    nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints)
    bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
    -- store foreground silhouette geometry into buffer
    nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) (concatMap polyToRender fpics)
    bindShaderBuffers [_lightingLineShadowShader pdata] [nSils]
    -- store foreground geometry and floor into buffer
    let addC (xx,yy) = (xx,yy,0)
    nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) 
        $ [Render3 $ polyToTris $ map addC $ scPol ]
        ++ concatMap polyToGeoRender (fpics)
    bindShaderBuffers [_lightingSurfaceShader pdata] [nsurfVs]
-- clear buffer to full alpha and furthest depth
-- clearColor is specified in preloadRender
    clear [ColorBuffer,DepthBuffer]
    cullFace $= Just Back
-- draw walls from your point of view in order to set z buffer
    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
    drawShader (_lightingWallShader pdata) nWallLights
    --colorMask $= Color4 Disabled Disabled Disabled Disabled
    --currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
    --uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
    --        $= Vector2 viewFromx viewFromy  
    --drawShader (_lightingOccludeShader pdata) nWalls
---- draw foreground elements to set z buffer
    currentProgram $= Just (_shaderProgram $ _lightingSurfaceShader pdata)
    drawShader (_lightingSurfaceShader pdata) nsurfVs 
-- for each of the lights: 
-- stencil out the walls from this light's point of view
-- draw fading lightmap circles on the floor
-- draw fading lightmaps on the walls
    --cullFace $= Nothing
    depthMask $= Disabled
    blendFunc $= (Zero, OneMinusSrcAlpha)
    stencilTest $= Enabled
    --depthFunc $= Just Less
    forM_ lightPoints $ \((x,y,z),r,lum) -> do
        -- stencil out shadows
        --depthFunc $= Just Less
        depthFunc $= Just Lequal
        colorMask $= Color4 Disabled Disabled Disabled Disabled
        clear [StencilBuffer]
        cullFace $= Just Back
        stencilOp $= (OpKeep,OpKeep,OpIncr)
        stencilFunc $= (Always, 0, 255)
        currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
        uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
            $= Vector3 x y z
        drawShader (_lightingOccludeShader pdata) nWalls
        --cullFace $= Nothing
        currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
        uniform (head $  _shaderCustomUnis $ _lightingLineShadowShader pdata)
            $= Vector3 x y z
        drawShader (_lightingLineShadowShader pdata) nSils

        cullFace $= Just Front
        stencilOp $= (OpKeep,OpKeep,OpDecr)
        currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
        drawShader (_lightingOccludeShader pdata) nWalls

        currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
        drawShader (_lightingLineShadowShader pdata) nSils
        depthFunc $= Just Lequal
        -- draw geometry surfaces
        cullFace $= Just Back
        colorMask $= Color4 Disabled Disabled Disabled Enabled
        stencilFunc $= (Equal, 0, 255)
        currentProgram $= Just (_shaderProgram $ _lightingSurfaceShader pdata)
        uniform (head $  _shaderCustomUnis $ _lightingSurfaceShader pdata)
            $= Vector3 x y z
        uniform (_shaderCustomUnis (_lightingSurfaceShader pdata) !! 1)
            $= Vector2 r lum
        drawShader (_lightingSurfaceShader pdata) nsurfVs 
        -- draw wall light "circles"
        --cullFace $= Nothing
        currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
        uniform (head $ _shaderCustomUnis $ _lightingWallShader pdata)
            $= Vector3 x y z
        uniform (_shaderCustomUnis (_lightingWallShader pdata) !! 1)
            $= Vector2 r lum
        drawShader (_lightingWallShader pdata) nWallLights
    cullFace $= Nothing
    stencilTest $= Disabled
    blend $= Disabled
    -- set the viewport size to that of the window
    viewport $= (vppos, vpsize)
    -- disable depth testing for blurring
    depthFunc $= Just Always
    -- draw the lightmap on a full size fbo
    bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
    colorMask $= Color4 Disabled Disabled Disabled Enabled
    bindShaderBuffers [_boxBlurShader pdata] [4]
    textureBinding Texture2D $= Just (_fboTexture pdata)
    -- by upscaling the shadowmap texture and using Linear' magnification
    -- interpolation, we get a poor mans blur, not sure about performance
    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
    generateMipmap' Texture2D
    drawShader (_boxBlurShader pdata) 4
    -- ping pong blur between '_fbo2' and '_fbo3' as many times as desired
    replicateM_ 3 $ pingPongBlur pdata
    -- reset drawing parameters ready for drawing on top of the light map
    colorMask $= Color4 Enabled Enabled Enabled Enabled
    depthMask $= Enabled
    blend $= Enabled
{- |
Blur between two framebuffers.
Assumes no depth testing is done (depthFunc %= Just Always).
 -}
pingPongBlur :: RenderData -> IO ()
pingPongBlur pdata = do
    bindFramebuffer Framebuffer $= fst3 (_fbo3 pdata)
    textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
    generateMipmap' Texture2D
    drawShader (_boxBlurShader pdata) 4

    bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
    textureBinding Texture2D $= Just (snd3 $ _fbo3 pdata)
    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
    generateMipmap' Texture2D
    drawShader (_boxBlurShader pdata) 4

renderShader
    :: Foldable f
    => FullShader
    -> f RenderType
    -> IO Word32
renderShader shad dat = do
    sticks <- SDL.ticks
    i <- F.foldM  (pokeShader shad) dat
    bindShaderBuffers [shad] [i]
    drawShader shad i
    eticks <- SDL.ticks
    return $ eticks - sticks

renderFoldable
    :: Foldable f
    => RenderData
    -> f RenderType
    -> IO Word32
renderFoldable pdata struct = do
    pokeStartTicks <- SDL.ticks

    let slist = _pictureShaders pdata

-- poke data, returns list buffer sizes for each shader
    is <- F.foldM (traverse pokeShader slist) struct

-- the idea of binding many buffers at once, rather than interweaving with draw
-- calls, is to prevent opengl from waiting for a draw call to finish
-- before it performs another state change
    bindShaderBuffers slist is

    zipWithM_ drawShader slist is
    
    pokeEndTicks <- SDL.ticks
    return $ pokeEndTicks - pokeStartTicks
------------------------------end renderFoldable

pokeTwoOff 
    :: Ptr Float 
    -> Int 
    -> (Float,Float) 
    -> IO ()
{-# INLINE pokeTwoOff #-}
pokeTwoOff ptr n (x,y) = do
    pokeElemOff ptr (2*n+0) x
    pokeElemOff ptr (2*n+1) y
pokeThreeOff 
    :: Ptr Float 
    -> Int 
    -> (Float,Float,Float) 
    -> IO ()
{-# INLINE pokeThreeOff #-}
pokeThreeOff ptr n (x,y,z) = do
    pokeElemOff ptr (3*n+0) x
    pokeElemOff ptr (3*n+1) y
    pokeElemOff ptr (3*n+2) z
pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
{-# INLINE pokeFourOff #-}
pokeFourOff ptr n (x,y,z,w) = do
    pokeElemOff ptr (4*n+0) x
    pokeElemOff ptr (4*n+1) y
    pokeElemOff ptr (4*n+2) z
    pokeElemOff ptr (4*n+3) w