From 23fbee3374199fcd08c8057079007c4ce9ff7375 Mon Sep 17 00:00:00 2001 From: jgk Date: Sun, 21 Mar 2021 19:45:21 +0100 Subject: [PATCH] Set up wall rendering with textures --- app/Main.hs | 5 +-- src/Dodge/Rendering.hs | 5 ++- src/Picture/Preload.hs | 6 +-- src/Picture/Render.hs | 84 ++++++++++++++++++++---------------------- 4 files changed, 46 insertions(+), 54 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index b876afeaa..b46aff4b8 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -62,10 +62,7 @@ main = do (_cameraCenter w) (worldPictures w) blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - renderFoldable (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w) - (_windowX w,_windowY w) - --(picToLTree (Just 1) $ fixedCoordPictures w) - (picToLTree Nothing $ fixedCoordPictures w) + renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w) endRenderTicks <- SDL.ticks playSoundQueue (_soundData preData) (_soundQueue w) newSoundData <- playAndUpdate (_sounds w) (_soundData preData) diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 0a4f19cb5..54649daf9 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -439,10 +439,11 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $ scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show $ _crHP $ _creatures w IM.! n -wallsForGloom :: World -> [(Point2,Point2)] -wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough) +wallsForGloom :: World -> [((Point2,Point2),Point4)] +wallsForGloom w = map f $ filter (not . _wlIsSeeThrough) $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w where linePairs (x:y:_) = (x,y) + f wl = (linePairs $ _wlLine wl, _wlColor wl) lightsForGloom' :: World -> [(Point4)] lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w) diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 78a371e41..b23f9fa33 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -21,7 +21,7 @@ data RenderData = RenderData { _lightSourceShader :: FullShader (Float,Float,Float,Float) , _wallShadowShader :: FullShader (Point2,Point2) , _wallLightShader :: FullShader (Point2,Point2) - , _wallFaceShader :: FullShader (Point2,Point2,Point4) + , _wallFaceShader :: FullShader ((Point2,Point2),Point4) , _backgroundShader :: FullShader (Point2,Point2,Point2,Point2) , _fullscreenShader :: FullShader () , _listShaders :: [FullShader RenderType] @@ -155,8 +155,8 @@ frag = FragmentShader pokeWPStrat :: (Point2,Point2) -> [[[Float]]] pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]] -pokeWPColStrat :: (Point2,Point2,Point4) -> [[[Float]]] -pokeWPColStrat ((x,y),(z,w),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]] +pokeWPColStrat :: ((Point2,Point2),Point4) -> [[[Float]]] +pokeWPColStrat (((x,y),(z,w)),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]] pokeBGStrat :: a -> [[[Float]]] pokeBGStrat = const [] diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 5fd2ea0be..6cf0980af 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -41,37 +41,40 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do : (map extractProgAndUnis $ _listShaders pdata) ) -createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> - [(Point2,Point2)] -> [Point4] -> - (Float,Float) -> Picture -> IO () -createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints - (viewFromx,viewFromy) pic = do - return () - renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> - [(Point2,Point2)] -> [Point4] -> + [((Point2,Point2),Point4)] -> [Point4] -> (Float,Float) -> Picture -> IO (Word32,Word32) -renderPicture' pdata rot zoom trans wins wallPoints lightPoints - viewFroms pic = do +renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol lightPoints + viewFroms@(viewFromx,viewFromy) pic = do + let wallPoints = map fst wallPointsCol startTicks <- SDL.ticks setCommonUniforms pdata rot zoom trans wins - renderPicture pdata rot zoom trans wins wallPoints lightPoints viewFroms pic - endTicks <- SDL.ticks - return (startTicks, endTicks - startTicks) -renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> - [(Point2,Point2)] -> [Point4] -> - (Float,Float) -> Picture -> IO (Word32,Word32) -renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints - (viewFromx,viewFromy) pic = do - wallPokeStart <- SDL.ticks - --- setting the depth function to less, instead of lequal, --- seems to stop a lot of unecessary drawing --- of wall shadows when creating the light map depthFunc $= Just Less --- draw lightmap +-- calculate perspective matrix + 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 + ticksAfterLighting <- SDL.ticks + renderBackground pdata rot zoom trans wins + renderWalls pdata wallPointsCol pmat + renderPicture pdata pic + endTicks <- SDL.ticks + return (ticksAfterLighting, endTicks - startTicks) + +renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO () +renderWalls pdata wps pmat = do + n <- F.foldM (pokeShader $ _wallFaceShader pdata) wps + return () + +createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> + [(Point2,Point2)] -> [Point4] -> + (Float,Float) -> GLmatrix GLfloat -> IO () +createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints + (viewFromx,viewFromy) pmat = do bindFramebuffer Framebuffer $= (_spareFBO pdata) clearColor $= Color4 0 0.5 0 1 @@ -79,11 +82,6 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints clearDepth $= 1 clear [ColorBuffer,DepthBuffer] --- calculate perspective matrix - pmat <- (newMatrix RowMajor - $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) - ) :: IO (GLmatrix GLfloat) - nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints bindShaderBuffers [_wallLightShader pdata] [nWallLights] currentProgram $= Just (_shaderProgram $ _wallLightShader pdata) @@ -171,14 +169,16 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints blend $= Enabled --- draw picture on top of light/shadow map +renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO () +renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do + depthFunc $= Just Less + -- set drawing for on top blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) clear [DepthBuffer] -- draw background bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata - depthFunc $= Just Less currentProgram $= Just (_shaderProgram $ _backgroundShader pdata) bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata) @@ -189,34 +189,28 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints textureBinding Texture2D $= (fmap _textureObject $ _shaderTexture $ _backgroundShader pdata) drawArrays Points (fromIntegral 0) (fromIntegral 1) +renderPicture :: RenderData -> Picture -> IO () +renderPicture pdata pic = do + depthFunc $= Just Lequal -- draw layer 0 - ticks2 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 0) pic + ticks2 <- renderFoldable pdata $ picToLTree (Just 0) pic --((picToAlt 0 pic) :: [RenderType]) -- reset blend so that light map doesn't apply blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - ticks3 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 1) pic + ticks3 <- renderFoldable pdata $ picToLTree (Just 1) pic -- set drawing for on top aticks <- SDL.ticks blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) - ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic + ticks4 <- renderFoldable pdata $ picToLTree (Just 2) pic bticks <- SDL.ticks resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata) - endWallTicks <- SDL.ticks - --return (ticksAfterL, ticks2+ticks3+ticks4, endWallTicks - startWallTicks) - ticksE <- SDL.ticks - --return (ticksAfterL, ticksE - ticksS) - --return (ticksAfterL, ticks2 + ticks3 + ticks4) - return (ticksAfterL, wallPokeEnd - wallPokeStart) -----------------end renderPicture' - -renderFoldable :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) - -> f RenderType -> IO Word32 -renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do +renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32 +renderFoldable pdata tree = do pokeStartTicks <- SDL.ticks let slist = _listShaders pdata