Implement low res shadows
This commit is contained in:
@@ -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
|
||||
}
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
+49
-12
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user