diff --git a/shader/lighting/floor.frag b/shader/lighting/floor.frag index 7a6466b7e..c8e032fb9 100644 --- a/shader/lighting/floor.frag +++ b/shader/lighting/floor.frag @@ -1,5 +1,4 @@ #version 430 core -in vec2 cenPosT; in float lum; in vec2 dField; diff --git a/shader/lighting/floor.geom b/shader/lighting/floor.geom index f1f3d2615..c4bd5bca4 100644 --- a/shader/lighting/floor.geom +++ b/shader/lighting/floor.geom @@ -1,33 +1,34 @@ #version 430 core layout (points) in; layout (triangle_strip, max_vertices = 4) out; -in vec2 vParams []; out float lum; -out vec2 cenPosT; out vec2 dField; uniform vec2 winSize; uniform float zoom; +uniform mat4 worldMat; void main() { - lum = vParams[0].y; - vec3 cenPos = gl_in[0].gl_Position.xyz; - float gRad = vParams[0].x * zoom * 2; - - cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y); + lum = gl_in[0].gl_Position.w; + vec2 cenPos = vec2( gl_in[0].gl_Position.x / 2, gl_in[0].gl_Position.y / 2); + float gRad = gl_in[0].gl_Position.z * zoom * 2; dField = vec2 ( 1, 1); - gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, -0 , 1); + gl_Position + = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, -0 , 1); EmitVertex(); dField = vec2 (-1, 1); - gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, -0 , 1); + gl_Position + = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, -0 , 1); EmitVertex(); dField = vec2 ( 1,-1); - gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, -0 , 1); + gl_Position + = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, -0 , 1); EmitVertex(); dField = vec2 (-1,-1); - gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, -0 , 1); + gl_Position + = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, -0 , 1); EmitVertex(); EndPrimitive(); diff --git a/shader/lighting/floor.vert b/shader/lighting/floor.vert index 0498314fe..8637c6826 100644 --- a/shader/lighting/floor.vert +++ b/shader/lighting/floor.vert @@ -1,6 +1,6 @@ #version 430 core layout (location = 0) in vec4 position; -out vec2 vParams; +//out vec2 vParams; uniform vec2 winSize; uniform float zoom; @@ -10,6 +10,5 @@ uniform mat4 worldMat; void main() { - gl_Position = vec4(position.xy,0,1); - vParams = position.zw; + gl_Position = position; } diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index be509d4b2..1f9b8453e 100644 --- a/src/Dodge/Config/Data.hs +++ b/src/Dodge/Config/Data.hs @@ -7,6 +7,7 @@ module Dodge.Config.Data ( , volume_master , volume_sound , volume_music + , wall_textured ) where import Data.Aeson @@ -21,6 +22,7 @@ data Configuration = Configuration { _volume_master :: Float , _volume_sound :: Float , _volume_music :: Float + , _wall_textured :: Bool } deriving (Generic, Show) @@ -35,5 +37,6 @@ defaultConfig = Configuration { _volume_master = 1 , _volume_sound = 1 , _volume_music = 1 + , _wall_textured = False } diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 3409e5e42..32be4abcb 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -49,7 +49,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 - _ -> popMenu w + ScancodeW -> Just $ w & config . wall_textured %~ not + _ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :) ControlList -> Just $ w & menuLayers %~ tail _ -> Just w where @@ -58,10 +59,8 @@ handlePressedKeyInMenu mState scode w = case mState of startLevel = unpause . storeLevel dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) - pushMenu ml w = Just $ w & menuLayers %~ (ml :) - popMenu w = Just $ w & menuLayers %~ tail - goToOptionMenu w = Just $ w & menuLayers %~ (OptionMenu :) - goToControls w = Just $ w & menuLayers %~ (ControlList :) + pushMenu ml w = Just $ w & menuLayers %~ (ml :) + popMenu w = Just $ w & menuLayers %~ tail sw = w & sideEffects %~ (setVol (_config w) : ) startNewGame = Just $ generateFromList levx $ initialWorld diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 99aab535f..4794ae9c4 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -4,6 +4,7 @@ module Dodge.Render ) where import Dodge.Data +import Dodge.Config.Data import Dodge.Base import Dodge.Render.HUD import Dodge.Render.MenuScreen @@ -15,22 +16,23 @@ import Picture.Render import Picture.Preload import Shader -import Data.Graph.Inductive.Query.DFS -import Data.Graph.Inductive.Graph +import Foreign (Word32) +import Control.Applicative import Control.Monad.State +import Control.Lens +import qualified Control.Foldl as F +import Data.Maybe import Data.List import Data.Bifunctor import Data.Function -import Foreign (Word32) -import Control.Applicative -import Control.Lens -import Data.Maybe import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import qualified Data.Set as S import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) import qualified SDL +halfwindow = over windowX ( / 2) . over windowY ( / 2) + doDrawing :: RenderData -> World -> IO (Word32) doDrawing pdata w = do sTicks <- SDL.ticks @@ -47,28 +49,33 @@ doDrawing pdata w = do wallPoints = map fst wallPointsCol setCommonUniforms pdata rot zoom trans wins depthFunc $= Just Less - pmat <- (newMatrix RowMajor $ perspectiveMatrix w) :: IO (GLmatrix GLfloat) + 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 blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) -- clear [DepthBuffer] depthFunc $= Just Always renderBackground pdata rot zoom trans wins - depthFunc $= Just Lequal --- depthFunc $= Just Less - renderWalls pdata wallPointsCol pmat - setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat + depthFunc $= Just Less + if w ^. config . wall_textured + 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 -- depthFunc $= Just Lequal renderFoldable pdata $ picToLTree (Just 0) pic -- reset blend so that light map doesn't apply -- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One)) -- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + depthFunc $= Just Lequal renderFoldable pdata $ picToLTree (Just 1) pic -- set drawing for on top blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) renderFoldable pdata $ picToLTree (Just 2) pic depthMask $= Disabled - renderWalls pdata windowPoints pmat + renderBlankWalls pdata windowPoints pmat depthMask $= Enabled resetShaderUniforms (map extractProgAndUnis $ _pictureShaders pdata) ---------------------- @@ -76,3 +83,33 @@ doDrawing pdata w = do renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w) eTicks <- SDL.ticks return (eTicks - sTicks) + +renderBlankWalls + :: RenderData + -> [((Point2,Point2),Point4)] -- ^ List: wall positions and color + -> GLmatrix GLfloat + -> IO () +renderBlankWalls pdata wps pmat = do + n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps + bindShaderBuffers [_wallBlankShader pdata] [n] + currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) + uniform (head (fromJust $ _shaderCustomUnis $ _wallBlankShader pdata) ) + $= pmat + cullFace $= Just Back + drawShader (_wallBlankShader pdata) n + cullFace $= Nothing + +renderTextureWalls + :: RenderData + -> [((Point2,Point2),Point4)] -- ^ List: wall positions and color + -> GLmatrix GLfloat + -> IO () +renderTextureWalls pdata wps pmat = do + n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps + bindShaderBuffers [_wallTextureShader pdata] [n] + currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata) + uniform (head (fromJust $ _shaderCustomUnis $ _wallTextureShader pdata) ) + $= pmat + cullFace $= Just Back + drawShader (_wallTextureShader pdata) n + cullFace $= Nothing diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index c77b0889f..bec8d655c 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -42,7 +42,7 @@ menuScreen cfig hw hh mLays = case mLays of ,"n - MUSIC VOLUME + m : " ++ muvol ] (GraphicsOptionMenu : _) -> optionsList hw hh "OPTIONS:GRAPHICS" - ["w - WALL TEXTURES" + ["w - WALL TEXTURES:" ++ show (_wall_textured cfig) ] (ControlList : _) -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh diff --git a/src/Dodge/Render/PerspectiveMatrix.hs b/src/Dodge/Render/PerspectiveMatrix.hs index 4ea325552..8c6220205 100644 --- a/src/Dodge/Render/PerspectiveMatrix.hs +++ b/src/Dodge/Render/PerspectiveMatrix.hs @@ -1,21 +1,20 @@ module Dodge.Render.PerspectiveMatrix where -import Dodge.Data - import Geometry import Linear.Matrix import Linear.V4 import Graphics.Rendering.OpenGL (GLfloat) -perspectiveMatrix :: World -> [GLfloat] -perspectiveMatrix w = - let rot = _cameraRot w - zoom = _cameraZoom w - (tranx,trany) = _cameraCenter w - (winx,winy) = (_windowX w,_windowY w) - (viewFromx,viewFromy) = _cameraViewFrom w - scalMat = Linear.Matrix.transpose $ V4 +perspectiveMatrix + :: Float -- ^ Rotation + -> Float -- ^ Zoom + -> Point2 -- ^ Translation + -> Point2 -- ^ Window size + -> Point2 -- ^ View froms + -> [GLfloat] +perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) = + let scalMat = Linear.Matrix.transpose $ V4 (V4 (2*zoom/winx) 0 0 (0::GLfloat)) (V4 0 (2*zoom/winy) 0 0) (V4 0 0 0.5 0) --scaled to make walls shorter diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index f73eb173a..90bbeb309 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -21,7 +21,8 @@ data RenderData = RenderData { _lightingFloorShader :: FullShader (Float,Float,Float,Float) , _lightingOccludeShader :: FullShader (Point2,Point2) , _lightingWallShader :: FullShader (Point2,Point2) - , _wallFaceShader :: FullShader ((Point2,Point2),Point4) + , _wallBlankShader :: FullShader ((Point2,Point2),Point4) + , _wallTextureShader :: FullShader ((Point2,Point2),Point4) , _backgroundShader :: FullShader (Point2,Point2,Point2,Point2) , _fullscreenShader :: FullShader () , _pictureShaders :: [FullShader RenderType] @@ -68,8 +69,12 @@ preloadRender = do bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat >>= addTexture "data/texture/smudgedDirt.png" --- wallShader - wlFace <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat +-- blank wallShader + wlBlank <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat +-- >>= addTexture "data/texture/grayscaleDirt.png" + >>= addUniforms ["perpMat"] +-- textured wallShader + wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat >>= addTexture "data/texture/grayscaleDirt.png" >>= addUniforms ["perpMat"] @@ -80,16 +85,17 @@ preloadRender = do bindFramebuffer Framebuffer $= defaultFramebufferObject return $ RenderData - { _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader] - , _lightingFloorShader = lsShad - , _lightingOccludeShader = wsShad - , _lightingWallShader = wlLightShad - , _wallFaceShader = wlFace - , _backgroundShader = bgShad - , _fullscreenShader = fsShad - , _spareFBO = fbo - , _fboTexture = fboTO - , _fboRenderbufferObject = fboRBO + { _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader] + , _lightingFloorShader = lsShad + , _lightingOccludeShader = wsShad + , _lightingWallShader = wlLightShad + , _wallBlankShader = wlBlank + , _wallTextureShader = wlTexture + , _backgroundShader = bgShad + , _fullscreenShader = fsShad + , _spareFBO = fbo + , _fboTexture = fboTO + , _fboRenderbufferObject = fboRBO } -- potential drawing setup @@ -113,6 +119,7 @@ setupFramebuffer = do fboTO <- genObjectName textureBinding Texture2D $= Just fboTO texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) + texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr) textureFilter Texture2D $= ((Linear',Just Linear') , Nearest) generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 202c0b3b9..dc4db6717 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -25,17 +25,12 @@ import Data.Maybe (fromJust) import qualified Data.IntMap.Strict as IM import qualified SDL - -renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO () -renderWalls pdata wps pmat = do - n <- F.foldM (pokeShader $ _wallFaceShader pdata) wps - bindShaderBuffers [_wallFaceShader pdata] [n] - currentProgram $= Just (_shaderProgram $ _wallFaceShader pdata) - uniform (head (fromJust $ _shaderCustomUnis $ _wallFaceShader pdata) ) - $= pmat - drawShader (_wallFaceShader pdata) n - -setWallDepth :: RenderData -> [(Point2,Point2)] -> (Float,Float) -> GLmatrix GLfloat -> IO Word32 +setWallDepth + :: RenderData + -> [(Point2,Point2)] -- ^ Wall points + -> (Float,Float) -- ^ View from point + -> GLmatrix GLfloat + -> IO Word32 setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do startTicks <- SDL.ticks colorMask $= Color4 Disabled Disabled Disabled Disabled @@ -55,6 +50,8 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do endTicks <- SDL.ticks return $ endTicks - startTicks +halfSize (Size x y) = Size (div x 2) (div y 2) + createLightMap :: RenderData -> Float -- Rotation @@ -66,8 +63,13 @@ createLightMap -> (Float,Float) -- View from position -> GLmatrix GLfloat -> IO () -createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints +createLightMap pdata rot zoom (tranx,trany) (winx',winy') wallPoints lightPoints (viewFromx,viewFromy) pmat = do + let winx = winx' / 2 + winy = winy' / 2 + + (vppos,vpsize) <- get viewport + viewport $= (vppos, halfSize vpsize) bindFramebuffer Framebuffer $= _spareFBO pdata -- store wall and light positions into buffer @@ -140,6 +142,7 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints cullFace $= Nothing stencilTest $= Disabled blend $= Disabled + viewport $= (vppos, vpsize) bindFramebuffer Framebuffer $= defaultFramebufferObject colorMask $= Color4 Disabled Disabled Disabled Enabled bindShaderBuffers [_fullscreenShader pdata] [4] @@ -148,7 +151,13 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints colorMask $= Color4 Enabled Enabled Enabled Enabled blend $= Enabled -renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO () +renderBackground + :: RenderData + -> Float -- Rotation + -> Float -- Zoom + -> (Float,Float) -- Translation + -> (Float,Float) -- Window size + -> IO () renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do -- depthFunc $= Just Less -- set drawing for on top @@ -164,7 +173,13 @@ renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do textureBinding Texture2D $= _textureObject <$> _shaderTexture (_backgroundShader pdata) drawArrays Points 0 1 -setCommonUniforms :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO () +setCommonUniforms + :: RenderData + -> Float -- ^ Rotation + -> Float -- ^ Zoom + -> (Float,Float) -- ^ Translation + -> (Float,Float) -- ^ Window size + -> IO () setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do setShaderUniforms rot zoom (tranx,trany) (winx,winy) ( extractProgAndUnis (_lightingFloorShader pdata) @@ -174,7 +189,11 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do : map extractProgAndUnis (_pictureShaders pdata) ) -renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32 +renderFoldable + :: Foldable f + => RenderData + -> f RenderType + -> IO Word32 renderFoldable pdata tree = do pokeStartTicks <- SDL.ticks @@ -183,7 +202,7 @@ renderFoldable pdata tree = do -- poke data, returns list of number of vertices for each shader is <- F.foldM (pokeShaders slist) tree --- the idea of doing as binding of buffers at once, rather than interweaving with draw +-- the idea of binding many buffers at once, rather than interweaving with draw -- calls, is to prevent opengl from waiting for a draw call to finish -- before it performs another state change bindShaderBuffers slist is @@ -194,13 +213,20 @@ renderFoldable pdata tree = do return $ pokeEndTicks - pokeStartTicks ------------------------------end renderFoldable - -pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO () +pokeTwoOff + :: Ptr Float + -> Int + -> (Float,Float) + -> IO () {-# INLINE pokeTwoOff #-} pokeTwoOff ptr n (x,y) = do pokeElemOff ptr (2*n+0) x pokeElemOff ptr (2*n+1) y -pokeThreeOff :: Ptr Float -> Int -> (Float,Float,Float) -> IO () +pokeThreeOff + :: Ptr Float + -> Int + -> (Float,Float,Float) + -> IO () {-# INLINE pokeThreeOff #-} pokeThreeOff ptr n (x,y,z) = do pokeElemOff ptr (3*n+0) x diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index 6bd6332a9..95202ecd1 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -14,8 +14,8 @@ resizeSpareFBO xsize ysize pdata = do fboName = _spareFBO rdata fboTO = _fboTexture rdata fboRBO = _fboRenderbufferObject rdata - xsize' = fromIntegral xsize - ysize' = fromIntegral ysize + xsize' = fromIntegral $ xsize `div` 2 + ysize' = fromIntegral $ ysize `div` 2 bindFramebuffer Framebuffer $= fboName textureBinding Texture2D $= Just fboTO texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)