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

Implement different shadow resolutions

Browse Source
This commit is contained in:
jgk
2021-04-28 23:16:42 +02:00
parent 8cb177a21c
commit 750a67ea6e
8 changed files with 63 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Config/Data.hs
+8 -5
View File
@@ -8,6 +8,7 @@ module Dodge.Config.Data (
, volume_sound
, volume_music
, wall_textured
, shadow_resolution
) where
import Data.Aeson
@@ -19,11 +20,12 @@ import System.Directory
import Control.Lens
data Configuration = Configuration
{ _volume_master :: Float
, _volume_sound :: Float
, _volume_music :: Float
, _wall_textured :: Bool
}
{ _volume_master :: Float
, _volume_sound :: Float
, _volume_music :: Float
, _wall_textured :: Bool
, _shadow_resolution :: Int -- ^ Higher values divide the screen size, i.e. make the resolution worse
}
deriving (Generic, Show)
makeLenses ''Configuration
@@ -38,5 +40,6 @@ defaultConfig = Configuration
, _volume_sound = 1
, _volume_music = 1
, _wall_textured = False
, _shadow_resolution = 1
}
src/Dodge/Event.hs
+8 -2
View File
@@ -20,6 +20,7 @@ import Dodge.Base
import Dodge.Creature.Action
import Dodge.SoundLogic
import Dodge.Inventory
import Dodge.Config.Data
import Geometry
import Preload.Update
@@ -66,13 +67,18 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
| otherwise -> Just w
_ -> Just w
{-
Resets the world window size, and resizes the fbo that gets the light map drawn into it.
-}
handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
handleResizeEvent sev = Just
handleResizeEvent sev w = Just
. set windowX (fromIntegral x)
. set windowY (fromIntegral y)
. over sideEffects ( resizeSpareFBO (fromIntegral x) (fromIntegral y) : )
$ over sideEffects ( resizeSpareFBO (fromIntegral x `div` divRes) (fromIntegral y `div` divRes) : )
w
where
V2 x y = windowSizeChangedEventSize sev
divRes = w ^. config . shadow_resolution
handlePressedMouseButton :: MouseButton -> World -> Maybe World
handlePressedMouseButton but w
src/Dodge/Event/Menu.hs
+14 -1
View File
@@ -9,6 +9,7 @@ import Dodge.SoundLogic
import Dodge.Config.Data
import Dodge.Config.Update
import Dodge.Layout
import Preload.Update
import Data.Maybe
import qualified Data.Set as S
@@ -49,7 +50,8 @@ handlePressedKeyInMenu mState scode w = case mState of
ScancodeM -> Just $ sw & config . volume_music %~ inc
_ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :)
GraphicsOptionMenu -> case scode of
ScancodeW -> Just $ w & config . wall_textured %~ not
ScancodeW -> Just $ w & config . wall_textured %~ not
ScancodeS -> Just $ updateFramebufferSize $ w & config . shadow_resolution %~ cycleResolution
_ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :)
ControlList -> Just $ w & menuLayers %~ tail
_ -> Just w
@@ -68,6 +70,17 @@ handlePressedKeyInMenu mState scode w = case mState of
& windowX .~ _windowX w
& windowY .~ _windowY w
updateFramebufferSize :: World -> World
updateFramebufferSize w = w & sideEffects
%~ (resizeSpareFBO (ceiling x `div` divRes) (ceiling y `div` divRes) : )
where
(x,y) = (_windowX w, _windowY w)
divRes = w ^. config . shadow_resolution
cycleResolution 1 = 2
cycleResolution 2 = 4
cycleResolution 4 = 1
storeLevel :: World -> World
storeLevel w = case _storedLevel w of
Nothing -> w & storedLevel ?~ w
src/Dodge/Render.hs
+2 -3
View File
@@ -51,8 +51,7 @@ doDrawing pdata w = do
depthFunc $= Just Less
pmat <- (newMatrix RowMajor $ perspectiveMatrix rot zoom trans wins viewFroms)
:: IO (GLmatrix GLfloat)
-- pmat2 <- (newMatrix RowMajor $ perspectiveMatrix $ halfwindow w) :: IO (GLmatrix GLfloat)
createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms pmat
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-- clear [DepthBuffer]
depthFunc $= Just Always
@@ -62,7 +61,7 @@ doDrawing pdata w = do
then renderTextureWalls pdata wallPointsCol pmat
else renderBlankWalls pdata wallPointsCol pmat
-- I believe a more apt name would be setCeilingDepth
-- setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
-- depthFunc $= Just Lequal
renderFoldable pdata $ picToLTree (Just 0) pic
-- reset blend so that light map doesn't apply
src/Dodge/Render/MenuScreen.hs
+16 -14
View File
@@ -21,28 +21,29 @@ menuScreen cfig hw hh mLays = case mLays of
[] -> blank
(LevelMenu x:_) -> optionsList hw hh ("LEVEL"++show x) []
(PauseMenu:_) -> optionsList hw hh "PAUSED"
["n - NEW LEVEL"
,"r - RESTART"
,"o - OPTIONS"
,"c - CONTROLS"
["N - NEW LEVEL"
,"R - RESTART"
,"O - OPTIONS"
,"C - CONTROLS"
]
(GameOverMenu:_) -> optionsList hw hh "GAME OVER"
["n - NEW LEVEL"
,"r - RESTART"
,"o - OPTIONS"
,"c - CONTROLS"
["N - NEW LEVEL"
,"R - RESTART"
,"O - OPTIONS"
,"C - CONTROLS"
]
(OptionMenu : _) -> optionsList hw hh "OPTIONS"
["v - VOLUME"
,"g - GRAPHICS"
["V - VOLUME"
,"G - GRAPHICS"
]
(SoundOptionMenu : _) -> optionsList hw hh "OPTIONS:VOLUME"
["y - MASTER VOLUME + u : " ++ mavol
,"h - SOUND VOLUME + j : " ++ snvol
,"n - MUSIC VOLUME + m : " ++ muvol
["Y - MASTER VOLUME + U : " ++ mavol
,"H - SOUND VOLUME + J : " ++ snvol
,"N - MUSIC VOLUME + M : " ++ muvol
]
(GraphicsOptionMenu : _) -> optionsList hw hh "OPTIONS:GRAPHICS"
["w - WALL TEXTURES:" ++ show (_wall_textured cfig)
["W - WALL TEXTURES:" ++ show (_wall_textured cfig)
,"S - SHADOW RESOLUTION:" ++ showShadRes (_shadow_resolution cfig)
]
(ControlList : _) -> pictures
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
@@ -57,6 +58,7 @@ menuScreen cfig hw hh mLays = case mLays of
snvol = f $ _volume_sound $ cfig
muvol = f $ _volume_music $ cfig
f x = show $ round $ 10 * x
showShadRes i = "1/"++ show i
optionsList
:: Float -- ^ Half screen width
src/Picture/Render.hs
+7 -13
View File
@@ -50,26 +50,22 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
endTicks <- SDL.ticks
return $ endTicks - startTicks
halfSize (Size x y) = Size (div x 2) (div y 2)
divideSize :: Int -> Size -> Size
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
createLightMap
:: RenderData
-> Float -- Rotation
-> Float -- Zoom
-> (Float,Float) -- Translation
-> (Float,Float) -- Window size
-> Int -- Resolution division
-> [(Point2,Point2)] -- Wall pairs
-> [Point4] -- Lights
-> (Float,Float) -- View from position
-> GLmatrix GLfloat
-> IO ()
createLightMap pdata rot zoom (tranx,trany) (winx',winy') wallPoints lightPoints
createLightMap pdata resDiv wallPoints lightPoints
(viewFromx,viewFromy) pmat = do
let winx = winx' / 2
winy = winy' / 2
(vppos,vpsize) <- get viewport
viewport $= (vppos, halfSize vpsize)
viewport $= (vppos, divideSize resDiv vpsize)
bindFramebuffer Framebuffer $= _spareFBO pdata
-- store wall and light positions into buffer
@@ -88,7 +84,7 @@ createLightMap pdata rot zoom (tranx,trany) (winx',winy') wallPoints lightPoints
depthFunc $= Just Less
-- draw walls from your point of view in order to set z buffer
colorMask $= Color4 Disabled Disabled Disabled Disabled
let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
-- let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata)
$= Vector2 viewFromx viewFromy
@@ -109,9 +105,7 @@ createLightMap pdata rot zoom (tranx,trany) (winx',winy') wallPoints lightPoints
-- bind buffer for floor light circle
let lightPtr = (\(_,ptr,_) -> ptr) $ head
$ _vaoBufferTargets $ _shaderVAO $ _lightingFloorShader pdata
(x',y') = zTran $ rotateV (negate rot) $ (x,y) -.- (tranx,trany)
zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy)
pokeFourOff lightPtr 0 (x',y',r,lum)
pokeFourOff lightPtr 0 (x,y,r,lum)
-- stencil out walls
colorMask $= Color4 Disabled Disabled Disabled Disabled
clear [StencilBuffer]
src/Preload/Update.hs
+7 -3
View File
@@ -7,15 +7,19 @@ import Graphics.Rendering.OpenGL
import Foreign
import Picture.Preload
resizeSpareFBO :: Int -> Int -> PreloadData a -> IO (PreloadData a)
resizeSpareFBO
:: Int -- ^ Width
-> Int -- ^ Height
-> PreloadData a
-> IO (PreloadData a)
resizeSpareFBO xsize ysize pdata = do
-- I am unsure how much of this needs to be bound...
let rdata = _renderData pdata
fboName = _spareFBO rdata
fboTO = _fboTexture rdata
fboRBO = _fboRenderbufferObject rdata
xsize' = fromIntegral $ xsize `div` 2
ysize' = fromIntegral $ ysize `div` 2
xsize' = fromIntegral $ xsize
ysize' = fromIntegral $ ysize
bindFramebuffer Framebuffer $= fboName
textureBinding Texture2D $= Just fboTO
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)