From e62ff391a561e53795fe91c9528f53cb04898f2a Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 31 Mar 2021 11:27:45 +0200 Subject: [PATCH] Reogranise drawing in main --- app/Main.hs | 61 ++++++++++++++++++++++---- src/Dodge/Creature/Inanimate.hs | 3 +- src/Dodge/WallCreatureCollisions.hs | 7 ++- src/Dodge/WorldEvent/Flash.hs | 2 +- src/Dodge/WorldEvent/ThingsHit.hs | 1 + src/Geometry.hs | 1 + src/Picture/Render.hs | 68 +++++++++++++++++------------ 7 files changed, 99 insertions(+), 44 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 7fe2ea989..d3c3a114d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -85,15 +85,58 @@ doTheRender :: PreloadData a -> World -> IO (Word32) doTheRender preData w = do sTicks <- SDL.ticks clear [ColorBuffer,DepthBuffer] - renderPicture' (_renderData preData) - (_cameraRot w) (_cameraZoom w) - (_cameraCenter w) - (_windowX w,_windowY w) - (wallsPointsAndCols w) - (wallsWindows w) - (lightsForGloom' w) - (_cameraViewFrom w) - (worldPictures w) + let pdata = _renderData preData + 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 + 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 + + blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) + clear [DepthBuffer] + + 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) +---------------------- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w) eTicks <- SDL.ticks diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 058840b30..4397a33d2 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -5,6 +5,7 @@ import Dodge.Base import Dodge.Default import Dodge.CreatureState import Dodge.LightSources +import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Sound @@ -34,7 +35,7 @@ updateLamp :: Int -> CRUpdate updateLamp i = unrandUpdate handleLS internalUpdate where handleLS cr w - | _crHP cr < 0 = mkSoundBreakGlass w & lightSources %~ IM.delete i + | _crHP cr < 0 = explosionFlashAt (_crPos cr) $ mkSoundBreakGlass w & lightSources %~ IM.delete i | otherwise = w & lightSources . ix i . lsPos .~ _crPos cr internalUpdate cr | _crHP cr < 0 = Nothing diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 32bb96116..d5685de40 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -40,18 +40,17 @@ wallBuffer = 3 -- the following tests whether or not a point is on a wall, and if so pushes it -- out from the wall --- If the resultant push out is itself on another wall, the original point is --- returned +-- this is then repeated if the point ends up on a new wall collideWalls :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2 collideWalls rad cp1 walls cp2 = case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of Nothing -> cp2 Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of Nothing -> cp3 - Just cp4 -> cp1 + Just cp4 -> cp4 -- pushes a point out from a list of walls --- if multiple new points occur, chooses the one closest to the orignal pointjk +-- if multiple new points occur, chooses the one closest to the orignal point pushOutFromWalls :: Float -> [[Point2]] -> Point2 -> Point2 pushOutFromWalls rad walls p = fromMaybe p diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 721b9d1ea..26171d70c 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -59,7 +59,7 @@ glareBetween t len wdth col a b w lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture lowLightPic len wdth col (a,b) w - = case thingsHitLongLine a b w of + = case thingsHit a b w of ((p, E3x2 wall):_) -> setCol . lineOfThickness wdth $ [alongLineBy len p wa, alongLineBy len p wb] where x = len *.* (normalizeV $ wa -.- wb) diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 149d288a6..73c0b7b80 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -17,6 +17,7 @@ thingsHit sp ep w where hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr)) $ _creatures w + -- $ creaturesAlongLine sp ep w crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs crs = zip crPs (map E3x1 hitCrs) diff --git a/src/Geometry.hs b/src/Geometry.hs index 666cfab39..0c8614ad6 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -152,6 +152,7 @@ circOnLine' !p1 !p2 !c !rad = isJustTrue (fmap (\p -> magV (p -.- c) < rad) y) -- this should probably be circOnSeg circOnLine :: Point2 -> Point2 -> Point2 -> Float -> Bool +{-# INLINE circOnLine #-} circOnLine !p1 !p2 !c !rad = magV (p1 -.- c) <= rad || magV (p2 -.- c) <= rad || isJustTrue (fmap (\p -> magV (p -.- c) < rad) y) where diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 855bbb2da..c1fbccce6 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -1,9 +1,9 @@ --{-# LANGUAGE Strict #-} {-# LANGUAGE DeriveFoldable, StandaloneDeriving #-} module Picture.Render - ( renderPicture' - , renderFoldable + ( module Picture.Render , picToLTree + , perspectiveMatrix ) where @@ -114,19 +114,27 @@ 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 - depthFunc $= Just Less + +-- 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 - nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints - bindShaderBuffers [_wallShadowShader pdata] [nWalls] +-- 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) @@ -140,41 +148,44 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints cullFace $= Just Back drawShader (_wallShadowShader pdata) nWalls +-- for each of the lights: +-- stencil out the walls from this lights point of view +-- draw fading lightmap circles on the floor +-- draw fading lightmaps on the walls depthMask $= Disabled blendFunc $= (Zero, OneMinusSrcAlpha) --- blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha)) stencilTest $= Enabled forM_ lightPoints $ \(x,y,r,lum) -> do --- depthFunc $= Just Less - colorMask $= (Color4 Disabled Disabled Disabled Disabled) - clear [StencilBuffer] - cullFace $= Just Back --- stencilOp $= (OpKeep,OpKeep,OpReplace) - stencilOp $= (OpKeep,OpKeep,OpIncr) - stencilFunc $= (Always, 0, 255) --- currentProgram does get called twice: here and inside drawShader below - currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata) - uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) - $= Vector2 x y --- blendFunc $= (Zero,One) - drawShader (_wallShadowShader pdata) nWalls - cullFace $= Just Front - stencilOp $= (OpKeep,OpKeep,OpDecr) - drawShader (_wallShadowShader pdata) nWalls - - cullFace $= Nothing - - colorMask $= (Color4 Enabled Enabled Enabled Enabled) +-- bind buffer for floor light circle let lightPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata (x',y') = zTran $ rotateV (0 - rot) $ (x,y) -.- (tranx,trany) zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy) pokeFourOff lightPtr 0 (x',y',r,lum) + +-- stencil out walls + colorMask $= (Color4 Disabled Disabled Disabled Disabled) + clear [StencilBuffer] + cullFace $= Just Back + stencilOp $= (OpKeep,OpKeep,OpIncr) + stencilFunc $= (Always, 0, 255) + currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata) + uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) + $= Vector2 x y + drawShader (_wallShadowShader pdata) nWalls + cullFace $= Just Front + stencilOp $= (OpKeep,OpKeep,OpDecr) + drawShader (_wallShadowShader pdata) nWalls + +-- draw floor light circles + cullFace $= Nothing + colorMask $= (Color4 Disabled Disabled Disabled Enabled) bindShaderBuffers [_lightSourceShader pdata] [1] stencilFunc $= (Equal, 0, 255) drawShader (_lightSourceShader pdata) 1 +-- draw wall light "circles" currentProgram $= Just (_shaderProgram $ _wallLightShader pdata) uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata) $= Vector2 x y @@ -204,8 +215,7 @@ renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do depthFunc $= Just Less -- set drawing for on top - blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) - clear [DepthBuffer] + --blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) -- draw background bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata