module Render
    ( createLightMap
    , divideSize
    , renderFoldable
    , renderLayer
    , pingPongBetween
    , bindTO
    , bindFBO
    )
  where
import Shader
import Shader.ExtraPrimitive
import Shader.Data
import Data.Preload.Render
import Picture.Data
import Geometry.Data

import Foreign hiding (rotate)
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import Control.Monad.Primitive
import qualified Data.Vector.Fusion.Stream.Monadic as VS
import Graphics.GL.Core43

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.  -}
createLightMap 
    :: RenderData 
    -> [(Point3,Float,Point3)]             -- Lights
    -> Int -- ^ number of walls
    -> Int -- ^ number of silhoutte lines to draw
    -> Int -- ^ number of "caps" to attempt to draw
    -> TextureObject -- ^ the texture object giving positions
    -> IO ()
createLightMap pdata lightPoints nWalls nSils nCaps toPos = do
    let llsShad = _lightingLineShadowShader pdata
    let lcShad  = _lightingCapShader pdata
    let lwShad  = _lightingWallShadShader pdata
    let flShad  = _fullLightingShader pdata
    -- we assume that the renderbuffer's depth has been correctly set elsewhere
    -- we will not be changing that here
    depthMask $= Disabled
    -- clearColor is specified differently in preloadRender
    clearColor $= Color4 1 1 1 1
    clear [ColorBuffer]
    -- for each of the lights: 
    -- 1. stencil out the walls from this light's point of view
    -- 2. calculate lighting based on each fragment's position
    blendFunc $= (Zero, OneMinusSrcColor)
    stencilTest $= Enabled
    flip VS.mapM_ (VS.fromList lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do
        depthFunc $= Just Less
        -- setup stencil
        colorMask $= Color4 Disabled Disabled Disabled Disabled
        clear [StencilBuffer]
        cullFace $= Nothing
        stencilOpSeparate Front $= (OpKeep,OpKeep,OpIncrWrap)
        stencilOpSeparate Back  $= (OpKeep,OpKeep,OpDecrWrap)
        stencilFunc $= (Always, 0, 255)
        --draw wall shadows
        currentProgram $= Just (_shadProg lwShad)
        uniform (head $  _shadUnis lwShad)
            $= Vector3 x y z
        bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad)
        glDrawArrays 
            (marshalEPrimitiveMode $ _shadPrim lwShad) 
            0 
            (fromIntegral nWalls)
        --drawShader lwShad nWalls
        --draw silhouette shadows
        currentProgram $= Just (_shadProg llsShad)
        uniform (head $  _shadUnis $ _lightingLineShadowShader pdata)
            $= Vector3 x y z
        bindVertexArrayObject $= Just (_vao $ _shadVAO llsShad)
        glDrawElements
            (marshalEPrimitiveMode $ _shadPrim llsShad) 
            (fromIntegral nSils)
            GL_UNSIGNED_SHORT
            nullPtr
        cullFace $= Just Back
        --draw caps on the near plane as required
        currentProgram $= Just (_shadProg lcShad)
        uniform (head $  _shadUnis lcShad)
            $= Vector3 x y z
        bindVertexArrayObject $= Just (_vao $ _shadVAO lcShad)
        glDrawElements
            (marshalEPrimitiveMode $ _shadPrim lcShad) 
            (fromIntegral nCaps)
            GL_UNSIGNED_SHORT
            nullPtr
        --draw lightmap itself
        depthFunc $= Just Always
        -- bind world position texture
        bindTO toPos
        colorMask $= Color4 Enabled Enabled Enabled Enabled
        stencilOp $= (OpKeep,OpKeep,OpKeep)
        stencilFunc $= (Equal, 0, 255)
        currentProgram $= Just (_shadProg flShad)
        uniform (head $  _shadUnis flShad)
            $= Vector3 x y z
        uniform (_shadUnis flShad !! 1)
            $= Vector4 r g b rad
        bindVertexArrayObject $= Just (_vao $ _shadVAO flShad)
        glDrawArrays 
            (marshalEPrimitiveMode (_shadPrim flShad))
            0 
            (fromIntegral (4::Int))
    --cleanup: may not be necessary, depending on what comes after...
    cullFace $= Nothing
    stencilTest $= Disabled
-- assumes that vertices have already been sent to the shader
pingPongBetween 
    :: (FramebufferObject,TextureObject)
    -> (FramebufferObject,TextureObject)
    -> FullShader
    -> IO ()
pingPongBetween (fb1,to1) (fb2,to2) fs = do
    bindFramebuffer Framebuffer $= fb2
    textureBinding Texture2D $= Just to1
    drawShader fs 4
    bindFramebuffer Framebuffer $= fb1
    textureBinding Texture2D $= Just to2
    drawShader fs 4

renderFoldable
    :: MV.MVector (PrimState IO) FullShader
    -> Picture
    -> IO ()
renderFoldable shadV struct = do
    counts <- UMV.replicate 6 0
    pokeBindFoldable shadV counts struct
    MV.imapM_ (drawShaderLay 0 counts) shadV

------------------------------end renderFoldable
renderLayer 
    :: Int 
    -> MV.MVector (PrimState IO) FullShader
    -> UMV.MVector (PrimState IO) Int
    -> IO ()
renderLayer layer shads counts = do
    let layerCounts = UMV.slice (layer * 6) 6 counts
    MV.imapM_ (drawShaderLay layer layerCounts) shads

bindTO :: TextureObject -> IO ()
bindTO t = textureBinding Texture2D $= Just t

bindFBO :: FramebufferObject -> IO ()
bindFBO fb = bindFramebuffer Framebuffer $= fb
