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

Reogranise drawing in main

Browse Source
This commit is contained in:
jgk
2021-03-31 11:27:45 +02:00
parent 89c3ff96c8
commit e62ff391a5
7 changed files with 99 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+52 -9
View File
@@ -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
src/Dodge/Creature/Inanimate.hs
+2 -1
View File
@@ -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
src/Dodge/WallCreatureCollisions.hs
+3 -4
View File
@@ -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
src/Dodge/WorldEvent/Flash.hs
+1 -1
View File
@@ -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)
src/Dodge/WorldEvent/ThingsHit.hs
+1
View File
@@ -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)
src/Geometry.hs
+1
View File
@@ -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
src/Picture/Render.hs
+39 -29
View File
@@ -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