loop/src/Render.hs

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

--import Data.Foldable
import Foreign hiding (rotate)
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
--import qualified SDL
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)

--sizeToTexSize :: Size -> TextureSize2D
--sizeToTexSize (Size x y) = TextureSize2D x y

{- | 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
    -- 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 $ _lightingOccludeShader pdata)
        uniform (head $  _shadUnis $ _lightingOccludeShader pdata)
            $= Vector3 x y z
        drawShader (_lightingOccludeShader pdata) nWalls
        --draw silhouette shadows
        let llss = _lightingLineShadowShader pdata
        currentProgram $= Just (_shadProg $ _lightingLineShadowShader pdata)
        uniform (head $  _shadUnis $ _lightingLineShadowShader pdata)
            $= Vector3 x y z
    --    drawShader (_lightingLineShadowShader pdata) nSils
        bindVertexArrayObject $= Just (_vao $ _shadVAO llss)
        glDrawElements
            (marshalEPrimitiveMode $ _shadPrim llss) 
            (fromIntegral nSils)
            (GL_UNSIGNED_SHORT)
            nullPtr
        cullFace $= Just Back

        --draw caps on the near plane as required
        currentProgram $= Just (_shadProg $ _lightingCapShader pdata)
        uniform (head $  _shadUnis $ _lightingCapShader pdata)
            $= Vector3 x y z
        -- TODO clean this up
        let fs = _lightingCapShader pdata
        bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
        glDrawElements
            (marshalEPrimitiveMode $ _shadPrim fs) 
            (fromIntegral nCaps)
            (GL_UNSIGNED_SHORT)
            nullPtr
        --drawShader (_lightingCapShader pdata) nCaps
        --draw lightmap itself
        depthFunc $= Just Always
        --cullFace $= Nothing
        bindTO toPos
        colorMask $= Color4 Enabled Enabled Enabled Enabled
        stencilOp $= (OpKeep,OpKeep,OpKeep)
        stencilFunc $= (Equal, 0, 255)
        currentProgram $= Just (_shadProg $ _fullLightingShader pdata)
        uniform (head $  _shadUnis $ _fullLightingShader pdata)
            $= Vector3 x y z
        uniform (_shadUnis (_fullLightingShader pdata) !! 1)
            $= Vector4 r g b rad
        drawShader (_fullLightingShader pdata) 4
    --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