Module reorganisation
This commit is contained in:
@@ -1,18 +0,0 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Preload.Data
|
||||
where
|
||||
import Control.Lens
|
||||
import GHC.Word (Word32)
|
||||
|
||||
import Picture.Preload
|
||||
import Sound.Data
|
||||
import Music
|
||||
|
||||
data PreloadData a = PreloadData
|
||||
{ _renderData :: RenderData
|
||||
, _soundData :: SoundData a
|
||||
, _musicData :: MusicData
|
||||
, _frameTimer :: Word32
|
||||
}
|
||||
|
||||
makeLenses ''PreloadData
|
||||
@@ -0,0 +1,202 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
||||
module Preload.Render
|
||||
( preloadRender
|
||||
, cleanUpRenderPreload
|
||||
)
|
||||
where
|
||||
import Picture.Data
|
||||
import Shader
|
||||
import Shader.Data
|
||||
import Shader.Compile
|
||||
import Shader.AuxAddition
|
||||
import Geometry.Data
|
||||
import Data.Preload.Render
|
||||
|
||||
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
||||
--import Control.Lens
|
||||
import Foreign
|
||||
|
||||
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 cornerList
|
||||
-- note we directly poke the shader vertex data here
|
||||
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList
|
||||
boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const cornerList
|
||||
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO boxBlurShad) $ concat cornerList
|
||||
grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const cornerList
|
||||
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList
|
||||
-- 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
|
||||
}
|
||||
|
||||
cornerList :: [[Float]]
|
||||
cornerList =
|
||||
[[-1, 1,0,1]
|
||||
,[ 1, 1,1,1]
|
||||
,[-1,-1,0,0]
|
||||
,[ 1,-1,1,0]
|
||||
]
|
||||
-- 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) -> concat [flat3 p,flat4 co]) vs
|
||||
pokeTriStrat _ = []
|
||||
|
||||
pokeLightingFloorStrat :: RenderType -> [[Float]]
|
||||
pokeLightingFloorStrat Render1111{_unRender1111=x} = [flat4 x]
|
||||
pokeLightingFloorStrat _ = undefined
|
||||
|
||||
pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> concat [flat3 a, flat4 b, flat3 c]) vs
|
||||
pokeCharStrat _ = []
|
||||
|
||||
pokeArcStrat (RenderArc (a,b,c)) = [concat [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 []
|
||||
@@ -2,10 +2,10 @@ module Preload.Update
|
||||
( resizeSpareFBO
|
||||
)
|
||||
where
|
||||
import Preload.Data
|
||||
import Data.Preload
|
||||
import Data.Preload.Render
|
||||
import Graphics.Rendering.OpenGL
|
||||
import Foreign
|
||||
import Picture.Preload
|
||||
|
||||
resizeSpareFBO
|
||||
:: Int -- ^ Lightmap width
|
||||
|
||||
Reference in New Issue
Block a user