justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor lighting shaders

Browse Source
This commit is contained in:
jgk
2021-06-25 00:44:45 +02:00
parent 6320093473
commit b451953b99
13 changed files with 44 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
-1
View File
@@ -12,7 +12,6 @@ data RenderData = RenderData
, _lightingWallShader :: FullShader
, _wallBlankShader :: FullShader
, _wallTextureShader :: FullShader
, _backgroundShader :: FullShader
, _textureShader :: FullShader
, _textureArrayShader :: FullShader
, _fullscreenShader :: FullShader
src/Dodge/Creature/Inanimate.hs
+2 -2
View File
@@ -36,8 +36,8 @@ lampPic = pictures
[ setDepth 0 $ color white $ p
, setDepth (negate 0.1) $ color yellow $ p
, setDepth (negate 0.5) $ color green $ p
, setDepth (negate 0.7) $ color red $ p
, setDepth (negate 0.9) $ color blue $ p
, setDepth (negate 0.4) $ color red $ p
, setDepth (negate 0.2) $ color blue $ p
, setDepth (negate 1) $ color white $ p
]
where
src/Dodge/Render.hs
+4 -7
View File
@@ -51,7 +51,7 @@ doDrawing pdata w = do
wins = (getWindowX w,getWindowY w)
wallPointsCol = wallsPointsAndCols w
windowPoints = wallsWindows w
lightPoints = lightsForGloom' w
lightPoints = lightsForGloom w
viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
pic = worldPictures w
wallPoints = map fst wallPointsCol
@@ -63,16 +63,13 @@ doDrawing pdata w = do
-- draw the lightmap. Probably changes the bound framebufferObject
createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms
(foregroundPics w)
-- draw the background. Assumes that depth testing is not enabled or that
-- the depth buffer is ready to be drawn on
clear [DepthBuffer]
depthFunc $= Just Less
-- set blending to depend upon the alpha level already present
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
renderBackground pdata rot camzoom trans wins
_ <- renderShader (_textureArrayShader pdata) (_floorTiles w)
-- draw the walls
depthFunc $= Just Less
if w ^. config . wall_textured
then renderTextureWalls pdata wallPointsCol
else renderBlankWalls pdata wallPointsCol
src/Dodge/Render/Picture.hs
+5 -5
View File
@@ -217,8 +217,8 @@ wallsForShadows w = map _wlLine
. filter (not . _wlIsSeeThrough)
. IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
lightsForGloom' :: World -> [Point4]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
where getLS ls = ( fst $ _lsPos ls, snd $ _lsPos ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
lightsForGloom :: World -> [Point4]
lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
where
getLS ls = ( fst $ _lsPos ls, snd $ _lsPos ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
src/Loop.hs
+4 -9
View File
@@ -48,7 +48,6 @@ setupLoop
initParams
paramCleanup
$ doLoop window startWorld sideEffects eventFn worldFn
-- | The internal loop.
doLoop
:: Window -- ^ The SDL window.
@@ -81,7 +80,6 @@ doLoop
doLoop window updatedWorld worldSideEffects eventFn worldUpdate newParams
Nothing -> return ()
-- | Handle quit events in a manner to exit the loop. Other events handled as
-- determined by the custom function, although resize events also change the viewport.
applyEventIO :: (world -> Event -> Maybe world) -> Maybe world -> Event -> IO (Maybe world)
@@ -91,16 +89,13 @@ applyEventIO fn mw e = case eventPayload e of
WindowSizeChangedEvent WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y}
-> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e)
_ -> return $ mw >>= flip fn e
-- | Create an OpenGL SDL window configuration with a given x and y size.
winConfig :: Int -> Int -> WindowConfig
winConfig x y = defaultWindow
{ windowGraphicsContext
= OpenGLContext (defaultOpenGL { glProfile = Core Normal 4 3
, glColorPrecision = V4 8 8 8 8
}
)
{ windowGraphicsContext = OpenGLContext $ defaultOpenGL
{ glProfile = Core Normal 4 3
, glColorPrecision = V4 8 8 8 8
}
, windowInitialSize = V2 (fromIntegral x) (fromIntegral y)
, windowResizable =True
}
src/Picture/Render.hs
+1 -24
View File
@@ -73,10 +73,8 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
-- clear buffer to full alpha and furthest depth
clearColor $= Color4 0 0 0 1
clearDepth $= 1
-- clearColor is specified in preloadRender
clear [ColorBuffer,DepthBuffer]
depthFunc $= Just Less
-- draw walls from your point of view in order to set z buffer
colorMask $= Color4 Disabled Disabled Disabled Disabled
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
@@ -174,27 +172,6 @@ pingPongBlur pdata = do
generateMipmap' Texture2D
drawShader (_boxBlurShader pdata) 4
renderBackground
:: RenderData
-> Float -- Rotation
-> Float -- Zoom
-> (Float,Float) -- Translation
-> (Float,Float) -- Window size
-> IO ()
renderBackground pdata rot camZoom (tranx,trany) (winx,winy) = do
-- depthFunc $= Just Less
-- set drawing for on top
--blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-- draw background
--bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
bindArrayBuffers 1 $ _vaoVBO $ _shaderVAO $ _backgroundShader pdata
currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
let backPtr = _vboPointer $ _vaoVBO $ _shaderVAO $ _backgroundShader pdata
pokeArrayOff backPtr 0 [tranx,trany,rot,camZoom,winx,winy]
textureBinding Texture2D $= _textureObject <$> _shaderTexture (_backgroundShader pdata)
drawArrays Points 0 1
renderShader
:: Foldable f
=> FullShader
src/Preload/Render.hs
+4 -6
View File
@@ -49,10 +49,6 @@ preloadRender = do
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO boxBlurShad) $ concat cornerList
grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const cornerList
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList
-- background shader
bgShad <- makeShader "background" [vert,geom,frag] [4,2] Points pokeBGStrat
>>= addTexture "data/texture/marbleSlabs.png"
-- >>= addTexture "data/texture/smudgedDirt.png"
-- blank wallShader
wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] Points pokeWPColStrat
-- textured wallShader
@@ -70,6 +66,10 @@ preloadRender = do
framebuf3 <- setupFramebufferWithStencil
-- reset to default framebuffer, ready for drawing direct to screen
bindFramebuffer Framebuffer $= defaultFramebufferObject
-- set the clearColor to have 1 alpha
clearColor $= Color4 0 0 0 1
return $ RenderData
{ _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
, _lightingFloorShader = lightingFloorShad
@@ -79,7 +79,6 @@ preloadRender = do
, _wallTextureShader = wlTexture
, _textureShader = textShad
, _textureArrayShader = textArrayShad
, _backgroundShader = bgShad
, _fullscreenShader = fsShad
, _boxBlurShader = boxBlurShad
, _grayscaleShader = grayscaleShad
@@ -148,7 +147,6 @@ cleanUpRenderPreload pd = do
mapM_ freeShaderPointers $ _pictureShaders pd
freeShaderPointers $ _lightingFloorShader pd
freeShaderPointers $ _lightingOccludeShader pd
freeShaderPointers $ _backgroundShader pd
freeShaderPointers $ _fullscreenShader pd
{-# INLINE pokeBezQStrat #-}