Partially implement a framebuffer object for bluring shadows

shader/background.vert

@@ -1,6 +1,6 @@
 #version 430 core
 layout (location = 0) in vec4 params;
-layout (location = 1) in vec2 winSizea;
+layout (location = 1) in vec2 texCoor;
 out vec4 vParams;
 out vec2 vWinSize;
 

shader/fullscreen.frag

@@ -0,0 +1,11 @@
+#version 430 core
+in vec2 vTexPos;
+out vec4 fColor;
+
+uniform sampler2D screenTexture;
+
+void main()
+{
+    fColor = texture(screenTexture, vTexPos);
+//    fColor = vec4(1,1,1,0);
+}

shader/fullscreen.vert

@@ -0,0 +1,10 @@
+#version 430 core
+layout (location = 0) in vec2 pos;
+layout (location = 1) in vec2 texPos;
+out vec2 vTexPos;
+
+void main()
+{
+  gl_Position = vec4(pos,0,1);
+  vTexPos = texPos;
+}

src/Dodge/Base.hs

@@ -524,10 +524,8 @@ reflectCircCreature rad p1 p2 cr =
         Just p3 -> Just ( p1
                         , errorNormalizeV 37 (ssaTriPoint p2 (_crPos cr) p1 (_crRad cr) -.- _crPos cr) 
                             +.+ (_crPos cr -.- _crOldPos cr)
-                        --, errorNormalizeV 38 $ 
-                        --  ssaTriPoint p1 (_crPos cr) p2 (_crRad cr)
-                        --     -.- _crOldPos cr
-                        , _crID cr)
+                        , _crID cr
+                        )
 
 reflectCircCreatures :: Float -> Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Point2,Int)
 reflectCircCreatures rad p1 p2 cs = listToMaybe $ sortBy f $ IM.elems $ IM.mapMaybe

src/Dodge/Item/Weapon.hs

@@ -353,10 +353,13 @@ maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef
         itRef = _crInvSel cr
 
 shootBezier :: Point2 -> Int -> World -> World
-shootBezier targetp cid w = (shootWithSound 0 . withMuzFlare . withRecoil 40 . torqueBefore 0.05
-                                . withRandomDir 0.5)
-                                bezBul cid w
+shootBezier targetp cid w = (shootWithSound 0 
+                            . withMuzFlare 
+                            . withRecoil 40 
+                            . torqueBefore 0.05 
+                            ) bezBul cid w
     where
+-- note that torqueBefore will not affect the startp here
         bezBul = mkBezierBul startp controlp targetp
         controlp = mouseWorldPos w
         cr = _creatures w IM.! cid
