Rename shaders, remove a dependency on Dodge.Data
This commit is contained in:
@@ -0,0 +1,9 @@
|
||||
#version 430 core
|
||||
in vec4 gColor;
|
||||
|
||||
out vec4 fColor;
|
||||
|
||||
void main()
|
||||
{
|
||||
fColor = gColor;
|
||||
}
|
||||
@@ -0,0 +1,41 @@
|
||||
#version 430 core
|
||||
layout (points) in;
|
||||
layout (triangle_strip, max_vertices = 4) out;
|
||||
|
||||
in vec4 vColor [];
|
||||
out vec4 gColor;
|
||||
|
||||
uniform mat4 perpMat;
|
||||
|
||||
// consider using isLHS to check if the wall is facing the center
|
||||
// this needs the view from point
|
||||
float isLHS (vec2 startV, vec2 testV)
|
||||
{
|
||||
return sign( -startV.x * testV.y + startV.y * testV.x);
|
||||
}
|
||||
|
||||
void main()
|
||||
{
|
||||
gColor = vColor[0];
|
||||
|
||||
vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0,1);
|
||||
vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1);
|
||||
|
||||
vec4 a1 = perpMat * p1;
|
||||
vec4 a2 = perpMat * p2;
|
||||
|
||||
// if (0 > isLHS (a1.xy - a2.xy, a1.xy - "viewFromPoint")) {
|
||||
|
||||
vec4 p3 = vec4 (p1.xy,-0.5,1);
|
||||
vec4 p4 = vec4 (p2.xy,-0.5,1);
|
||||
|
||||
vec4 a3 = perpMat * p3;
|
||||
vec4 a4 = perpMat * p4;
|
||||
|
||||
gl_Position = a1; EmitVertex();
|
||||
gl_Position = a3; EmitVertex();
|
||||
gl_Position = a2; EmitVertex();
|
||||
gl_Position = a4; EmitVertex();
|
||||
EndPrimitive();
|
||||
// }
|
||||
}
|
||||
@@ -9,4 +9,5 @@ out vec4 fColor;
|
||||
void main()
|
||||
{
|
||||
fColor = gColor * texture(tex,tPos);
|
||||
// fColor = gColor;
|
||||
}
|
||||
@@ -264,7 +264,7 @@ Items you start with.
|
||||
-}
|
||||
startInventory = IM.fromList (zip [0..20]
|
||||
(
|
||||
[--pistol
|
||||
[pistol
|
||||
--,blinkGun
|
||||
--,spawnGun lamp
|
||||
--,poisonSprayer
|
||||
|
||||
+1
-1
@@ -8,7 +8,6 @@ circular imports are scary.
|
||||
{-# LANGUAGE StrictData #-}
|
||||
module Dodge.Data
|
||||
( module Dodge.Data
|
||||
, module Dodge.Data.Menu
|
||||
, module Dodge.Data.DamageType
|
||||
, module Dodge.Data.SoundOrigin
|
||||
, module Dodge.Creature.Data
|
||||
@@ -58,6 +57,7 @@ data World = World
|
||||
, _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
|
||||
, _projectiles :: IM.IntMap Projectile
|
||||
, _particles :: ![Particle]
|
||||
, _staticWalls :: [Wall]
|
||||
, _walls :: !(IM.IntMap Wall)
|
||||
, _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall)))
|
||||
, _forceFields :: IM.IntMap ForceField
|
||||
|
||||
@@ -6,7 +6,8 @@ data MenuLayer
|
||||
| PauseMenu
|
||||
| GameOverMenu
|
||||
| OptionMenu
|
||||
| SoundOptionMenu
|
||||
| GraphicsOptionMenu
|
||||
| ConfigSaveScreen
|
||||
| ControlList
|
||||
deriving (Eq,Ord)
|
||||
|
||||
|
||||
@@ -9,6 +9,7 @@ module Dodge.Default where
|
||||
|
||||
import Dodge.Item.Weapon.Recock
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Base
|
||||
import Dodge.Config.Data
|
||||
@@ -208,6 +209,7 @@ defaultWorld = World
|
||||
, _itemPositions = IM.empty
|
||||
, _projectiles = IM.empty
|
||||
, _particles = []
|
||||
, _staticWalls = []
|
||||
, _walls = IM.empty
|
||||
, _wallsZone = IM.empty
|
||||
, _forceFields = IM.empty
|
||||
|
||||
@@ -6,6 +6,7 @@ module Dodge.Event.Keyboard
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Base
|
||||
import Dodge.Creature.Action
|
||||
import Dodge.Config.KeyConfig
|
||||
|
||||
@@ -2,6 +2,7 @@ module Dodge.Event.Menu
|
||||
( handlePressedKeyInMenu
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Floor
|
||||
import Dodge.Initialisation
|
||||
import Dodge.SoundLogic
|
||||
|
||||
@@ -2,6 +2,7 @@ module Dodge.Initialisation where
|
||||
-- imports {{{
|
||||
import Dodge.Default
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Creature
|
||||
import Dodge.Base
|
||||
import Dodge.Floor
|
||||
@@ -21,8 +22,9 @@ initializeWorld w = w
|
||||
|
||||
firstWorld :: IO World
|
||||
firstWorld = do
|
||||
i <- randomRIO (0,5000)
|
||||
putStrLn $ "Random seed for level generation: " ++ show ( i :: Int)
|
||||
-- i <- randomRIO (0,5000)
|
||||
let i = 2
|
||||
putStrLn $ "Seed for level generation: " ++ show ( i :: Int)
|
||||
return $ generateFromList levx $ initialWorld {_randGen = mkStdGen i}
|
||||
|
||||
initialWorld :: World
|
||||
|
||||
+2
-40
@@ -1,7 +1,6 @@
|
||||
module Dodge.Render
|
||||
( module Dodge.Render.Picture
|
||||
, doDrawing
|
||||
, doDrawing'
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -55,6 +54,7 @@ doDrawing pdata w = do
|
||||
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 Lequal
|
||||
@@ -64,53 +64,15 @@ doDrawing pdata w = do
|
||||
blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
|
||||
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
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
|
||||
depthMask $= Enabled
|
||||
|
||||
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
|
||||
resetShaderUniforms (map extractProgAndUnis $ _pictureShaders pdata)
|
||||
----------------------
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
|
||||
eTicks <- SDL.ticks
|
||||
return (eTicks - sTicks)
|
||||
doDrawing' :: RenderData -> World -> IO (Word32)
|
||||
doDrawing' pdata w = do
|
||||
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
||||
sTicks <- SDL.ticks
|
||||
clear [ColorBuffer,DepthBuffer]
|
||||
let rot = _cameraRot w
|
||||
zoom = _cameraZoom w
|
||||
trans@(tranx,trany) = _cameraCenter w
|
||||
wins@(winx,winy) = (_windowX w,_windowY w)
|
||||
wallPointsCol = wallsPointsAndCols w
|
||||
windowPoints = wallsWindows w
|
||||
lightPoints = lightsForGloom' w
|
||||
viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
|
||||
pic = worldPictures w
|
||||
wallPoints = map fst wallPointsCol
|
||||
pmat <- (newMatrix RowMajor
|
||||
$ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
|
||||
setCommonUniforms pdata rot zoom trans wins
|
||||
|
||||
depthMask $= Disabled
|
||||
renderBackground pdata rot zoom trans wins
|
||||
depthMask $= Enabled
|
||||
blend $= Enabled
|
||||
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
|
||||
-- not sure why renderWalls and setWallDepth aren't combined
|
||||
renderWalls pdata wallPointsCol pmat
|
||||
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
|
||||
depthFunc $= Just Lequal
|
||||
renderFoldable pdata $ picToLTree (Just 0) pic
|
||||
renderFoldable pdata $ picToLTree (Just 1) pic
|
||||
renderFoldable pdata $ picToLTree (Just 2) pic
|
||||
eTicks <- SDL.ticks
|
||||
return (eTicks - sTicks)
|
||||
|
||||
|
||||
@@ -1,22 +1,30 @@
|
||||
{-
|
||||
The menu picture.
|
||||
-}
|
||||
module Dodge.Render.MenuScreen
|
||||
( menuScreen
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Config.Update
|
||||
import Dodge.Config.Data
|
||||
import Dodge.Base (halfWidth,halfHeight)
|
||||
import Picture
|
||||
|
||||
menuScreen :: World -> Picture
|
||||
menuScreen w = case _menuLayers w of
|
||||
menuScreen
|
||||
:: Configuration
|
||||
-> Float -- Half width of screen
|
||||
-> Float -- Half height of screen
|
||||
-> [MenuLayer]
|
||||
-> Picture
|
||||
menuScreen cfig hw hh mLays = case mLays of
|
||||
[] -> blank
|
||||
(LevelMenu x:_) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 ("LEVEL "++show x)
|
||||
]
|
||||
(PauseMenu:_) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 "PAUSED"
|
||||
,tst (-100) 50 0.2 "n - new level"
|
||||
,tst (-100) 0 0.2 "r - restart"
|
||||
@@ -24,7 +32,7 @@ menuScreen w = case _menuLayers w of
|
||||
,tst (-100) (-100) 0.2 "c - controls"
|
||||
]
|
||||
(GameOverMenu:_) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 "GAME OVER"
|
||||
,tst (-100) 50 0.2 "n - new level"
|
||||
,tst (-100) 0 0.2 "r - restart"
|
||||
@@ -32,19 +40,19 @@ menuScreen w = case _menuLayers w of
|
||||
,tst (-100) (-100) 0.2 "c - controls"
|
||||
]
|
||||
(OptionMenu : _) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 "OPTIONS"
|
||||
,tst (-180) 50 0.2 $ "y - master volume + u : " ++ mavol
|
||||
,tst (-180) 0 0.2 $ "h - sound volume + j : " ++ snvol
|
||||
,tst (-180) (-50) 0.2 $ "n - music volume + m : " ++ muvol
|
||||
]
|
||||
(ControlList : _) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 "CONTROLS"
|
||||
,controlsList
|
||||
]
|
||||
(ConfigSaveScreen : _) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 "OPTIONS"
|
||||
,tst (-180) 50 0.2 $ "y - master volume + u : " ++ mavol
|
||||
,tst (-180) 0 0.2 $ "h - sound volume + j : " ++ snvol
|
||||
@@ -53,9 +61,9 @@ menuScreen w = case _menuLayers w of
|
||||
_ -> blank
|
||||
where
|
||||
tst x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
mavol = f $ _volume_master $ _config w
|
||||
snvol = f $ _volume_sound $ _config w
|
||||
muvol = f $ _volume_music $ _config w
|
||||
mavol = f $ _volume_master $ cfig
|
||||
snvol = f $ _volume_sound $ cfig
|
||||
muvol = f $ _volume_music $ cfig
|
||||
f x = show $ round $ 10 * x
|
||||
|
||||
controlsList = pictures $ concat $ zipWith butAndEff
|
||||
@@ -76,9 +84,14 @@ controlsList = pictures $ concat $ zipWith butAndEff
|
||||
,translate 0 y $ scale 0.15 0.15 $ color white $ text etext
|
||||
]
|
||||
|
||||
screenBox w = [ (halfWidth w, halfHeight w)
|
||||
, (-halfWidth w, halfHeight w)
|
||||
, (-halfWidth w,-halfHeight w)
|
||||
, ( halfWidth w,-halfHeight w)
|
||||
]
|
||||
screenBox
|
||||
:: Float
|
||||
-> Float
|
||||
-> [(Float,Float)]
|
||||
screenBox halfW halfH =
|
||||
[ (halfW, halfH)
|
||||
, (-halfW, halfH)
|
||||
, (-halfW,-halfH)
|
||||
, ( halfW,-halfH)
|
||||
]
|
||||
|
||||
|
||||
@@ -30,7 +30,7 @@ worldPictures w = pictures $ concat
|
||||
fixedCoordPictures :: World -> Picture
|
||||
fixedCoordPictures w = pictures
|
||||
[ hudDrawings w
|
||||
, scaler . onLayer MenuDepth $ menuScreen w
|
||||
, scaler . onLayer MenuDepth $ menuScreen (_config w) (halfWidth w) (halfHeight w) (_menuLayers w)
|
||||
, customMouseCursor w
|
||||
]
|
||||
where
|
||||
|
||||
@@ -6,6 +6,7 @@ module Dodge.Update
|
||||
( update
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Base
|
||||
import Dodge.WallCreatureCollisions
|
||||
import Dodge.LevelGen.Block
|
||||
|
||||
+18
-18
@@ -18,13 +18,13 @@ import Foreign
|
||||
import qualified Control.Foldl as F
|
||||
|
||||
data RenderData = RenderData
|
||||
{ _lightSourceShader :: FullShader (Float,Float,Float,Float)
|
||||
, _wallShadowShader :: FullShader (Point2,Point2)
|
||||
, _wallLightShader :: FullShader (Point2,Point2)
|
||||
{ _lightingFloorShader :: FullShader (Float,Float,Float,Float)
|
||||
, _lightingOccludeShader :: FullShader (Point2,Point2)
|
||||
, _lightingWallShader :: FullShader (Point2,Point2)
|
||||
, _wallFaceShader :: FullShader ((Point2,Point2),Point4)
|
||||
, _backgroundShader :: FullShader (Point2,Point2,Point2,Point2)
|
||||
, _fullscreenShader :: FullShader ()
|
||||
, _listShaders :: [FullShader RenderType]
|
||||
, _pictureShaders :: [FullShader RenderType]
|
||||
, _spareFBO :: FramebufferObject
|
||||
, _fboTexture :: TextureObject
|
||||
, _fboRenderbufferObject :: RenderbufferObject
|
||||
@@ -35,12 +35,12 @@ makeLenses ''RenderData
|
||||
preloadRender :: IO RenderData
|
||||
preloadRender = do
|
||||
-- lighting shaders
|
||||
lsShad <- makeShader "lighting/lightmapCircle" [vert,geom,frag] [(0,4)] Points
|
||||
lsShad <- makeShader "lighting/floor" [vert,geom,frag] [(0,4)] Points
|
||||
(return . return . flat4)
|
||||
wsShad <- makeShader "lighting/wallShadow" [vert,geom,frag] [(0,4)] Points pokeWPStrat
|
||||
wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [(0,4)] Points pokeWPStrat
|
||||
>>= addUniforms ["lightPos","perpMat","facesToDraw"]
|
||||
wlLightShad
|
||||
<- makeShader "lighting/lightmapWall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
|
||||
<- makeShader "lighting/wall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
|
||||
>>= addUniforms ["lightPos","perpMat","radLum"]
|
||||
|
||||
-- 2D draw shaders
|
||||
@@ -69,7 +69,7 @@ preloadRender = do
|
||||
>>= addTexture "data/texture/smudgedDirt.png"
|
||||
|
||||
-- wallShader
|
||||
wlShad <- makeShader "wallFace" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
|
||||
wlFace <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
|
||||
>>= addTexture "data/texture/grayscaleDirt.png"
|
||||
>>= addUniforms ["perpMat"]
|
||||
|
||||
@@ -80,13 +80,13 @@ preloadRender = do
|
||||
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
||||
|
||||
return $ RenderData
|
||||
{ _listShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
|
||||
, _lightSourceShader = lsShad
|
||||
, _wallShadowShader = wsShad
|
||||
, _wallLightShader = wlLightShad
|
||||
, _wallFaceShader = wlShad
|
||||
, _backgroundShader = bgShad
|
||||
, _fullscreenShader = fsShad
|
||||
{ _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
|
||||
@@ -129,9 +129,9 @@ setupFramebuffer = do
|
||||
|
||||
cleanUpRenderPreload :: RenderData -> IO ()
|
||||
cleanUpRenderPreload pd = do
|
||||
mapM_ freeShaderPointers $ _listShaders pd
|
||||
freeShaderPointers $ _lightSourceShader pd
|
||||
freeShaderPointers $ _wallShadowShader pd
|
||||
mapM_ freeShaderPointers $ _pictureShaders pd
|
||||
freeShaderPointers $ _lightingFloorShader pd
|
||||
freeShaderPointers $ _lightingOccludeShader pd
|
||||
freeShaderPointers $ _backgroundShader pd
|
||||
freeShaderPointers $ _fullscreenShader pd
|
||||
|
||||
|
||||
+48
-95
@@ -25,61 +25,6 @@ import Data.Maybe (fromJust)
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified SDL
|
||||
|
||||
renderPicture
|
||||
:: RenderData -- ^ Preloaded render data
|
||||
-> Float -- ^ Rotation
|
||||
-> Float -- ^ Zoom
|
||||
-> Point2 -- ^ Translation
|
||||
-> Point2 -- ^ Window size
|
||||
-> [((Point2,Point2),Point4)] -- ^ Wall data
|
||||
-> [((Point2,Point2),Point4)] -- ^ Window data
|
||||
-> [Point4] -- ^ Lights data
|
||||
-> (Float,Float) -- ^ View from point
|
||||
-> Picture -- ^ Picture
|
||||
-> IO Word32 -- ^ Time taken according to SDL.ticks
|
||||
renderPicture pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
|
||||
viewFroms@(viewFromx,viewFromy) pic = do
|
||||
startTicks <- SDL.ticks
|
||||
let wallPoints = map fst wallPointsCol
|
||||
|
||||
setCommonUniforms pdata rot zoom trans wins
|
||||
|
||||
depthFunc $= Just Less
|
||||
|
||||
pmat <- (newMatrix RowMajor
|
||||
$ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
|
||||
) :: IO (GLmatrix GLfloat)
|
||||
|
||||
createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
|
||||
|
||||
renderBackground pdata rot zoom trans wins
|
||||
|
||||
renderWalls pdata wallPointsCol 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
|
||||
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
|
||||
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
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
|
||||
depthMask $= Enabled
|
||||
|
||||
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
|
||||
endTicks <- SDL.ticks
|
||||
return (endTicks - startTicks)
|
||||
|
||||
renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO ()
|
||||
renderWalls pdata wps pmat = do
|
||||
@@ -94,55 +39,63 @@ setWallDepth :: RenderData -> [(Point2,Point2)] -> (Float,Float) -> GLmatrix GLf
|
||||
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
|
||||
startTicks <- SDL.ticks
|
||||
colorMask $= Color4 Disabled Disabled Disabled Disabled
|
||||
nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints
|
||||
bindShaderBuffers [_wallShadowShader pdata] [nWalls]
|
||||
nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) wallPoints
|
||||
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
|
||||
|
||||
currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
|
||||
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata)
|
||||
$= Vector2 viewFromx viewFromy
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 1)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1)
|
||||
$= pmat
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2)
|
||||
$= (0 :: Float)
|
||||
-- cullFace $= Just Front
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
drawShader (_lightingOccludeShader pdata) nWalls
|
||||
colorMask $= Color4 Enabled Enabled Enabled Enabled
|
||||
endTicks <- SDL.ticks
|
||||
return $ endTicks - startTicks
|
||||
|
||||
createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2)] -> [Point4] ->
|
||||
(Float,Float) -> GLmatrix GLfloat -> IO ()
|
||||
createLightMap
|
||||
:: RenderData
|
||||
-> Float -- Rotation
|
||||
-> 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
|
||||
(viewFromx,viewFromy) pmat = do
|
||||
|
||||
bindFramebuffer Framebuffer $= _spareFBO pdata
|
||||
-- store wall and light positions into buffer
|
||||
nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) wallPoints
|
||||
bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
|
||||
nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) wallPoints
|
||||
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
|
||||
-- set uniforms for shader that draws lights
|
||||
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _lightingWallShader pdata) !! 1)
|
||||
$= pmat
|
||||
-- clear buffer to full alpha and furthest depth
|
||||
clearColor $= Color4 0 0 0 1
|
||||
clearDepth $= 1
|
||||
clear [ColorBuffer,DepthBuffer]
|
||||
depthFunc $= Just Less
|
||||
-- store wall and light positions into buffer
|
||||
nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints
|
||||
bindShaderBuffers [_wallLightShader pdata] [nWallLights]
|
||||
nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints
|
||||
bindShaderBuffers [_wallShadowShader pdata] [nWalls]
|
||||
-- set uniforms for shader that draws lights
|
||||
currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallLightShader pdata) !! 1)
|
||||
$= pmat
|
||||
-- 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)
|
||||
currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
|
||||
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata)
|
||||
$= Vector2 viewFromx viewFromy
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 1)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1)
|
||||
$= pmat
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2)
|
||||
$= (0 :: Float)
|
||||
cullFace $= Just Back
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
drawShader (_lightingOccludeShader pdata) nWalls
|
||||
-- for each of the lights:
|
||||
-- stencil out the walls from this light's point of view
|
||||
-- draw fading lightmap circles on the floor
|
||||
@@ -153,7 +106,7 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
forM_ lightPoints $ \(x,y,r,lum) -> do
|
||||
-- bind buffer for floor light circle
|
||||
let lightPtr = (\(_,ptr,_) -> ptr) $ head
|
||||
$ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata
|
||||
$ _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)
|
||||
@@ -163,26 +116,26 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
cullFace $= Just Back
|
||||
stencilOp $= (OpKeep,OpKeep,OpIncr)
|
||||
stencilFunc $= (Always, 0, 255)
|
||||
currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
|
||||
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata)
|
||||
$= Vector2 x y
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
drawShader (_lightingOccludeShader pdata) nWalls
|
||||
cullFace $= Just Front
|
||||
stencilOp $= (OpKeep,OpKeep,OpDecr)
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
drawShader (_lightingOccludeShader pdata) nWalls
|
||||
-- draw floor light circles
|
||||
cullFace $= Nothing
|
||||
colorMask $= Color4 Disabled Disabled Disabled Enabled
|
||||
bindShaderBuffers [_lightSourceShader pdata] [1]
|
||||
bindShaderBuffers [_lightingFloorShader pdata] [1]
|
||||
stencilFunc $= (Equal, 0, 255)
|
||||
drawShader (_lightSourceShader pdata) 1
|
||||
drawShader (_lightingFloorShader pdata) 1
|
||||
-- draw wall light "circles"
|
||||
currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata)
|
||||
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingWallShader pdata)
|
||||
$= Vector2 x y
|
||||
uniform (fromJust (_shaderCustomUnis $ _wallLightShader pdata) !! 2)
|
||||
uniform (fromJust (_shaderCustomUnis $ _lightingWallShader pdata) !! 2)
|
||||
$= Vector2 r lum
|
||||
drawShader (_wallLightShader pdata) nWallLights
|
||||
drawShader (_lightingWallShader pdata) nWallLights
|
||||
depthMask $= Enabled
|
||||
cullFace $= Nothing
|
||||
stencilTest $= Disabled
|
||||
@@ -214,18 +167,18 @@ renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
setCommonUniforms :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
|
||||
setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy)
|
||||
( extractProgAndUnis (_lightSourceShader pdata)
|
||||
: extractProgAndUnis (_wallShadowShader pdata)
|
||||
: extractProgAndUnis (_wallLightShader pdata)
|
||||
( extractProgAndUnis (_lightingFloorShader pdata)
|
||||
: extractProgAndUnis (_lightingOccludeShader pdata)
|
||||
: extractProgAndUnis (_lightingWallShader pdata)
|
||||
: extractProgAndUnis (_backgroundShader pdata)
|
||||
: map extractProgAndUnis (_listShaders pdata)
|
||||
: map extractProgAndUnis (_pictureShaders pdata)
|
||||
)
|
||||
|
||||
renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32
|
||||
renderFoldable pdata tree = do
|
||||
pokeStartTicks <- SDL.ticks
|
||||
|
||||
let slist = _listShaders pdata
|
||||
let slist = _pictureShaders pdata
|
||||
|
||||
-- poke data, returns list of number of vertices for each shader
|
||||
is <- F.foldM (pokeShaders slist) tree
|
||||
|
||||
Reference in New Issue
Block a user