diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 1fa2fb845..c8452ea93 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -23,6 +23,7 @@ import qualified Control.Foldl as F data RenderData = RenderData { _lightSourceShader :: FullShader (Float,Float,Float,Float) , _wallShadowShader :: FullShader (Point2,Point2,Point2,Point2) + , _wallLightShader :: FullShader (Point3) , _backgroundShader :: FullShader (Point2,Point2,Point2,Point2) , _fullscreenShader :: FullShader () , _wallShader :: FullShader (Point3,Point4) @@ -47,6 +48,9 @@ preloadRender = do wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat ["lightPos"] + wlLightShad <- makeShaderCustomUnis "wallLight" [vert,frag] [(0,3)] TriangleStrip pokeLightWallStrat + ["lightPosRadLum"] + wlShad <- makeShader "wall" [vert,frag] [(0,3),(1,4)] TriangleStrip pokeWlStrat bslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat @@ -91,6 +95,7 @@ preloadRender = do , _dummyPtr = dummyptr , _lightSourceShader = lsShad , _wallShadowShader = wsShad + , _wallLightShader = wlLightShad , _wallShader = wlShad , _backgroundShader = bgShad , _fullscreenShader = fsShad @@ -116,7 +121,6 @@ setupFramebuffer = do fboRBO <- genObjectName bindRenderbuffer Renderbuffer $= fboRBO renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) - -- not sure if the stencil is needed framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO fboStatus <- framebufferStatus Framebuffer @@ -170,6 +174,9 @@ frag = FragmentShader pokeWPStrat :: (Point2,Point2,Point2,Point2) -> [[[Float]]] pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w],[a,b,c,d]]] +pokeLightWallStrat :: Point3 -> [[[Float]]] +pokeLightWallStrat (x,y,z) = [[[x,y,z]]] + pokeBGStrat :: a -> [[[Float]]] pokeBGStrat = const [] diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index b044928b3..627b84c14 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -44,6 +44,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p setShaderUniforms rot zoom (tranx,trany) (winx,winy) ( (extractProgAndUnis $ _lightSourceShader pdata) : (extractProgAndUnis $ _wallShadowShader pdata) + : (extractProgAndUnis $ _wallLightShader pdata) : (extractProgAndUnis $ _wallShader pdata) : (extractProgAndUnis $ _backgroundShader pdata) : (map extractProgAndUnis $ _listShaders pdata) @@ -52,7 +53,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p -- draw lightmap bindFramebuffer Framebuffer $= (_spareFBO pdata) - depthFunc $= Just Less + depthFunc $= Just Always clearColor $= Color4 0 0.5 0 1 clearDepth $= (200) clear [ColorBuffer] @@ -61,10 +62,21 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints bindShaderBuffers [_wallShadowShader pdata] [nWalls] +-- let f (x,y) = (x,y,0) +-- h (x,y) = (x,y,-1) +-- g (a,b,_,_) = [f a,f a,h a,f b,h b,h b] +-- wp = concatMap g wallPoints +-- nLightWalls <- F.foldM (pokeShader (_wallLightShader pdata)) wp +-- bindShaderBuffers [_wallLightShader pdata] [nLightWalls] + + stencilTest $= Enabled forM_ lightPoints $ \(x,y,r,lum) -> do cullFace $= Just Front - clear [DepthBuffer] + clear [DepthBuffer,StencilBuffer] + stencilOp $= (OpKeep,OpKeep,OpReplace) + + stencilFunc $= (Always, 1, 255) -- currentProgram does get called twice: here and inside drawShader below currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata) uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) @@ -80,7 +92,18 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p bindShaderBuffers [_lightSourceShader pdata] [1] blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha)) + stencilFunc $= (Notequal, 1, 255) drawShader (_lightSourceShader pdata) 1 + +-- currentProgram $= Just (_shaderProgram $ _wallLightShader pdata) +-- uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata) +-- $= Vector4 x y r lum +-- cullFace $= Just Front +-- depthFunc $= Just Lequal +-- drawShader (_wallLightShader pdata) nLightWalls + + cullFace $= Nothing + stencilTest $= Disabled startWallTicks <- SDL.ticks wallPokeEnd <- SDL.ticks @@ -132,22 +155,38 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic bticks <- SDL.ticks --- render walls - blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - -- poke data - let lights = map (\(x,y,r,g) -> ((x,y),(r,g,0,0))) lightPoints - wallPairs = map (\(a,b,_,_) -> [(a,(1,1,1,1)),(b,(1,1,1,1))]) wallPoints - f (x,y) = [(x,y,0),(x,y,0),(x,y,-1)] - g (x,y) = [(x,y,0),(x,y,-1),(x,y,-1)] - wp = concatMap (\(a,b,_,_) -> f a ++ g b) wallPoints - h p = (p,(1,0,0,1)) - i <- F.foldM (pokeShader (_wallShader pdata)) $ map h wp +-- -- render walls +-- depthFunc $= Nothing +-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) +-- -- poke data +-- let lights = map (\(x,y,r,g) -> ((x,y),(r,g,0,0))) lightPoints +-- wallPairs = map (\(a,b,_,_) -> [(a,(1,1,1,1)),(b,(1,1,1,1))]) wallPoints +-- f (x,y) = [(x,y,0),(x,y,0),(x,y,-1)] +-- g (x,y) = [(x,y,0),(x,y,-1),(x,y,-1)] +-- wp = concatMap (\(a,b,_,_) -> f a ++ g b) wallPoints +-- h p = (p,(1,0,0,1)) +-- i <- F.foldM (pokeShader (_wallShader pdata)) $ map h wp +-- +-- -- bind buffers +-- bindShaderBuffers [_wallShader pdata] [i] +-- +-- -- draw call +-- drawShaders [_wallShader pdata] [i] +-- depthFunc $= Just Lequal - -- bind buffers - bindShaderBuffers [_wallShader pdata] [i] - - -- draw call - drawShaders [_wallShader pdata] [i] +------ blendFunc $= (One,Zero) +------ let f (x,y) = (x,y,0) +------ h (x,y) = (x,y,-1) +------ g (a,b) = [f a,f a,h a,f b,h b,h b] +------ wp = concatMap g [((200,200),(-200,200))] +------ nLightWalls <- F.foldM (pokeShader (_wallLightShader pdata)) wp +------ bindShaderBuffers [_wallLightShader pdata] [nLightWalls] +------ currentProgram $= Just (_shaderProgram $ _wallLightShader pdata) +------ uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata) +------ $= Vector4 (0::Float) 0 200 0.5 +------ cullFace $= Just Front +------ depthFunc $= Just Lequal +------ drawShader (_wallLightShader pdata) nLightWalls resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)