diff --git a/shader/lighting/lightmapCircle.frag b/shader/lighting/floor.frag similarity index 100% rename from shader/lighting/lightmapCircle.frag rename to shader/lighting/floor.frag diff --git a/shader/lighting/lightmapCircle.geom b/shader/lighting/floor.geom similarity index 100% rename from shader/lighting/lightmapCircle.geom rename to shader/lighting/floor.geom diff --git a/shader/lighting/lightmapCircle.vert b/shader/lighting/floor.vert similarity index 100% rename from shader/lighting/lightmapCircle.vert rename to shader/lighting/floor.vert diff --git a/shader/lighting/wallShadow.frag b/shader/lighting/occlude.frag similarity index 100% rename from shader/lighting/wallShadow.frag rename to shader/lighting/occlude.frag diff --git a/shader/lighting/wallShadow.geom b/shader/lighting/occlude.geom similarity index 100% rename from shader/lighting/wallShadow.geom rename to shader/lighting/occlude.geom diff --git a/shader/lighting/lightmapWall.vert b/shader/lighting/occlude.vert similarity index 100% rename from shader/lighting/lightmapWall.vert rename to shader/lighting/occlude.vert diff --git a/shader/lighting/lightmapWall.frag b/shader/lighting/wall.frag similarity index 100% rename from shader/lighting/lightmapWall.frag rename to shader/lighting/wall.frag diff --git a/shader/lighting/lightmapWall.geom b/shader/lighting/wall.geom similarity index 100% rename from shader/lighting/lightmapWall.geom rename to shader/lighting/wall.geom diff --git a/shader/lighting/wallShadow.vert b/shader/lighting/wall.vert similarity index 100% rename from shader/lighting/wallShadow.vert rename to shader/lighting/wall.vert diff --git a/shader/wall/blank.frag b/shader/wall/blank.frag new file mode 100644 index 000000000..e966151e5 --- /dev/null +++ b/shader/wall/blank.frag @@ -0,0 +1,9 @@ +#version 430 core +in vec4 gColor; + +out vec4 fColor; + +void main() +{ + fColor = gColor; +} diff --git a/shader/wall/blank.geom b/shader/wall/blank.geom new file mode 100644 index 000000000..5e371044a --- /dev/null +++ b/shader/wall/blank.geom @@ -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(); +// } +} diff --git a/shader/wallFace.vert b/shader/wall/blank.vert similarity index 100% rename from shader/wallFace.vert rename to shader/wall/blank.vert diff --git a/shader/wallFace.frag b/shader/wall/texture.frag similarity index 87% rename from shader/wallFace.frag rename to shader/wall/texture.frag index a4e0a29a7..923312dcc 100644 --- a/shader/wallFace.frag +++ b/shader/wall/texture.frag @@ -9,4 +9,5 @@ out vec4 fColor; void main() { fColor = gColor * texture(tex,tPos); +// fColor = gColor; } diff --git a/shader/wallFace.geom b/shader/wall/texture.geom similarity index 100% rename from shader/wallFace.geom rename to shader/wall/texture.geom diff --git a/shader/wallFace.vet b/shader/wall/texture.vert similarity index 100% rename from shader/wallFace.vet rename to shader/wall/texture.vert diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 9f440a681..578fe653c 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -264,7 +264,7 @@ Items you start with. -} startInventory = IM.fromList (zip [0..20] ( - [--pistol + [pistol --,blinkGun --,spawnGun lamp --,poisonSprayer diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f10a8df32..16305b1f7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Data/Menu.hs b/src/Dodge/Data/Menu.hs index f24747294..32ecc6b1d 100644 --- a/src/Dodge/Data/Menu.hs +++ b/src/Dodge/Data/Menu.hs @@ -6,7 +6,8 @@ data MenuLayer | PauseMenu | GameOverMenu | OptionMenu + | SoundOptionMenu + | GraphicsOptionMenu | ConfigSaveScreen | ControlList deriving (Eq,Ord) - diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 9ef736335..1469a6d64 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 4d52741f1..5778d9753 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index a363b46dd..9e5db6011 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -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 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 0a648a848..69f18da03 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 05c0c3ff6..99aab535f 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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) - diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index fd524313d..c6cce8dfc 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -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) + ] diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 0550a3516..eca7b9aa0 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 17abfc2ee..2e81faf17 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index e493d065b..f73eb173a 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -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 diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index a2d6aa8ad..202c0b3b9 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -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