Partially implement a framebuffer object for bluring shadows

This commit is contained in:
jgk
2021-03-16 20:27:05 +01:00
parent 76a4731785
commit 3707954913
10 changed files with 108 additions and 15 deletions
+2 -4
View File
@@ -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
+7 -4
View File
@@ -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
-2
View File
@@ -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
+5 -2
View File
@@ -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
+6 -2
View File
@@ -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
+46
View File
@@ -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
+20
View File
@@ -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