diff --git a/app/Main.hs b/app/Main.hs index a946692d9..36cb9a8e5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -54,12 +54,12 @@ doSideEffects preData w = do endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData --- FIXME when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable --- FIXME (_renderData preData) --- FIXME (map snd $ setDepth (-1) --- FIXME . translate (-0.5) (-0.8) . scale 0.0005 0.0005 --- FIXME . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) --- FIXME ) + when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable + (_renderData preData) + (setDepth (-1) + . translate (-0.5) (-0.8) . scale 0.0005 0.0005 + . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) + ) foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds & frameTimer .~ endTicks)) (_doneSideEffects w) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 1d2595dfd..2885ccb1f 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -79,7 +79,7 @@ doDrawing pdata w = do else renderBlankWalls pdata nWalls --_ <- renderFoldable pdata $ (picToAlt (Just 0) (polysToPic $ foregroundPics w) :: [RenderType]) --_ <- renderFoldable pdata $ (picToAlt (Just 0) pic :: [RenderType]) --- FIXME _ <- renderFoldable pdata $ map snd (polysToPic $ foregroundPics w) + _ <- renderFoldable pdata $ polysToPic $ foregroundPics w --_ <- renderFoldable pdata $ map snd $ filter ((==0).fst) pic vnums <- pokeBindFoldableLayer pdata $ pic @@ -175,7 +175,7 @@ doDrawing pdata w = do depthMask $= Disabled blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) --- FIXME _ <- renderFoldable pdata $ map snd (fixedCoordPictures w) + _ <- renderFoldable pdata $ fixedCoordPictures w depthMask $= Enabled eTicks <- SDL.ticks diff --git a/src/Render.hs b/src/Render.hs index b00e6d632..9d596bc71 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} module Render where import Shader @@ -159,33 +160,37 @@ pokeBindFoldableLayer -> IO (IM.IntMap [(VShader,Int)]) pokeBindFoldableLayer pdata m = do let slist = (,) <$> [0..6] <*> _pictureShaders pdata + slist' = IM.fromListWith (++) ((,) <$> [0..6] <*> map ((:[]) . (, 0)) (_pictureShaders pdata)) - is <- F.foldM (traverse pokeShaderLayer slist) m +-- is <- F.foldM (traverse pokeShaderLayer slist) m +-- bindShaderLayer slist is + slist'' <- foldM pokeVX slist' m + bindShaderLay slist'' + --return $ IM.fromListWith (++) $ zipWith (\(i,fs) n -> (i,[(fs,n)])) slist is + return slist'' + +renderFoldable + :: Foldable f + => RenderData + -> f Verx + -> IO Word32 +renderFoldable pdata struct = do + pokeStartTicks <- SDL.ticks + + let slist = (,) <$> [0..6] <*> _pictureShaders pdata + +-- poke data, returns list buffer sizes for each shader + is <- F.foldM (traverse pokeShaderLayer slist) struct + +-- the idea of binding many buffers 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 bindShaderLayer slist is - return $ IM.fromListWith (++) $ zipWith (\(i,fs) n -> (i,[(fs,n)])) slist is ---renderFoldable --- :: Foldable f --- => RenderData --- -> f RenderType --- -> IO Word32 ---renderFoldable pdata struct = do --- pokeStartTicks <- SDL.ticks --- --- let slist = _pictureShaders pdata --- ----- poke data, returns list buffer sizes for each shader --- is <- F.foldM (traverse pokeShader slist) struct --- ----- the idea of binding many buffers 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 --- bindShaderBuffers slist is --- --- zipWithM_ drawShader slist is --- --- pokeEndTicks <- SDL.ticks --- return $ pokeEndTicks - pokeStartTicks + zipWithM_ (uncurry drawShaderLay) slist is + + pokeEndTicks <- SDL.ticks + return $ pokeEndTicks - pokeStartTicks ------------------------------end renderFoldable pokeTwoOff diff --git a/src/Shader.hs b/src/Shader.hs index 608c7b6a6..e540bcffb 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -1,5 +1,6 @@ module Shader ( bindShaderLayer + , bindShaderLay , bindShaderBuffers , bindArrayBuffers , drawShader @@ -16,6 +17,7 @@ import Foreign import Control.Monad import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Graphics.GL.Core43 +import qualified Data.IntMap.Strict as IM --import Text.RawString.QQ --import Linear.Matrix --import Linear.V4 @@ -42,6 +44,12 @@ bindArrayBuffersLayer numVs lay theVBO = do where stride = sum $ _vboAttribSizes theVBO +bindShaderLay :: IM.IntMap [(VShader,Int)] -> IO () +bindShaderLay = mapM_ f . IM.toList + where + f (lay,ps) = mapM_ (g lay) ps + g l (fs,i) = bindArrayBuffersLayer i l $ _vaoVBO $ _vshaderVAO fs + bindShaderLayer :: [(Int,VShader)] -> [Int] -> IO () bindShaderLayer = zipWithM_ f where @@ -52,6 +60,13 @@ bindShaderBuffers = zipWithM_ f where f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs +drawShaderLays :: IM.IntMap [(VShader,Int)] -> IO () +{-# INLINE drawShaderLays #-} +drawShaderLays = mapM_ f . IM.toList + where + f (lay,ps) = mapM_ (g lay) ps + g lay (shad,i) = drawShaderLay lay shad i + drawShaderLay :: Int -> VShader -> Int -> IO () {-# INLINE drawShaderLay #-} drawShaderLay l fs i = do diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index d96daf7db..d6451a5f0 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,15 +1,21 @@ +{-# LANGUAGE TupleSections #-} module Shader.Poke ( pokeArrayOff , pokeShader , pokeShaderLayer + , pokeVX ) where import Shader.Data import Shader.Parameters import Picture.Data +import Data.Maybe +import Data.List import Foreign import Control.Monad import qualified Control.Foldl as F +import qualified Data.IntMap.Strict as IM +import Control.Lens pokeShader :: FullShader -> F.FoldM IO RenderType Int pokeShader fs = F.FoldM (pokeVertices fls ptr stride) (return 0) return @@ -30,6 +36,25 @@ pokeVertices -> IO Int pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt) +pokeSL :: [(Int,[VShader])] -> [Verx] -> IO (IM.IntMap [(VShader,Int)]) +pokeSL vslist vxs = do + foldM pokeVX (f vslist) vxs + where + f = IM.map (map (, 0)) . IM.fromList + +pokeVX :: IM.IntMap [(VShader,Int)] -> Verx -> IO (IM.IntMap [(VShader,Int)]) +pokeVX count vx = do + let offset = _vxLayer vx + lshads = count IM.! offset + (vshad,n) = fromJust $ find (\(s,_) -> _vshaderPokeTest s $ _vxType vx) lshads + i = fromJust $ findIndex (\(s,_) -> _vshaderPokeTest s $ _vxType vx) lshads + theVBO = _vaoVBO $ _vshaderVAO vshad + ptr = _vboPointer theVBO + stride = sum $ _vboAttribSizes theVBO + pokeArrayOff ptr (stride * (n+offset * numSubElements)) (toFls' vx) + return $ count & ix offset . ix i . _2 +~ 1 + + pokeShaderLayer :: (Int,VShader) -> F.FoldM IO Verx Int pokeShaderLayer (l,fs) = F.FoldM (pokeVerticesOff ptr (_vshaderPokeTest fs) stride l) (return 0) return where @@ -53,6 +78,15 @@ pokeVerticesOff ptr vtest stride offset n vx i = _vxLayer vx typetest = vtest (_vxType vx) +toFls' :: Verx -> [Float] +toFls' vx = flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx) + where + f (PolyzV x) = [x] + f (BezV x) = flat4 x + f (TextV x) = flat2 x + f (ArcV x) = flat3 x + f _ = [] + toFls :: Verx -> [[Float]] toFls vx = [flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx)] where