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

First pass implementing exponentially fading lighting

Browse Source
This commit is contained in:
justin
2021-02-22 13:45:59 +01:00
parent c75cda639b
commit e855d303e8
10 changed files with 117 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Render.hs
+39 -14
View File
@@ -248,8 +248,44 @@ threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
(a:b:c:_) -> (a,b,c)
renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
[(Point2,Point2,Point2,Point2)] -> Picture -> IO ()
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
[(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO ()
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
depthFunc $= Just Lequal
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
foldWalls n ((x,y),(z,w),(a,b),(c,d)) = do
pokeFourOff wallPtr n (x,y,z,w)
pokeFourOff wallPtr2 n (a,b,c,d)
return $ n+1
nWalls <- foldM foldWalls 0 wallPoints
forM_ lightPoints $ \(x,y,r,lum) -> do
cullFace $= Just Front
clear [DepthBuffer]
currentProgram $= Just (_wallShadowShader pdata)
bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
uniform (_wssLightPos pdata) $= Vector2 (x) (y)
blendFunc $= (Zero,One)
drawArrays Points (fromIntegral 0) (fromIntegral $ length wallPoints)
cullFace $= Nothing
currentProgram $= Just (_fadeCircleShader pdata)
bindVertexArrayObject $= Just (_vao $ _fadeCircVAO pdata)
let fadeCircPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _fadeCircVAO pdata
pokeFourOff fadeCircPtr 0 (x,y,r,lum)
bindArrayBuffers (1) $ _vaoBufferTargets $ _fadeCircVAO pdata
uniform (_fcsWinUni pdata) $= Vector2 winx winy
uniform (_fcsZoomUni pdata) $= zoom
-- to refactor: put these uniforms in a ubo
blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
drawArrays Points (fromIntegral 0) (fromIntegral 1)
-- set drawing for on top
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
clear [DepthBuffer]
let firstIndex = 0
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
@@ -263,18 +299,6 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
depthFunc $= Just Less
currentProgram $= Just (_wallShadowShader pdata)
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
foldWalls n ((x,y),(z,w),(a,b),(c,d)) = do
pokeFourOff wallPtr n (x,y,z,w)
pokeFourOff wallPtr2 n (a,b,c,d)
return $ n+1
nWalls <- foldM foldWalls 0 wallPoints
bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
drawArrays Points (fromIntegral 0) (fromIntegral $ length wallPoints)
currentProgram $= Just (_backShader pdata)
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
@@ -316,6 +340,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
textureBinding Texture2D $= Just (_textures pdata !! 0)
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
bufferOffset :: Integral a => a -> Ptr b
bufferOffset = plusPtr nullPtr . fromIntegral