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 import Control.Monad 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 -> Bool -- ^ whether to draw object shadows or not -> TextureObject -- ^ the texture object giving positions -> IO () createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do let llsShad = _lightingLineShadowShader pdata let lcShad = _lightingCapShader pdata let lwShad = _lightingWallShadShader pdata let ltShad = _lightingTextureShader 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 -- to consider: adding normals/a "material" for each fragment 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) when drawObjShads $ do --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 ltShad) uniform (head $ _shadUnis ltShad) $= Vector3 x y z uniform (_shadUnis ltShad !! 1) $= Vector4 r g b rad bindVertexArrayObject $= Just (_vao $ _shadVAO ltShad) glDrawArrays (marshalEPrimitiveMode (_shadPrim ltShad)) 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 :: Layer -> MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () renderLayer layer shads counts = do let layerCounts = UMV.slice (ln * numLayers) 6 counts MV.imapM_ (drawShaderLay ln layerCounts) shads where ln = layerNum layer bindTO :: TextureObject -> IO () bindTO t = textureBinding Texture2D $= Just t bindFBO :: FramebufferObject -> IO () bindFBO fb = bindFramebuffer Framebuffer $= fb