{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module Picture.Preload ( RenderData (..) , preloadRender , cleanUpRenderPreload ) where import Picture.Data import Shader import Geometry.Data import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Control.Lens import Foreign import qualified Control.Foldl as F data RenderData = RenderData { _lightingFloorShader :: FullShader , _lightingOccludeShader :: FullShader , _lightingWallShader :: FullShader , _wallBlankShader :: FullShader , _wallTextureShader :: FullShader , _backgroundShader :: FullShader --, _textureShader :: FullShader (Point3,Point2) , _fullscreenShader :: FullShader , _boxBlurShader :: FullShader , _grayscaleShader :: FullShader , _pictureShaders :: [FullShader] , _spareFBO :: FramebufferObject , _fboTexture :: TextureObject , _fboRenderbufferObject :: RenderbufferObject , _fbo2 :: (FramebufferObject, TextureObject, RenderbufferObject) , _fbo3 :: (FramebufferObject, TextureObject, RenderbufferObject) } makeLenses ''RenderData preloadRender :: IO RenderData preloadRender = do -- lighting shaders lightingFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [4] Points pokeLightingFloorStrat wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] Points pokeWPStrat >>= addUniforms ["lightPos"] wlLightShad <- makeShader "lighting/wall" [vert,geom,frag] [4] Points pokeWPStrat >>= addUniforms ["lightPos","radLum"] -- 2D draw shaders bslist <- makeShader "twoD/basic" [vert,frag] [3,4] Triangles pokeTriStrat lslist <- makeShader "twoD/basic" [vert,frag] [3,4] Lines pokeLineStrat aslist <- makeShader "twoD/arc" [vert,geom,frag] [3,4,4] Points pokeArcStrat eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4] Triangles pokeEllStrat bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] TriangleStrip pokeBezQStrat cslist <- makeShader "twoD/character" [vert,geom,frag] [3,4,3] Points pokeCharStrat >>= addTexture "data/texture/charMap.png" -- texture shaders, no textures attached fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const [[[-1, 1],[0,1]] ,[[ 1, 1],[1,1]] ,[[-1,-1],[0,0]] ,[[ 1,-1],[1,0]] ] _ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const [[[-1, 1],[0,1]] ,[[ 1, 1],[1,1]] ,[[-1,-1],[0,0]] ,[[ 1,-1],[1,0]] ] _ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const [[[-1, 1],[0,1]] ,[[ 1, 1],[1,1]] ,[[-1,-1],[0,0]] ,[[ 1,-1],[1,0]] ] _ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now -- background shader bgShad <- makeShader "background" [vert,geom,frag] [4,2] Points pokeBGStrat >>= addTexture "data/texture/marbleSlabs.png" -- >>= addTexture "data/texture/smudgedDirt.png" -- blank wallShader wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] Points pokeWPColStrat -- textured wallShader wlTexture <- makeShader "wall/texture" [vert,geom,frag] [4,4] Points pokeWPColStrat >>= addTexture "data/texture/grayscaleDirt.png" ---- texture shader -- textShad <- makeShader "texture/simpleWorld" [vert,frag] [(0,3),(1,2)] Triangles poke32 -- >>= addTexture "data/texture/ayene_wooden_floor.png" -- framebuffer for lighting (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil framebuf2 <- setupFramebufferWithStencil framebuf3 <- setupFramebufferWithStencil -- reset to default framebuffer, ready for drawing direct to screen bindFramebuffer Framebuffer $= defaultFramebufferObject return $ RenderData { _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader] , _lightingFloorShader = lightingFloorShad , _lightingOccludeShader = wsShad , _lightingWallShader = wlLightShad , _wallBlankShader = wlBlank , _wallTextureShader = wlTexture --, _textureShader = textShad , _backgroundShader = bgShad , _fullscreenShader = fsShad , _boxBlurShader = boxBlurShad , _grayscaleShader = grayscaleShad , _spareFBO = fbo , _fboTexture = fboTO , _fboRenderbufferObject = fboRBO , _fbo2 = framebuf2 , _fbo3 = framebuf3 } -- potential drawing setup ---- swapInterval $= ImmediateUpdates -- GL.blend $= GL.Enabled ---- GL.depthMask $= GL.Enabled -- GL.blendEquation $= GL.FuncAdd -- GL.blendFunc $= (GL.SrcAlpha,GL.OneMinusSrcAlpha) -- GL.clearColor $= GL.Color4 0 0.5 0 1 -- GL.clearDepth $= (200) -- swapInterval $= ImmediateUpdates -- GL.lineSmooth $= GL.Enabled --------------------end preloadRender setupFramebufferWithStencil :: IO (FramebufferObject, TextureObject,RenderbufferObject) setupFramebufferWithStencil = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName fboTO <- genObjectName textureBinding Texture2D $= Just fboTO texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) textureFilter Texture2D $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 fboRBO <- genObjectName bindRenderbuffer Renderbuffer $= fboRBO renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO fboStatus <- framebufferStatus Framebuffer print fboStatus return (fboName, fboTO, fboRBO) setupFramebuffer :: IO (FramebufferObject, TextureObject) setupFramebuffer = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName fboTO <- genObjectName textureBinding Texture2D $= Just fboTO texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 600 600) 0 (PixelData RGBA UnsignedByte nullPtr) textureFilter Texture2D $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 fboRBO <- genObjectName bindRenderbuffer Renderbuffer $= fboRBO renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 600 600) framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO fboStatus <- framebufferStatus Framebuffer print fboStatus return (fboName, fboTO) cleanUpRenderPreload :: RenderData -> IO () cleanUpRenderPreload pd = do mapM_ freeShaderPointers $ _pictureShaders pd freeShaderPointers $ _lightingFloorShader pd freeShaderPointers $ _lightingOccludeShader pd freeShaderPointers $ _backgroundShader pd freeShaderPointers $ _fullscreenShader pd {-# INLINE pokeBezQStrat #-} pokeBezQStrat :: RenderType -> [[[Float]]] pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,u,v)) -> [[x,y,z],[r,g,b,a],[s,t,u,v]] ) vs pokeBezQStrat _ = [] {-# INLINE pokeTriStrat #-} pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[[Float]]] pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> [flat3 p,flat4 co]) vs pokeTriStrat _ = [] pokeLightingFloorStrat :: RenderType -> [[[Float]]] pokeLightingFloorStrat Render1111{_unRender1111=x} = [[flat4 x]] pokeLightingFloorStrat _ = undefined pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> [flat3 a, flat4 b, flat3 c]) vs pokeCharStrat _ = [] pokeArcStrat (RenderArc (a,b,c)) = [[flat3 a, flat4 b, flat4 c]] pokeArcStrat _ = [] pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs pokeLineStrat _ = [] pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs pokeEllStrat _ = [] vert, geom, frag :: ShaderType vert = VertexShader geom = GeometryShader frag = FragmentShader pokeWPStrat :: RenderType -> [[[Float]]] pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[[x,y,z,w]]] pokeWPStrat _ = undefined pokeWPColStrat :: RenderType -> [[[Float]]] pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[[x,y,z,w],[r,g,b,a]]] pokeWPColStrat _ = undefined poke32 :: (Point3,Point2) -> [[[Float]]] poke32 ((x,y,z),(a,b)) = [[[x,y,z],[a,b]]] pokeBGStrat :: a -> [[[Float]]] pokeBGStrat = const []