{- | Contains the central drawing functions for the dodge loop. -} module Dodge.Render ( doDrawing ) where import Dodge.Data import Dodge.Config.Data import Dodge.Base --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 Picture.Tree 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 nWalls <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol) -- poke silhouette vertex data nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) (concatMap polyToRender (foregroundPics w)) -- poke foreground geometry and floor let addC (xx,yy) = (xx,yy,0) 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 $ (picToAlt (Just 0) (polysToPic $ foregroundPics w) :: [RenderType]) --_ <- renderFoldable pdata $ (picToAlt (Just 0) pic :: [RenderType]) _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w) _ <- renderFoldable pdata $ picToLTree (Just 0) pic _ <- renderShader (_textureArrayShader pdata) (_floorTiles w) bindFramebuffer Framebuffer $= fst (_fboBloom pdata) clear [ColorBuffer] blendFunc $= (SrcAlpha,OneMinusSrcAlpha) _ <- renderFoldable pdata $ picToLTree (Just 1) pic bindFramebuffer Framebuffer $= fst (_fboColor pdata) clear [ColorBuffer] depthMask $= Disabled _ <- renderFoldable pdata $ picToLTree (Just 3) pic _ <- renderFoldable pdata $ picToLTree (Just 4) pic _ <- renderFoldable pdata $ picToLTree (Just 5) pic 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 _ <- renderFoldable pdata $ picToLTree (Just 2) pic 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 distParam = do _ <- F.foldM (pokeShader $ _barrelShader pdata) [Render2221 distParam] 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 (picToLTree Nothing $ 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) 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