214 lines
8.9 KiB
Haskell
214 lines
8.9 KiB
Haskell
{-# 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 (Float,Float,Float,Float)
|
|
, _lightingOccludeShader :: FullShader (Point2,Point2)
|
|
, _lightingWallShader :: FullShader (Point2,Point2)
|
|
, _wallBlankShader :: FullShader ((Point2,Point2),Point4)
|
|
, _wallTextureShader :: FullShader ((Point2,Point2),Point4)
|
|
, _backgroundShader :: FullShader (Point2,Point2,Point2,Point2)
|
|
, _fullscreenShader :: FullShader ()
|
|
, _boxBlurShader :: FullShader ()
|
|
, _grayscaleShader :: FullShader ()
|
|
, _pictureShaders :: [FullShader RenderType]
|
|
, _spareFBO :: FramebufferObject
|
|
, _fboTexture :: TextureObject
|
|
, _fboRenderbufferObject :: RenderbufferObject
|
|
, _fbo2 :: (FramebufferObject, TextureObject, RenderbufferObject)
|
|
, _fbo3 :: (FramebufferObject, TextureObject, RenderbufferObject)
|
|
}
|
|
makeLenses ''RenderData
|
|
|
|
preloadRender :: IO RenderData
|
|
preloadRender = do
|
|
-- lighting shaders
|
|
lsShad <- makeShader "lighting/floor" [vert,geom,frag] [(0,4)] Points
|
|
(return . return . flat4)
|
|
wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [(0,4)] Points pokeWPStrat
|
|
>>= addUniforms ["lightPos"]
|
|
wlLightShad
|
|
<- makeShader "lighting/wall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
|
|
>>= addUniforms ["lightPos","radLum"]
|
|
-- 2D draw shaders
|
|
bslist <- makeShader "twoD/basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
|
|
lslist <- makeShader "twoD/basic" [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
|
|
aslist <- makeShader "twoD/arc" [vert,geom,frag] [(0,3),(1,4),(2,4)] Points pokeArcStrat
|
|
eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeEllStrat
|
|
bezierQuadShader <- makeShader
|
|
"twoD/bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)] TriangleStrip pokeBezQStrat
|
|
cslist <- makeShader "twoD/character" [vert,geom,frag]
|
|
[(0,3),(1,4),(2,3)] Points pokeCharStrat
|
|
>>= addTexture "data/texture/charMap.png"
|
|
-- texture shaders, no textures attached
|
|
fsShad <- makeShader "texture/simple" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
|
|
[[[-1, 1],[0,1]]
|
|
,[[ 1, 1],[1,1]]
|
|
,[[-1,-1],[0,0]]
|
|
,[[ 1,-1],[1,0]]
|
|
]
|
|
_ <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
|
|
boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
|
|
[[[-1, 1],[0,1]]
|
|
,[[ 1, 1],[1,1]]
|
|
,[[-1,-1],[0,0]]
|
|
,[[ 1,-1],[1,0]]
|
|
]
|
|
_ <- F.foldM (pokeShader boxBlurShad) [()] -- fix fullscreen vertex positions now
|
|
grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
|
|
[[[-1, 1],[0,1]]
|
|
,[[ 1, 1],[1,1]]
|
|
,[[-1,-1],[0,0]]
|
|
,[[ 1,-1],[1,0]]
|
|
]
|
|
_ <- F.foldM (pokeShader grayscaleShad) [()] -- fix fullscreen vertex positions now
|
|
-- background shader
|
|
bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
|
|
>>= addTexture "data/texture/marbleSlabs.png"
|
|
-- >>= addTexture "data/texture/smudgedDirt.png"
|
|
-- blank wallShader
|
|
wlBlank <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
|
|
-- textured wallShader
|
|
wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
|
|
>>= addTexture "data/texture/grayscaleDirt.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 = lsShad
|
|
, _lightingOccludeShader = wsShad
|
|
, _lightingWallShader = wlLightShad
|
|
, _wallBlankShader = wlBlank
|
|
, _wallTextureShader = wlTexture
|
|
, _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 (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
|
|
pokeTriStrat _ = []
|
|
|
|
pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
|
|
pokeCharStrat _ = []
|
|
|
|
pokeArcStrat (RenderArc (a,b,c)) = [flat3 (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 :: (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]]]
|
|
|
|
pokeBGStrat :: a -> [[[Float]]]
|
|
pokeBGStrat = const []
|