Cleanup createLightmap

src/Dodge/Render.hs

@@ -129,7 +129,7 @@ doDrawing pdata w = do
     -- this is not ideal if the original is not divisible by 2
 
     bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-    createLightMap pdata lightPoints nWalls nSils nsurfVs 
+    createLightMap pdata lightPoints nWalls nSils
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     clearColor $= Color4 0 0 0 0
 

src/Render.hs

@@ -1,4 +1,12 @@
 module Render
+    ( createLightMap
+    , divideSize
+    , renderFoldable
+    , renderLayer
+    , pingPongBetween
+    , bindTO
+    , bindFBO
+    )
   where
 import Shader
 import Shader.Data
@@ -8,9 +16,9 @@ import Picture.Data
 import Geometry.Data
 
 --import Data.Foldable
-import Foreign hiding (rotate)
+--import Foreign hiding (rotate)
 import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
-import qualified SDL
+--import qualified SDL
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import Control.Monad.Primitive
@@ -19,8 +27,8 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS
 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
 
-sizeToTexSize :: Size -> TextureSize2D
+--sizeToTexSize :: Size -> TextureSize2D
-sizeToTexSize (Size x y) = TextureSize2D x y
+--sizeToTexSize (Size x y) = TextureSize2D x y
 
 {- | Determine where light is shining in the world.  -}
 createLightMap 
@@ -28,41 +36,21 @@ createLightMap
     -> [(Point3,Float,Point3)]             -- Lights
     -> Int -- ^ number of walls
     -> Int -- ^ number of silhoutte lines to draw
-    -> Int -- ^ number of surface triangles to draw
     -> IO ()
-createLightMap pdata lightPoints nWalls nSils nsurfVs = do
+createLightMap pdata lightPoints nWalls nSils = do
-    depthFunc $= Just Less
+    -- we assume that the renderbuffer's depth has been correctly set elsewhere
-    -- clear buffer to full alpha and furthest depth
+    -- we will not be changing that here
-    -- clearColor is specified in preloadRender
+    depthMask $= Disabled
+    -- clearColor is specified differently in preloadRender
     clearColor $= Color4 1 1 1 1
     clear [ColorBuffer]
-    -- we assume that the renderbuffer's depth has been correctly set elsewhere
---    clear [ColorBuffer,DepthBuffer]
---    --colorMask $= Color4 Disabled Disabled Disabled Disabled
---    cullFace $= Just Back
---    cullFace $= Nothing
---    -- we assume that the camera position uniforms have been correctly set elsewhere
---    -- draw wall surfaces from the camera's point of view in order to set z buffer
---    drawShader (_lightingWallShader pdata) nWalls
---    -- draw foreground elements the camera's your point of view to set z buffer
---    drawShader (_lightingSurfaceShader pdata) nsurfVs 
---    -- draw wall occlusions from the camera's point of view
---    drawShader (_lightingOccludeShader pdata) nWalls
---    --hypothesis: the above three draw calls only work because the
---    --uniform was set to your position, that being the last light source in the list
---    --if this hypothesis is correct, then the code is brittle and should be changed
-    
     -- 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
-    depthMask $= Disabled
     blendFunc $= (Zero, OneMinusSrcColor)
     stencilTest $= Enabled
