Set up wall rendering with textures
This commit is contained in:
+1
-4
@@ -62,10 +62,7 @@ main = do
|
||||
(_cameraCenter w)
|
||||
(worldPictures w)
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
renderFoldable (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)
|
||||
(_windowX w,_windowY w)
|
||||
--(picToLTree (Just 1) $ fixedCoordPictures w)
|
||||
(picToLTree Nothing $ fixedCoordPictures w)
|
||||
renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
|
||||
endRenderTicks <- SDL.ticks
|
||||
playSoundQueue (_soundData preData) (_soundQueue w)
|
||||
newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
|
||||
|
||||
@@ -439,10 +439,11 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
|
||||
scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
|
||||
$ _crHP $ _creatures w IM.! n
|
||||
|
||||
wallsForGloom :: World -> [(Point2,Point2)]
|
||||
wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
|
||||
wallsForGloom :: World -> [((Point2,Point2),Point4)]
|
||||
wallsForGloom w = map f $ filter (not . _wlIsSeeThrough)
|
||||
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
|
||||
where linePairs (x:y:_) = (x,y)
|
||||
f wl = (linePairs $ _wlLine wl, _wlColor wl)
|
||||
|
||||
lightsForGloom' :: World -> [(Point4)]
|
||||
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
|
||||
|
||||
@@ -21,7 +21,7 @@ data RenderData = RenderData
|
||||
{ _lightSourceShader :: FullShader (Float,Float,Float,Float)
|
||||
, _wallShadowShader :: FullShader (Point2,Point2)
|
||||
, _wallLightShader :: FullShader (Point2,Point2)
|
||||
, _wallFaceShader :: FullShader (Point2,Point2,Point4)
|
||||
, _wallFaceShader :: FullShader ((Point2,Point2),Point4)
|
||||
, _backgroundShader :: FullShader (Point2,Point2,Point2,Point2)
|
||||
, _fullscreenShader :: FullShader ()
|
||||
, _listShaders :: [FullShader RenderType]
|
||||
@@ -155,8 +155,8 @@ frag = FragmentShader
|
||||
pokeWPStrat :: (Point2,Point2) -> [[[Float]]]
|
||||
pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]
|
||||
|
||||
pokeWPColStrat :: (Point2,Point2,Point4) -> [[[Float]]]
|
||||
pokeWPColStrat ((x,y),(z,w),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]]
|
||||
pokeWPColStrat :: ((Point2,Point2),Point4) -> [[[Float]]]
|
||||
pokeWPColStrat (((x,y),(z,w)),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]]
|
||||
|
||||
pokeBGStrat :: a -> [[[Float]]]
|
||||
pokeBGStrat = const []
|
||||
|
||||
+39
-45
@@ -41,37 +41,40 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
: (map extractProgAndUnis $ _listShaders pdata)
|
||||
)
|
||||
|
||||
createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2)] -> [Point4] ->
|
||||
(Float,Float) -> Picture -> IO ()
|
||||
createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
(viewFromx,viewFromy) pic = do
|
||||
return ()
|
||||
|
||||
renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2)] -> [Point4] ->
|
||||
[((Point2,Point2),Point4)] -> [Point4] ->
|
||||
(Float,Float) -> Picture -> IO (Word32,Word32)
|
||||
renderPicture' pdata rot zoom trans wins wallPoints lightPoints
|
||||
viewFroms pic = do
|
||||
renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol lightPoints
|
||||
viewFroms@(viewFromx,viewFromy) pic = do
|
||||
let wallPoints = map fst wallPointsCol
|
||||
startTicks <- SDL.ticks
|
||||
setCommonUniforms pdata rot zoom trans wins
|
||||
renderPicture pdata rot zoom trans wins wallPoints lightPoints viewFroms pic
|
||||
endTicks <- SDL.ticks
|
||||
return (startTicks, endTicks - startTicks)
|
||||
|
||||
renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2)] -> [Point4] ->
|
||||
(Float,Float) -> Picture -> IO (Word32,Word32)
|
||||
renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
(viewFromx,viewFromy) pic = do
|
||||
wallPokeStart <- SDL.ticks
|
||||
|
||||
-- setting the depth function to less, instead of lequal,
|
||||
-- seems to stop a lot of unecessary drawing
|
||||
-- of wall shadows when creating the light map
|
||||
depthFunc $= Just Less
|
||||
|
||||
-- draw lightmap
|
||||
-- calculate perspective matrix
|
||||
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
|
||||
ticksAfterLighting <- SDL.ticks
|
||||
renderBackground pdata rot zoom trans wins
|
||||
renderWalls pdata wallPointsCol pmat
|
||||
renderPicture pdata pic
|
||||
endTicks <- SDL.ticks
|
||||
return (ticksAfterLighting, endTicks - startTicks)
|
||||
|
||||
renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO ()
|
||||
renderWalls pdata wps pmat = do
|
||||
n <- F.foldM (pokeShader $ _wallFaceShader pdata) wps
|
||||
return ()
|
||||
|
||||
createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2)] -> [Point4] ->
|
||||
(Float,Float) -> GLmatrix GLfloat -> IO ()
|
||||
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
|
||||
@@ -79,11 +82,6 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
clearDepth $= 1
|
||||
clear [ColorBuffer,DepthBuffer]
|
||||
|
||||
-- calculate perspective matrix
|
||||
pmat <- (newMatrix RowMajor
|
||||
$ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
|
||||
) :: IO (GLmatrix GLfloat)
|
||||
|
||||
nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints
|
||||
bindShaderBuffers [_wallLightShader pdata] [nWallLights]
|
||||
currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
|
||||
@@ -171,14 +169,16 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
|
||||
blend $= Enabled
|
||||
|
||||
-- draw picture on top of light/shadow map
|
||||
renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
|
||||
renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
depthFunc $= Just Less
|
||||
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
clear [DepthBuffer]
|
||||
|
||||
-- draw background
|
||||
bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
|
||||
depthFunc $= Just Less
|
||||
|
||||
currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
|
||||
@@ -189,34 +189,28 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
textureBinding Texture2D $= (fmap _textureObject $ _shaderTexture $ _backgroundShader pdata)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
renderPicture :: RenderData -> Picture -> IO ()
|
||||
renderPicture pdata pic = do
|
||||
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- draw layer 0
|
||||
ticks2 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 0) pic
|
||||
ticks2 <- renderFoldable pdata $ picToLTree (Just 0) pic
|
||||
--((picToAlt 0 pic) :: [RenderType])
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
ticks3 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 1) pic
|
||||
ticks3 <- renderFoldable pdata $ picToLTree (Just 1) pic
|
||||
-- set drawing for on top
|
||||
aticks <- SDL.ticks
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic
|
||||
ticks4 <- renderFoldable pdata $ picToLTree (Just 2) pic
|
||||
bticks <- SDL.ticks
|
||||
|
||||
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
|
||||
|
||||
endWallTicks <- SDL.ticks
|
||||
--return (ticksAfterL, ticks2+ticks3+ticks4, endWallTicks - startWallTicks)
|
||||
ticksE <- SDL.ticks
|
||||
--return (ticksAfterL, ticksE - ticksS)
|
||||
--return (ticksAfterL, ticks2 + ticks3 + ticks4)
|
||||
return (ticksAfterL, wallPokeEnd - wallPokeStart)
|
||||
|
||||
----------------end renderPicture'
|
||||
|
||||
renderFoldable :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
-> f RenderType -> IO Word32
|
||||
renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32
|
||||
renderFoldable pdata tree = do
|
||||
pokeStartTicks <- SDL.ticks
|
||||
|
||||
let slist = _listShaders pdata
|
||||
|
||||
Reference in New Issue
Block a user