Refactor shaders, commit before major deletion of old code
This commit is contained in:
+1
-1
@@ -60,7 +60,7 @@ main = do
|
||||
(lightsForGloom' w)
|
||||
(worldPictures w)
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
renderTree (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)
|
||||
renderTree' (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)
|
||||
(_windowX w,_windowY w)
|
||||
--(picToLTree (Just 1) $ fixedCoordPictures w)
|
||||
(picToLTree Nothing $ fixedCoordPictures w)
|
||||
|
||||
@@ -40,7 +40,11 @@ data FullShader = FullShader
|
||||
, _shaderVAO :: VAO
|
||||
, _shaderPokeStrategy :: RenderType -> [[[Float]]]-- -> F.FoldM IO RenderType Int
|
||||
, _shaderDrawPrimitive :: PrimitiveMode
|
||||
, _shaderTexture :: Maybe ShaderTexture
|
||||
}
|
||||
data ShaderTexture = ShaderTexture
|
||||
{ _textureObject :: TextureObject }
|
||||
|
||||
makeLenses ''VAO
|
||||
makeLenses ''FullShader
|
||||
|
||||
@@ -51,6 +55,10 @@ drawShaders fss is =
|
||||
where f fs i = do
|
||||
currentProgram $= Just (_shaderProgram fs)
|
||||
bindVertexArrayObject $= (Just (_vao $ _shaderVAO fs))
|
||||
case _shaderTexture fs of
|
||||
Just (ShaderTexture {_textureObject = to})
|
||||
-> textureBinding Texture2D $= Just to
|
||||
_ -> return ()
|
||||
drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i)
|
||||
|
||||
|
||||
|
||||
+34
-1
@@ -55,7 +55,38 @@ makeShader s shaderlist alocs pm renStrat = do
|
||||
, _shaderVAO = vao
|
||||
, _shaderPokeStrategy = renStrat
|
||||
, _shaderDrawPrimitive = pm
|
||||
, _shaderTexture = Nothing
|
||||
}
|
||||
makeTextureShader :: String -> [ShaderType] -> [(GLuint,Int)]
|
||||
-> PrimitiveMode -> (RenderType -> [[[Float]]])
|
||||
-> String
|
||||
-> IO FullShader
|
||||
makeTextureShader s shaderlist alocs pm renStrat texturePath = do
|
||||
(prog,unis) <- makeSourcedShader s shaderlist
|
||||
|
||||
Right cmap <- readImage texturePath
|
||||
let tex = convertRGBA8 cmap
|
||||
textureOb <- genObjectName
|
||||
textureBinding Texture2D $= Just textureOb
|
||||
let texData = V.toList $ imageData tex
|
||||
wtex = fromIntegral $ imageWidth tex
|
||||
htex = fromIntegral $ imageHeight tex
|
||||
withArray texData $ \ptr -> do
|
||||
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D wtex htex) 0
|
||||
(PixelData RGBA UnsignedByte ptr)
|
||||
generateMipmap' Texture2D
|
||||
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
|
||||
|
||||
vao <- setupVAO alocs
|
||||
|
||||
return $ FullShader { _shaderProgram = prog
|
||||
, _shaderUniforms = unis
|
||||
, _shaderVAO = vao
|
||||
, _shaderPokeStrategy = renStrat
|
||||
, _shaderDrawPrimitive = pm
|
||||
, _shaderTexture = Just $ ShaderTexture {_textureObject = textureOb}
|
||||
}
|
||||
|
||||
|
||||
mkS :: IO FullShader
|
||||
mkS = do
|
||||
@@ -150,7 +181,9 @@ preloadRender = do
|
||||
|
||||
bslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
|
||||
lslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
|
||||
cslist <- makeShader "character" [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeCharStrat
|
||||
cslist <- makeTextureShader "character" [vert,geom,frag]
|
||||
[(0,3),(1,4),(2,3)] Points pokeCharStrat
|
||||
"data/texture/charMap.png"
|
||||
aslist <- makeShader "arc" [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeArcStrat
|
||||
eslist <- makeShader "ellipseInterpolate" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeEllStrat
|
||||
|
||||
|
||||
+24
-14
@@ -403,6 +403,8 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
wmata <- (newMatrix RowMajor $ concatMap vToL $ vToL wmat) :: IO (GLmatrix GLfloat)
|
||||
|
||||
-- set common uniforms
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy) (_listShaders pdata)
|
||||
|
||||
forM_ [_basicShader pdata
|
||||
,_textShader pdata
|
||||
,_circShader pdata
|
||||
@@ -454,6 +456,21 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
clear [DepthBuffer]
|
||||
-- draw background
|
||||
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
|
||||
depthFunc $= Just Less
|
||||
|
||||
currentProgram $= Just (fst $ _backShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
|
||||
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
|
||||
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
|
||||
pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
|
||||
pokeTwoOff backPtr2 0 (winx,winy)
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 1)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- draw layer 0
|
||||
ticks2 <- renderTree' pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 0) pic
|
||||
--((picToAlt 0 pic) :: [RenderType])
|
||||
@@ -472,6 +489,13 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
,0,0,0,1
|
||||
]
|
||||
) :: IO (GLmatrix GLfloat)
|
||||
forM_ (_listShaders pdata) $ \shad -> do
|
||||
currentProgram $= Just (_shaderProgram shad)
|
||||
uniform (_shaderUniforms shad !! 0) $= Vector2 (2::Float) 2
|
||||
uniform (_shaderUniforms shad !! 1) $= (1::Float)
|
||||
uniform (_shaderUniforms shad !! 2) $= (0::Float)
|
||||
uniform (_shaderUniforms shad !! 3) $= Vector2 (0::Float) 0
|
||||
uniform (_shaderUniforms shad !! 4) $= idmat
|
||||
forM_ [_basicShader pdata
|
||||
,_textShader pdata
|
||||
,_circShader pdata
|
||||
@@ -500,7 +524,6 @@ renderTree' pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
pokeStartTicks <- SDL.ticks
|
||||
|
||||
let slist = _listShaders pdata
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy) slist
|
||||
|
||||
is <- F.foldM (pokeShaders slist) tree
|
||||
|
||||
@@ -534,7 +557,6 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
-- the idea of doing as much of this at once, rather than interweaving with draw
|
||||
-- calls, is to prevent opengl from waiting for a draw call to finish
|
||||
-- before it performs another state change
|
||||
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
|
||||
bindArrayBuffers nCircVs $ _vaoBufferTargets $ _circVAO pdata
|
||||
bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
|
||||
@@ -542,18 +564,6 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
|
||||
bindArrayBuffers nEllVs $ _vaoBufferTargets $ _ellipseVAO pdata
|
||||
|
||||
depthFunc $= Just Less
|
||||
|
||||
currentProgram $= Just (fst $ _backShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
|
||||
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
|
||||
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
|
||||
pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
|
||||
pokeTwoOff backPtr2 0 (winx,winy)
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 1)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- draw triangles
|
||||
currentProgram $= Just (fst $ _basicShader pdata)
|
||||
|
||||
+3
-3
@@ -1,8 +1,8 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Shaders
|
||||
(makeTextureShader
|
||||
,makeBasicShader
|
||||
,makeFadeShader
|
||||
(--makeTextureShader
|
||||
-- ,makeBasicShader
|
||||
makeFadeShader
|
||||
,makeCircleShader
|
||||
,makeArcShader
|
||||
,makeBackgroundShader
|
||||
|
||||
Reference in New Issue
Block a user