Implement different shadow resolutions

shader/lighting/floor.geom

@@ -11,7 +11,7 @@ uniform mat4 worldMat;
 void main()
 {
   lum = gl_in[0].gl_Position.w;
-  vec2 cenPos = vec2( gl_in[0].gl_Position.x / 2, gl_in[0].gl_Position.y / 2);
+  vec4 cenPos = worldMat * vec4( gl_in[0].gl_Position.xy, 0 , 1);
   float gRad = gl_in[0].gl_Position.z * zoom * 2;
 
   dField = vec2 ( 1, 1);

src/Dodge/Config/Data.hs

@@ -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_master   :: Float
-  , _volume_sound    :: Float
+    , _volume_sound    :: Float
-  , _volume_music    :: Float
+    , _volume_music    :: Float
-  , _wall_textured   :: Bool
+    , _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

@@ -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

@@ -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

@@ -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 (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms pmat
-    createLightMap pdata rot zoom trans wins 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

@@ -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"
+        ["N - NEW LEVEL"
-        ,"r - RESTART"
+        ,"R - RESTART"
-        ,"o - OPTIONS"
+        ,"O - OPTIONS"
-        ,"c - CONTROLS"
+        ,"C - CONTROLS"
         ]
     (GameOverMenu:_) -> optionsList hw hh "GAME OVER" 
-        ["n - NEW LEVEL"
+        ["N - NEW LEVEL"
-        ,"r - RESTART"
+        ,"R - RESTART"
-        ,"o - OPTIONS"
+        ,"O - OPTIONS"
-        ,"c - CONTROLS"
+        ,"C - CONTROLS"
         ]
     (OptionMenu : _) -> optionsList hw hh "OPTIONS" 
-        ["v - VOLUME"
+        ["V - VOLUME"
-        ,"g - GRAPHICS"
+        ,"G - GRAPHICS"
         ]
     (SoundOptionMenu : _) -> optionsList hw hh "OPTIONS:VOLUME" 
-        ["y - MASTER VOLUME + u : " ++ mavol
+        ["Y - MASTER VOLUME + U : " ++ mavol
-        ,"h - SOUND  VOLUME + j : " ++ snvol
+        ,"H - SOUND  VOLUME + J : " ++ snvol
-        ,"n - MUSIC  VOLUME + m : " ++ muvol
+        ,"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

@@ -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
+    -> Int                  -- Resolution division
-    -> Float                -- Zoom
-    -> (Float,Float)        -- Translation
-    -> (Float,Float)        -- Window size
     -> [(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)
+        pokeFourOff lightPtr 0 (x,y,r,lum)
-            zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy)
-        pokeFourOff lightPtr 0 (x',y',r,lum)
 -- stencil out walls
         colorMask $= Color4 Disabled Disabled Disabled Disabled
         clear [StencilBuffer]

src/Preload/Update.hs

@@ -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
+        xsize' = fromIntegral $ xsize
-        ysize' = fromIntegral $ ysize `div` 2
+        ysize' = fromIntegral $ ysize
     bindFramebuffer Framebuffer $= fboName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)