diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index e46f04542..ff1d6d0a8 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -16,6 +16,7 @@ import Geometry --import Picture import Picture.Render import Picture.Preload +import Picture.Data import Shader import MatrixHelper @@ -135,7 +136,7 @@ renderBlankWalls -> GLmatrix GLfloat -> IO () renderBlankWalls pdata wps pmat = do - n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps + n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps) bindShaderBuffers [_wallBlankShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat @@ -149,7 +150,7 @@ renderTextureWalls -> GLmatrix GLfloat -> IO () renderTextureWalls pdata wps pmat = do - n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps + n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps) bindShaderBuffers [_wallTextureShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata) uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index cfe73e4c3..d1661c7f2 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -20,6 +20,11 @@ data RenderType | RenderArc (Point3,Point4,Point4) | RenderLine [(Point3,Point4)] | RenderEllipse [(Point3,Point4)] + | RenderConst + | Render1111 {_unRender1111 :: (Float,Float,Float,Float)} + | Render22 {_unRender22 :: (Point2,Point2)} + | Render22x4 {_unRender22x4 :: ((Point2,Point2),Point4)} + | Render3x2 {_unRender3x2 :: (Point3,Point2)} type RGBA = (Float,Float,Float,Float) type Color = (Float,Float,Float,Float) diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 5171a3ed8..32597021a 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -16,17 +16,17 @@ 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) - , _textureShader :: FullShader (Point3,Point2) - , _fullscreenShader :: FullShader () - , _boxBlurShader :: FullShader () - , _grayscaleShader :: FullShader () - , _pictureShaders :: [FullShader RenderType] + { _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 @@ -38,8 +38,8 @@ makeLenses ''RenderData preloadRender :: IO RenderData preloadRender = do -- lighting shaders - lsShad <- makeShader "lighting/floor" [vert,geom,frag] [(0,4)] Points - (return . return . flat4) + lightningFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [(0,4)] Points + (return . return . flat4 . _unRender1111) wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [(0,4)] Points pokeWPStrat >>= addUniforms ["lightPos"] wlLightShad @@ -62,21 +62,21 @@ preloadRender = do ,[[-1,-1],[0,0]] ,[[ 1,-1],[1,0]] ] - _ <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now + _ <- F.foldM (pokeShader fsShad) [RenderConst] -- 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 + _ <- F.foldM (pokeShader boxBlurShad) [RenderConst] -- 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 + _ <- F.foldM (pokeShader grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now -- background shader bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat >>= addTexture "data/texture/marbleSlabs.png" @@ -87,9 +87,9 @@ preloadRender = do wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,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" +---- 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 @@ -99,12 +99,12 @@ preloadRender = do bindFramebuffer Framebuffer $= defaultFramebufferObject return $ RenderData { _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader] - , _lightingFloorShader = lsShad + , _lightingFloorShader = lightningFloorShad , _lightingOccludeShader = wsShad , _lightingWallShader = wlLightShad , _wallBlankShader = wlBlank , _wallTextureShader = wlTexture - , _textureShader = textShad + --, _textureShader = textShad , _backgroundShader = bgShad , _fullscreenShader = fsShad , _boxBlurShader = boxBlurShad @@ -190,13 +190,13 @@ 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 (RenderPoly vs) = fmap (\(p,co) -> [flat3 p,flat4 co]) vs pokeTriStrat _ = [] -pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs +pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> [flat3 a, flat4 b, flat3 c]) vs pokeCharStrat _ = [] -pokeArcStrat (RenderArc (a,b,c)) = [flat3 (flat3 a, flat4 b, flat4 c)] +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 @@ -210,11 +210,11 @@ vert = VertexShader geom = GeometryShader frag = FragmentShader -pokeWPStrat :: (Point2,Point2) -> [[[Float]]] -pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]] +pokeWPStrat :: RenderType -> [[[Float]]] +pokeWPStrat Render22{_unRender22 = ((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]]] +pokeWPColStrat :: RenderType -> [[[Float]]] +pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[[x,y,z,w],[r,g,b,a]]] poke32 :: (Point3,Point2) -> [[[Float]]] poke32 ((x,y,z),(a,b)) = [[[x,y,z],[a,b]]] diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 8e9d73517..989cb097f 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -34,7 +34,7 @@ setWallDepth setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do startTicks <- SDL.ticks colorMask $= Color4 Disabled Disabled Disabled Disabled - nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) wallPoints + nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints) bindShaderBuffers [_lightingOccludeShader pdata] [nWalls] currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) @@ -76,9 +76,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _ bindFramebuffer Framebuffer $= _spareFBO pdata -- store wall and light positions into buffer - nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) wallPoints + nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints) bindShaderBuffers [_lightingWallShader pdata] [nWallLights] - nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) wallPoints + nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints) bindShaderBuffers [_lightingOccludeShader pdata] [nWalls] -- set uniforms for shader that draws lights currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata) @@ -237,14 +237,14 @@ setIsoMatrixUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do setShaderUniforms rot camZoom (tranx,trany) (winx,winy) ( extractProgAndUnis (_lightingFloorShader pdata) : extractProgAndUnis (_backgroundShader pdata) - : extractProgAndUnis (_textureShader pdata) + -- : extractProgAndUnis (_textureShader pdata) : map extractProgAndUnis (_pictureShaders pdata) ) renderShader :: Foldable f - => FullShader a - -> f a + => FullShader + -> f RenderType -> IO Word32 renderShader shad dat = do sticks <- SDL.ticks diff --git a/src/Shader.hs b/src/Shader.hs index 3cecb6b18..6da190d70 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -23,6 +23,7 @@ module Shader import Geometry import Shader.Data import MatrixHelper +import Picture.Data import Foreign import Codec.Picture @@ -36,20 +37,20 @@ import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Linear.Matrix import Linear.V4 -extractProgAndUnis :: FullShader a -> (Program,UniformLocation) +extractProgAndUnis :: FullShader -> (Program,UniformLocation) extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s) -pokeShaders :: [FullShader a] -> F.FoldM IO a [Int] +pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int] pokeShaders = traverse pokeShader -pokeShader :: FullShader a -> F.FoldM IO a Int +pokeShader :: FullShader -> F.FoldM IO RenderType Int pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss)) (return 0) return where (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ _shaderVAO fs fls = _shaderPokeStrategy fs -pokeRender :: (a -> [[[Float]]]) - -> [(Ptr Float,Int)] -> Int -> a -> IO Int +pokeRender :: (RenderType -> [[[Float]]]) + -> [(Ptr Float,Int)] -> Int -> RenderType -> IO Int pokeRender toFs ptrs n rt = pokeList ptrs n (toFs rt) pokeList :: [(Ptr Float,Int)] -> Int -> [[[Float]]] -> IO Int @@ -72,15 +73,15 @@ bindArrayBuffers numVs ps = do bindBuffer ArrayBuffer $= Just bo bufferData ArrayBuffer $= (fromIntegral $ floatSize * numVs * i, ptr, DynamicDraw) -bindShaderBuffers :: [FullShader a] -> [Int] -> IO () +bindShaderBuffers :: [FullShader] -> [Int] -> IO () bindShaderBuffers = zipWithM_ f where f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs -drawShaders :: [FullShader a] -> [Int] -> IO () +drawShaders :: [FullShader] -> [Int] -> IO () drawShaders = zipWithM_ drawShader -drawShader :: FullShader a -> Int -> IO () +drawShader :: FullShader -> Int -> IO () {-# INLINE drawShader #-} drawShader fs i = do currentProgram $= Just (_shaderProgram fs) @@ -93,7 +94,7 @@ drawShader fs i = do -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... -addTexture :: String -> FullShader a -> IO (FullShader a) +addTexture :: String -> FullShader -> IO (FullShader) addTexture texturePath shad = do Right cmap <- readImage texturePath let tex = convertRGBA8 cmap @@ -118,8 +119,8 @@ makeShader -> [ShaderType] -- ^ Filetype extensions -> [(GLuint,Int)] -- ^ The shaders input vertices (location, size) -> PrimitiveMode - -> (a -> [[[Float]]]) -- ^ Poke strategy: method for creating a list of vertex data to be bound - -> IO (FullShader a) + -> (RenderType -> [[[Float]]]) -- ^ Poke strategy: method for creating a list of vertex data to be bound + -> IO (FullShader) makeShader s shaderlist alocs pm renStrat = do (prog,unis) <- makeSourcedShader s shaderlist vaob <- setupVAO alocs @@ -215,7 +216,7 @@ makeSourcedShader s sts = do uniformLocations <- uniformLocation prog "worldMat" return (prog,uniformLocations) -addUniforms :: [String] -> FullShader a -> IO (FullShader a) +addUniforms :: [String] -> FullShader -> IO (FullShader) addUniforms uniStrings shad = do uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings return $ shad & shaderCustomUnis %~ (++ uniLocs) @@ -286,7 +287,7 @@ setPerpMatUniform -> Point2 -- ^ translation -> Point2 -- ^ window size -> Point2 -- ^ viewfrom point - -> FullShader a + -> FullShader -> IO () setPerpMatUniform rot czoom trans wins vFrom shad = do pmat <- (newMatrix RowMajor $ perspectiveMatrix rot czoom trans wins vFrom) :: IO (GLmatrix GLfloat) @@ -294,7 +295,7 @@ setPerpMatUniform rot czoom trans wins vFrom shad = do uniform (_shaderMatrixUniform shad) $= pmat return () -freeShaderPointers :: FullShader a -> IO () +freeShaderPointers :: FullShader -> IO () freeShaderPointers fs = do forM_ (_vaoBufferTargets $ _shaderVAO fs) $ \(_,ptr,_) -> free ptr diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index c6557a155..f24b3d6e3 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -21,6 +21,8 @@ module Shader.Data -- , textureObject ) where +import Picture.Data + import Graphics.Rendering.OpenGL import Foreign import Control.Lens @@ -42,11 +44,11 @@ data VBO = VBO } {- | Datatype containing the necessary information for a single shader. -} -data FullShader a = FullShader +data FullShader = FullShader { _shaderProgram :: Program , _shaderMatrixUniform :: UniformLocation , _shaderVAO :: VAO - , _shaderPokeStrategy :: a -> [[[Float]]]-- -> F.FoldM IO RenderType Int + , _shaderPokeStrategy :: RenderType -> [[[Float]]]-- -> F.FoldM IO RenderType Int , _shaderDrawPrimitive :: PrimitiveMode , _shaderTexture :: Maybe ShaderTexture , _shaderCustomUnis :: [UniformLocation]