diff --git a/app/Main.hs b/app/Main.hs index e24d34de7..cc459a896 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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) diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 2a5fd023b..507aa588d 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -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) diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 755212802..2ee81f40f 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -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 diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 767c233ac..c35922229 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -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) diff --git a/src/Shaders.hs b/src/Shaders.hs index b8a5a2886..12e2e84f4 100644 --- a/src/Shaders.hs +++ b/src/Shaders.hs @@ -1,8 +1,8 @@ {-# LANGUAGE QuasiQuotes #-} module Shaders - (makeTextureShader - ,makeBasicShader - ,makeFadeShader + (--makeTextureShader +-- ,makeBasicShader + makeFadeShader ,makeCircleShader ,makeArcShader ,makeBackgroundShader