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

Use immutable storage for fullscreen vbo

Browse Source
This commit is contained in:
justin
2023-03-21 12:47:02 +00:00
parent 9bba0a43a4
commit ba240723f3
13 changed files with 105 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Cloud/Draw.hs
+2 -2
View File
@@ -6,8 +6,8 @@ import Picture
drawCloud :: CloudDraw -> Cloud -> Picture
drawCloud cd = case cd of
CloudColor radmult fadet col -> drawCloudWith radmult fadet col
DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
$ circleSolid 20
-- DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
-- $ circleSolid 20
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
drawCloudWith radMult fadet col cl = setLayer MidLayer
src/Dodge/Data/Cloud.hs
-1
View File
@@ -13,7 +13,6 @@ import Geometry
data CloudDraw
= CloudColor Float Float Color -- radius-multiply fade-time color
| DrawGasCloud Color
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Cloud = Cloud
src/Dodge/Placement/Instance/Wall.hs
+2 -1
View File
@@ -88,7 +88,8 @@ baseBlockPane =
defaultWall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
, _wlColor = greyN 0.5
--, _wlColor = greyN 0.5
, _wlColor = orange
, _wlOpacity = Opaque 10
, _wlUnshadowed = True
, _wlFireThrough = True
src/Dodge/Projectile/Update.hs
+4 -1
View File
@@ -107,8 +107,11 @@ doThrust pj w =
& cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
& shellTrailCloud' trailage trailfadetime
(addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
where
trailage = fst . randomR (300, 500) $ _randGen w
trailfadetime = fst . randomR (100, 300) $ _randGen w
accel = _prjAcc pj
i = _prjID pj
oldPos = _prjPos pj
src/Dodge/Render.hs
+25 -10
View File
@@ -5,6 +5,7 @@ module Dodge.Render (
--import qualified Data.Vector as V
import Data.List (sortOn)
import Shader.Poke.Cloud
import GLHelp
import Control.Lens
@@ -96,7 +97,7 @@ doDrawing' win pdata u = do
]
bufferPokedVBO (_vboShapes pdata) nShapeVs
(nCloudVs,nCloudIs) <- foldM (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
(0,0) (w ^. cWorld . lWorld . clouds)
(0,0) (sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
bufferPokedVBO (pdata ^. cloudVBO) nCloudVs
glNamedBufferSubData
(_eboName $ _cloudEBO pdata)
@@ -208,7 +209,8 @@ doDrawing' win pdata u = do
glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO)
glEnable GL_BLEND
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
--drawShader (fst $ _fullscreenShader pdata) 4
with GL_COLOR_ATTACHMENT0 $ \ptr ->
glInvalidateNamedFramebufferData
(pdata ^. fboLighting . _1 . unFBO)
@@ -241,7 +243,14 @@ doDrawing' win pdata u = do
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
glDepthFunc GL_LEQUAL
glDepthMask GL_FALSE
glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
--blendFunc $= (SrcAlphaSaturate,One)
--blendColor $= Color4 0.5 0.5 0.5 0.5
--blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
--blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
--glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
--glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
--glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
withArray [0.5,0.5,0.5,0] $ \ptr -> glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
@@ -274,10 +283,15 @@ doDrawing' win pdata u = do
2
ptr
glEnable GL_BLEND
--glDisable GL_BLEND
-- the idea is to (roughly) get the average position
glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
-- and to sum the normals
glBlendFunci 2 GL_ONE GL_ONE
--glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
-- or, if we order the clouds, just get the top pos
glBlendFunci 1 GL_ONE GL_ZERO
-- and to sum the normals (based on the alpha)
glBlendFunci 2 GL_SRC_ALPHA GL_ONE
-- just get the top normal
-- glBlendFunci 2 GL_ONE GL_ZERO
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
@@ -286,6 +300,7 @@ doDrawing' win pdata u = do
GL_UNSIGNED_SHORT
nullPtr
drawShader (_windowShader pdata) nWins
glEnable GL_BLEND
----draw lightmap for cloud buffer
glDepthMask GL_FALSE
glDepthFunc GL_LEQUAL
@@ -310,7 +325,7 @@ doDrawing' win pdata u = do
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing bloom then clouds
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
@@ -318,11 +333,11 @@ doDrawing' win pdata u = do
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--draw shadowed clouds onto base buffer
glBindTexture GL_TEXTURE_2D (pdata ^. fboCloud . _2 . _1 . unTO)
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
--set viewport for radial distortion
setViewportSize (round winx) (round winy)
glDepthFunc GL_ALWAYS
@@ -332,7 +347,7 @@ doDrawing' win pdata u = do
[] -> do
bindTO $ pdata ^. fboBase . _2 . _1
glBindFramebuffer GL_FRAMEBUFFER 0
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
rds -> do
let bindDrawDist :: Distortion -> IO ()
bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
src/Dodge/WorldEvent/Cloud.hs
+6 -3
View File
@@ -3,7 +3,7 @@ module Dodge.WorldEvent.Cloud (
smokeCloudAt,
makeThinSmokeAt,
makeThickSmokeAt,
shellTrailCloud,
shellTrailCloud',
spawnSmokeAtCursor,
makeStartCloudAt,
) where
@@ -60,10 +60,13 @@ makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50
makeStartCloudAt :: Point3 -> World -> World
--makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 50
makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
shellTrailCloud :: Point3 -> World -> World
shellTrailCloud = makeCloudAt (CloudColor (4 / 3) 800 (greyN 0.5)) 15 400 40
shellTrailCloud = makeCloudAt (CloudColor (3/2) 100 (greyN 0.5)) 15 400 80
shellTrailCloud' :: Int -> Float -> Point3 -> World -> World
shellTrailCloud' age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 80
makeFlamerSmokeAt :: Point3 -> World -> World
makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
src/Dodge/WorldEvent/SpawnParticle.hs
+1 -1
View File
@@ -93,7 +93,7 @@ makeGasCloud pos vel w =
Cloud
{ _clPos = addZ 20 pos
, _clVel = addZ 0 vel
, _clPict = DrawGasCloud col
, _clPict = CloudColor 3 50 (withAlpha 0.05 col)
, _clRad = 10
, _clAlt = 25
, _clTimer = 400