Add wall drawing capability (for shadows)

This commit is contained in:
jgk
2021-02-22 02:32:00 +01:00
parent 3dc566b6af
commit c75cda639b
7 changed files with 97 additions and 14 deletions
+3 -1
View File
@@ -53,7 +53,9 @@ main = do
\preData w -> --do render setparams w egFade
renderPicture' preData (_cameraRot w) (_cameraZoom w)
(_cameraPos w)
(_windowX w,_windowY w) (draw blank w)
(_windowX w,_windowY w)
(wallsForGloom' w)
(draw blank w)
--renderPicture' preData (_windowX w,_windowY w) (Circle 5)
-- renderPicture' preData
-- (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)]
Binary file not shown.
Binary file not shown.
+1 -1
View File
@@ -3,5 +3,5 @@ out vec4 fColor;
void main()
{
fColor = vec4 (0.9,0.9,0,1);
fColor = vec4 (0.9,0.5,0,1);
}
+6 -7
View File
@@ -9,17 +9,16 @@ void main()
{
vec2 posa = gl_in[0].gl_Position.xy;
vec2 posb = gl_in[0].gl_Position.zw;
vec2 v = normalize( posb - posa);
vec2 off = vec2( -(v.y *0.2)
, v.x *0.2 );
vec2 posc = vBackPoss[0].xy;
vec2 posd = vBackPoss[0].zw;
gl_Position = vec4 (posa, 0 , 1);
gl_Position = vec4 (posa, -1 , 1);
EmitVertex();
gl_Position = vec4 (posb, 0 , 1);
gl_Position = vec4 (posb, -1 , 1);
EmitVertex();
gl_Position = vec4 (posa + off, 0 , 1);
gl_Position = vec4 (posc, -1 , 1);
EmitVertex();
gl_Position = vec4 (posb + off, 0 , 1);
gl_Position = vec4 (posd, -1 , 1);
EmitVertex();
EndPrimitive();
+12
View File
@@ -508,6 +508,18 @@ wallsForGloom w = map (\(x:y:_) -> (screenShift x,screenShift y)) $
where screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
zoom = _cameraZoom w
wallsForGloom' :: World -> [(Point2,Point2,Point2,Point2)]
wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThrough)
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where wallPairToFour (x:y:_) = (ss x,ss y,ss $ x +.+ n,ss $ y+.+ n)
where n = 20 *.* (normalizeV $ vNormal $ y -.- x)
ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
ss = ss'' . ss'
-- the ss transformation would possibly be better done using a matrix in the
-- shader
zoom = _cameraZoom w
lightsForGloom :: World -> [(Point2,Float,Float)]
lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
+75 -5
View File
@@ -247,8 +247,81 @@ threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float)
threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
(a:b:c:_) -> (a,b,c)
renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) pic = do
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
let firstIndex = 0
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
-- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
<- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)
(threePtrsVAO $ _textVAO pdata)
(threePtrsVAO $ _circVAO pdata)
(twoPtrsVAO $ _lineVAO pdata)
(threePtrsVAO $ _arcVAO pdata)
) $ picToFTree pic
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
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
pokeTwoOff backPtr2 0 (winx,winy)
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
textureBinding Texture2D $= Just (_textures pdata !! 1)
drawArrays Points (fromIntegral 0) (fromIntegral 1)
-- draw triangles
currentProgram $= Just (_basicShader pdata)
bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
-- draw lines, don't need to change the program or vaos, just need to bind the
-- vbos and draw
bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata
drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs)
-- draw circles
currentProgram $= Just (_circShader pdata)
uniform (_uniWinSize pdata) $= Vector2 winx winy
uniform (_csZoomUni pdata) $= zoom
bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
-- draw arcs
currentProgram $= Just (_arcShader pdata)
uniform (_asWinUni pdata) $= Vector2 winx winy
uniform (_asZoomUni pdata) $= zoom
bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs)
-- draw text
currentProgram $= Just (_textShader pdata)
bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
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
renderPicture :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do
let firstIndex = 0
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
@@ -303,6 +376,3 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) 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