-    --depthFunc $= Just Lequal
     flip VS.mapM_ (VS.fromList lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do
-    --forM_ lightPoints $ \(V3 x y z,r,lum) -> do
-        -- the use of Less is for caps on geometry
         depthFunc $= Just Less
         -- stencil out shadows
         colorMask $= Color4 Disabled Disabled Disabled Disabled
@@ -71,30 +59,23 @@ createLightMap pdata lightPoints nWalls nSils nsurfVs = do
         stencilOpSeparate Front $= (OpKeep,OpKeep,OpIncrWrap)
         stencilOpSeparate Back  $= (OpKeep,OpKeep,OpDecrWrap)
         stencilFunc $= (Always, 0, 255)
+        --draw wall whadows
         currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
         uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector3 x y z
         drawShader (_lightingOccludeShader pdata) nWalls
-
+        --draw silhouette shadows
-        --stencilOp $= (OpKeep,OpDecr,OpKeep)
---        stencilOpSeparate Front $= (OpKeep,OpDecrWrap,OpKeep)
---        stencilOpSeparate Back  $= (OpKeep,OpIncrWrap,OpKeep)
         currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
         uniform (head $  _shaderCustomUnis $ _lightingLineShadowShader pdata)
             $= Vector3 x y z
---        depthClamp $= Enabled
         drawShader (_lightingLineShadowShader pdata) nSils
---        depthClamp $= Disabled
-
         cullFace $= Just Back
-        --stencilOp  $= (OpKeep,OpDecrWrap,OpKeep)
+        --draw caps on the near plane as required
         currentProgram $= Just (_shaderProgram $ _lightingCapShader pdata)
         uniform (head $  _shaderCustomUnis $ _lightingCapShader pdata)
             $= Vector3 x y z
---        depthClamp $= Enabled
         drawShader (_lightingCapShader pdata) (nSils - 6)
---        depthClamp $= Disabled
+        --draw lightmap itself
-
         depthFunc $= Just Always
         cullFace $= Nothing
         bindTO $ snd $ snd $ _fboBase pdata
@@ -107,42 +88,9 @@ createLightMap pdata lightPoints nWalls nSils nsurfVs = do
         uniform (_shaderCustomUnis (_fullLightingShader pdata) !! 1)
             $= Vector4 r g b rad
         drawShader (_fullLightingShader pdata) 4
-
+    --cleanup: may not be necessary, depending on what comes after...
---        -- use Lequal to redraw surfaces above already drawn surfaces
---        depthFunc $= Just Lequal
---        -- draw geometry surfaces
---        --cullFace $= Just Back
---        cullFace $= Nothing
---        --colorMask $= Color4 Disabled Disabled Disabled Enabled
---        colorMask $= Color4 Enabled Enabled Enabled Enabled
---        stencilOp $= (OpKeep,OpKeep,OpKeep)
---        stencilFunc $= (Equal, 0, 255)
---        currentProgram $= Just (_shaderProgram $ _lightingSurfaceShader pdata)
---        uniform (head $  _shaderCustomUnis $ _lightingSurfaceShader pdata)
---            $= Vector3 x y z
---        uniform (_shaderCustomUnis (_lightingSurfaceShader pdata) !! 1)
---            $= Vector4 r g b rad
---        drawShader (_lightingSurfaceShader pdata) nsurfVs 
---        -- draw wall light "circles"
---        currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
---        uniform (head $ _shaderCustomUnis $ _lightingWallShader pdata)
---            $= Vector3 x y z
---        uniform (_shaderCustomUnis (_lightingWallShader pdata) !! 1)
---            $= Vector4 r g b rad
---        drawShader (_lightingWallShader pdata) nWalls
     cullFace $= Nothing
     stencilTest $= Disabled
-{- | Blur between two framebuffers.
-Assumes no depth testing is done -}
-pingPongBlur :: RenderData -> IO ()
-pingPongBlur pdata = do
-    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
-    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
-    drawShader (_bloomBlurShader pdata) 4
-
-    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
-    textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
-    drawShader (_bloomBlurShader pdata) 4
 -- assumes that vertices have already been sent to the shader
 pingPongBetween 
     :: (FramebufferObject,TextureObject)
@@ -153,21 +101,10 @@ 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
 
-drawTextureOnFramebuffer
-    :: FullShader
-    -> FramebufferObject
-    -> TextureObject
-    -> IO ()
-drawTextureOnFramebuffer fs fbo to = do
-    bindFramebuffer Framebuffer $= fbo
-    textureBinding Texture2D $= Just to
-    drawShader fs 4
-
 renderFoldable
     :: MV.MVector (PrimState IO) FullShader
     -> Picture
@@ -177,17 +114,6 @@ renderFoldable shadV struct = do
     pokeBindFoldable shadV counts struct
     MV.imapM_ (drawShaderLay 0 counts) shadV
 
-renderFoldableTimed
-    :: MV.MVector (PrimState IO) FullShader
-    -> Picture
-    -> IO Word32
-renderFoldableTimed shadV struct = do
-    pokeStartTicks <- SDL.ticks
-    counts <- UMV.replicate 6 0
-    pokeBindFoldable shadV counts struct
-    MV.imapM_ (drawShaderLay 0 counts) shadV
-    pokeEndTicks <- SDL.ticks
-    return $ pokeEndTicks - pokeStartTicks
 ------------------------------end renderFoldable
 renderLayer 
     :: Int 
@@ -198,33 +124,6 @@ renderLayer layer shads counts = do
     let layerCounts = UMV.slice (layer * 6) 6 counts
     MV.imapM_ (drawShaderLay layer layerCounts) shads
 
-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
-
 bindTO :: TextureObject -> IO ()
 bindTO t = textureBinding Texture2D $= Just t
 

src/Shader/Poke.hs

@@ -88,6 +88,33 @@ pokeArrayOff :: Ptr Float -> Int -> [Float] -> IO ()
 {-# INLINE pokeArrayOff #-}
 pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))
 
+--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
+
 pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
 pokePoint33s ptr vals0 = go vals0 0
   where