{- | 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.Picture import Geometry import Render import Data.Preload.Render import Shader import Shader.Poke import Shader.Bind import Shader.Data 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 import qualified Data.Vector.Unboxed.Mutable as UMV doDrawing :: RenderData -> World -> IO Word32 doDrawing pdata w = do sTicks <- SDL.ticks let rot = _cameraRot w camzoom = _cameraZoom w trans = _cameraCenter w wins = V2 (getWindowX w) (getWindowY w) (wallPointsCol,windowPoints) = wallsAndWindows w lightPoints = lightsForGloom w viewFroms = _cameraViewFrom w shadV = _pictureShaders pdata -- bind as much data into vbos as feasible at this point -- poke wall points and colors nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) (_foregroundEdgeVerx w) -- poke foreground geometry and floor let addC (V2 xx yy) = V3 xx yy 0 nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata) $ 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 viewport $= (Position 0 0 , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) 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 -- draw wall occlusions from your point of view drawShader (_lightingOccludeShader pdata) nWalls -- this might only work because the uniform has been correctly set -- elsewhere, beware renderFoldable shadV $ polysToPic $ foregroundPics w layerCounts <- UMV.replicate (6*6) 0 pokeBindFoldableLayer shadV layerCounts $ worldPictures w renderLayer 0 shadV layerCounts nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w) bindShaderBuffers [_textureArrayShader pdata] [nTextArrayVs] drawShader (_textureArrayShader pdata) nTextArrayVs bindFramebuffer Framebuffer $= fst (_fboBloom pdata) clear [ColorBuffer] blendFunc $= (SrcAlpha,OneMinusSrcAlpha) renderLayer 1 shadV layerCounts bindFramebuffer Framebuffer $= fst (_fboColor pdata) clear [ColorBuffer] depthMask $= Disabled renderLayer 3 shadV layerCounts renderLayer 4 shadV layerCounts renderLayer 5 shadV layerCounts depthMask $= Enabled -- this is not ideal if the original is not divisible by 2 viewport $= (Position 0 0 , divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) bindFramebuffer Framebuffer $= fst (_fboFourth1 pdata) depthFunc $= Just Always textureBinding Texture2D $= Just (snd $ _fboBloom pdata) blend $= Disabled drawShader (_bloomBlurShader pdata) 4 replicateM_ 3 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata) blend $= Enabled viewport $= (Position 0 0 , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) bindFramebuffer Framebuffer $= fst (_fboLighting pdata) createLightMap pdata lightPoints nWalls nSils nsurfVs 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) blendFunc $= (SrcAlpha, One) textureBinding Texture2D $= Just (snd $ _fboFourth1 pdata) drawShader (_fullscreenShader pdata) 4 blendFunc $= (SrcAlpha, OneMinusSrcAlpha) textureBinding Texture2D $= Just (snd $ _fboBloom pdata) drawShader (_fullscreenShader pdata) 4 depthFunc $= Just Lequal --mapM_ (uncurry $ drawShaderLay 2) (vnums IM.! 2) renderLayer 2 shadV layerCounts renderWindows pdata windowPoints viewport $= (Position 0 0, Size (round $ fstV2 wins) (round $ sndV2 wins)) 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 ( V2 a b , V2 c d , V2 e f , g) = do pokeArray (shadVBOptr $ _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 (V2 0 0) (V2 2 2) depthFunc $= Just Always depthMask $= Disabled blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) renderFoldable shadV $ 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 <- poke224s (shadVBOptr $ _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