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

Rename shaders, remove a dependency on Dodge.Data

Browse Source
This commit is contained in:
jgk
2021-04-28 13:32:50 +02:00
parent 2085d5a048
commit 1b4eac2da7
28 changed files with 163 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+1 -1
View File
@@ -264,7 +264,7 @@ Items you start with.
-}
startInventory = IM.fromList (zip [0..20]
(
[--pistol
[pistol
--,blinkGun
--,spawnGun lamp
--,poisonSprayer
src/Dodge/Data.hs
+1 -1
View File
@@ -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
src/Dodge/Data/Menu.hs
+2 -1
View File
@@ -6,7 +6,8 @@ data MenuLayer
| PauseMenu
| GameOverMenu
| OptionMenu
| SoundOptionMenu
| GraphicsOptionMenu
| ConfigSaveScreen
| ControlList
deriving (Eq,Ord)
src/Dodge/Default.hs
+2
View File
@@ -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
src/Dodge/Event/Keyboard.hs
+1
View File
@@ -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
src/Dodge/Event/Menu.hs
+1
View File
@@ -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
src/Dodge/Initialisation.hs
+4 -2
View File
@@ -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
src/Dodge/Render.hs
+2 -40
View File
@@ -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)
src/Dodge/Render/MenuScreen.hs
+30 -17
View File
@@ -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)
]
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -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
src/Dodge/Update.hs
+1
View File
@@ -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
src/Picture/Preload.hs
+18 -18
View File
@@ -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
src/Picture/Render.hs
+48 -95
View File
@@ -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