{- | Contains the central drawing functions for the dodge loop. -} module Dodge.Render ( doDrawing ) where import Dodge.Data import Dodge.Config.Data import Dodge.Base.Window --import Dodge.Render.HUD --import Dodge.Render.MenuScreen import Dodge.Render.Picture --import Dodge.Render.PerspectiveMatrix import Geometry import Geometry.Data --import Picture import Render import Data.Preload.Render import Picture.Data import Shader import Shader.Data import Shader.Poke import MatrixHelper --import Polyhedra.Data import Polyhedra import Foreign --import Control.Applicative --import Control.Monad.State import Control.Lens import Control.Monad import qualified Control.Foldl as F --import Data.Tuple.Extra --import Data.List --import Data.Bifunctor --import Data.Function --import qualified Data.IntMap.Strict as IM --import qualified Data.Map as M --import qualified Data.Set as S import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) import qualified SDL doDrawing :: RenderData -> World -> IO Word32 doDrawing pdata w = do sTicks <- SDL.ticks let rot = _cameraRot w camzoom = _cameraZoom w trans = _cameraCenter w wins = (getWindowX w,getWindowY w) (wallPointsCol,windowPoints) = wallsAndWindows w lightPoints = lightsForGloom w viewFroms = _cameraViewFrom w pic = worldPictures w -- bind as much data into vbos as feasible at this point -- poke wall points and colors -- _ <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol) --pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) $ wallsToList wallPointsCol --let nWalls = length wallPointsCol nWalls <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) wallPointsCol --poke -- poke silhouette vertex data -- nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) -- (concatMap polyToRender (foregroundPics w)) nSils <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingLineShadowShader pdata) (_foregroundEdgeVerx w) -- poke foreground geometry and floor let addC (xx,yy) = (xx,yy,0) nsurfVs <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingSurfaceShader pdata) $ (polyToTris $ map addC $ screenPolygon w) ++ concatMap polyToGeoRender' (foregroundPics w) --nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) -- $ Render3 (polyToTris $ map addC $ screenPolygon w) -- : concatMap polyToGeoRender (foregroundPics w) -- bind wall points, silhouette data, surface geometry uncurry bindShaderBuffers $ unzip [ ( _wallTextureShader pdata, nWalls) , (_lightingLineShadowShader pdata, nSils) , (_lightingSurfaceShader pdata, nsurfVs) ] -- set the coordinate uniform ready for drawing elements using world coordinates bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms bindFramebuffer Framebuffer $= fst (_fboBase pdata) clearColor $= Color4 0 0 0 0 clear [ColorBuffer,DepthBuffer] depthFunc $= Just Less if w ^. config . wall_textured then renderTextureWalls pdata nWalls else renderBlankWalls pdata nWalls _ <- renderFoldable pdata $ polysToPic $ foregroundPics w vnums <- pokeBindFoldableLayer pdata $ pic let shads = _pictureShaders pdata --mapM_ (uncurry $ drawShaderLay 0) ((,) <$> shads <*> count) renderLayer 0 shads vnums _ <- renderShader (_textureArrayShader pdata) (_floorTiles w) bindFramebuffer Framebuffer $= fst (_fboBloom pdata) clear [ColorBuffer] blendFunc $= (SrcAlpha,OneMinusSrcAlpha) --mapM_ (uncurry $ drawShaderLay 1) (vnums IM.! 1) renderLayer 1 shads vnums bindFramebuffer Framebuffer $= fst (_fboColor pdata) clear [ColorBuffer] depthMask $= Disabled --mapM_ (uncurry $ drawShaderLay 3) (vnums IM.! 3) --mapM_ (uncurry $ drawShaderLay 4) (vnums IM.! 4) --mapM_ (uncurry $ drawShaderLay 5) (vnums IM.! 5) renderLayer 3 shads vnums renderLayer 4 shads vnums renderLayer 5 shads vnums depthMask $= Enabled bindFramebuffer Framebuffer $= fst (_fboFourth1 pdata) viewport $= (Position 0 0, Size 300 300) depthFunc $= Just Always textureBinding Texture2D $= Just (snd $ _fboBloom pdata) blend $= Disabled drawShader (_bloomBlurShader pdata) 4 replicateM_ 3 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata) viewport $= (Position 0 0, Size (round $ fst wins) (round $ snd wins)) blend $= Enabled bindFramebuffer Framebuffer $= fst (_fboLighting pdata) viewport $= (Position 0 0 ,divideSize (w ^. config . shadow_resolution) $ Size (round $ fst wins) (round $ snd wins)) createLightMap pdata lightPoints nWalls nSils nsurfVs viewport $= (Position 0 0, Size (round $ fst wins) (round $ snd wins)) colorMask $= Color4 Enabled Enabled Enabled Enabled clearColor $= Color4 0 0 0 0 blend $= Disabled depthMask $= Disabled depthFunc $= Just Always bindFramebuffer Framebuffer $= fst (_fboBase pdata) --drawShader (_fullscreenShader pdata) 4 --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata) textureBinding Texture2D $= Just (snd $ _fboLighting pdata) blend $= Enabled blendFunc $= (Zero, OneMinusSrcAlpha) drawShader (_fullscreenShader pdata) 4 blendFunc $= (SrcAlpha, OneMinusSrcAlpha) textureBinding Texture2D $= Just (snd $ _fboColor pdata) drawShader (_colorBlurShader pdata) 4 --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata) textureBinding Texture2D $= Just (snd $ _fboFourth1 pdata) drawShader (_fullscreenShader pdata) 4 textureBinding Texture2D $= Just (snd $ _fboBloom pdata) drawShader (_fullscreenShader pdata) 4 depthFunc $= Just Lequal --mapM_ (uncurry $ drawShaderLay 2) (vnums IM.! 2) renderLayer 2 shads vnums renderWindows pdata windowPoints depthFunc $= Just Always blendFunc $= (One,Zero) -- perform any radial distortion case _radDistortion w of [] -> do bindTO $ snd $ _fboBase pdata bindFramebuffer Framebuffer $= defaultFramebufferObject --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms drawShader (_fullscreenShader pdata) 4 rds -> do let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO () bindDrawDist ((a,b),(c,d),(e,f),g) = do --bindDrawDist distParam = do --_ <- F.foldM (pokeShader $ _barrelShader pdata) [Render2221 distParam] pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _barrelShader pdata) [a,b,c,d,e,f,g] bindShaderBuffers [_barrelShader pdata] [1] drawShader (_barrelShader pdata) 1 fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata,fst $ _fbo3 pdata])) ++ [defaultFramebufferObject] toList = snd (_fboBase pdata) : concat (repeat [snd $ _fbo2 pdata,snd $ _fbo3 pdata]) bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList) activeTexture $= TextureUnit 1 zipWithM_ (>>) bindings $ map bindDrawDist rds activeTexture $= TextureUnit 0 -- draw overlay bufferUBO $ isoMatrix 0 1 (0,0) (2,2) depthFunc $= Just Always depthMask $= Disabled blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) _ <- renderFoldable pdata $ fixedCoordPictures w depthMask $= Enabled eTicks <- SDL.ticks return (eTicks - sTicks) bindTO :: TextureObject -> IO () bindTO t = textureBinding Texture2D $= Just t bindFBO :: FramebufferObject -> IO () bindFBO fb = bindFramebuffer Framebuffer $= fb -------------------------------------------------------------------------------- -- note: currently assume there is only one UBO, we only bind it once at setup bufferUBO :: [Float] -> IO () bufferUBO mat = withArray mat $ \ptr -> bufferSubData UniformBuffer WriteToBuffer 0 64 ptr renderBlankWalls :: RenderData -> Int -- ^ number of walls -> IO () renderBlankWalls pdata nWalls = do cullFace $= Just Back drawShader (_wallBlankShader pdata) nWalls cullFace $= Nothing renderWindows :: RenderData -> [((Point2,Point2),Point4)] -- ^ List: wall positions and color -> IO () renderWindows pdata wps = do --n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps) n <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallBlankShader pdata) wps bindShaderBuffers [_wallBlankShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) cullFace $= Just Back drawShader (_wallBlankShader pdata) n cullFace $= Nothing renderTextureWalls :: RenderData -> Int -- ^ number of walls -> IO () renderTextureWalls pdata nWalls = do cullFace $= Just Back drawShader (_wallTextureShader pdata) nWalls cullFace $= Nothing