@@ -370,7 +373,7 @@ mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
                                 (threeEff' bulHitCr' bulHitWall' bulHitFF') 5
         (randPos,randPos') = flip evalState (_randGen w) 
                                     $ do a <- randInCirc 10
-                                         b <- randInCirc 10
+                                         b <- randInCirc 20
                                          return (a,b)
 
 removeItAttachment :: Int -> Int -> World -> World

src/Dodge/Item/Weapon/TriggerType.hs

@@ -60,8 +60,6 @@ withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
                              (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
                              cr
           (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
-          
-          
 
 shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
 shootWithSound soundid f cid w

src/Dodge/WorldActions/Bullet.hs

@@ -105,9 +105,12 @@ mvGenBullet' w bt
 
 bulLineLen :: Int -> Color -> Float -> [Point2] -> Picture
 bulLineLen n c w ps = 
-    setLayer 1 . onLayer HPtLayer $ color c $ thickLine (take (n * 3) ps) w
+    setLayer 1 . onLayer HPtLayer $ color c $ thickLine (take (n * 2) ps) w
 
-bulLine c w = setLayer 1 . bulLinea c w
+bulLine c w = setLayer 1 . bulLineb w
+
+bulLineb :: Float -> [Point2] -> Picture
+bulLineb w ps = color white $ thickLine (take 2 ps) w
 
 bulLinea :: Color -> Float -> [Point2] -> Picture
 bulLinea _ _ [] = blank

src/Dodge/WorldActions/ThingsHit.hs

@@ -18,7 +18,9 @@ thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine
           crNotCid _ = True
 
 thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
-thingsHitLongLine sp ep w = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
+thingsHitLongLine sp ep w 
+        | sp == ep  = []
+        | otherwise = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
     where 
           crs  = zip crPs (map E3x1 hitCrs)
           hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
@@ -34,7 +36,9 @@ thingsHitLongLine sp ep w = sortBy (compare `on` dist sp . fst) (crs ++  walls +
           ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
 
 thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
-thingsHit sp ep w = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
+thingsHit sp ep w 
+        | sp == ep  = []
+        | otherwise = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
     where 
           hitCrs   = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
                                             $ _creatures w

src/Picture/Preload.hs

@@ -18,13 +18,18 @@ import Shader
 
 import Geometry (Point2)
 
+import qualified Control.Foldl as F
+
 data RenderData = RenderData
     { _lightSourceShader :: FullShader (Float,Float,Float,Float)
     , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
+    , _fullscreenShader  :: FullShader ()
     , _listShaders :: [FullShader RenderType]
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
+    , _spareFBO :: FramebufferObject
+    , _fboTexture :: TextureObject
     }
 
 makeLenses ''RenderData
@@ -52,6 +57,16 @@ preloadRender = do
     bezierQuadShader
            <- makeShader "bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)]    TriangleStrip pokeBezQStrat
 
+    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip 
+                                (const [[[-1, 1],[0,1]]
+                                       ,[[ 1, 1],[1,1]]
+                                       ,[[-1,-1],[0,0]]
+                                       ,[[ 1,-1],[1,0]]
+                                       ]
+                                 )
+    n <- F.foldM (pokeShader fsShad) [()]
+    putStrLn $ show n
+
 --the following vbo is set up to contain one fixed vertex
     dummyvbo <- genObjectName
     dummyptr <- mallocArray numDrawableElements
@@ -62,6 +77,10 @@ preloadRender = do
 -- input a list of (attribute location, attrib length) pairs
 -- these will have buffers and pointers created
     backgroundvao <- setupVAO [(0,4),(1,2)]
+
+    (fbo,fboTO) <- setupFramebuffer
+
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
     
     return $ RenderData
         { _listShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
@@ -70,10 +89,37 @@ preloadRender = do
         , _lightSourceShader = lsShad
         , _wallShadowShader  = wsShad
         , _backgroundShader  = bgShad
+        , _fullscreenShader  = fsShad
+        , _spareFBO = fbo
+        , _fboTexture = fboTO
         }
 
 
 --------------------end preloadRender
+
+setupFramebuffer :: IO (FramebufferObject, TextureObject)
+setupFramebuffer = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+
+    fboTO <- genObjectName
+    textureBinding Texture2D $= Just fboTO
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
+
+    fboRBO <- genObjectName
+    bindRenderbuffer Renderbuffer $= fboRBO
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
+                                    -- not sure if the stencil is needed
+
+    fboStatus <- framebufferStatus Framebuffer
+    putStrLn $ show fboStatus
+
+    return (fboName, fboTO)
+
+
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload pd = do
     mapM_ freeShaderPointers $ _listShaders pd

src/Picture/Render.hs

@@ -49,6 +49,12 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         )
 
 -- draw lightmap
+
+    bindFramebuffer Framebuffer $= (_spareFBO pdata)
+    clearColor $= Color4 0 0.5 0 1
+    clearDepth $= (200)
+    clear [ColorBuffer]
+
     nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
@@ -78,10 +84,24 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     ticksS <- SDL.ticks
     ticksAfterL <- SDL.ticks
 
+    blend $= Disabled
+
+--    blendFunc $= (Zero,One)
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
+--
+--    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
+    bindShaderBuffers [_fullscreenShader pdata] [4]
+    textureBinding Texture2D $= Just (_fboTexture pdata)
+--    blendFunc $= (One, Zero)
+    drawShader (_fullscreenShader pdata) 4
+
+    blend $= Enabled
+
 -- draw picture on top of light/shadow map
 -- set drawing for on top
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
     clear [DepthBuffer]
+
 -- draw background
     bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
     depthFunc $= Just Less