Include tick counting code
This commit is contained in:
@@ -157,7 +157,7 @@ preloadRender = do
|
||||
circvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
|
||||
arcvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
|
||||
backgroundvao <- setupVAO [(posVBO,0,4),(colVBO,1,2)]
|
||||
wallvao <- setupVAO [(posVBO,0,4),(colVBO,1,4)]
|
||||
wallvao <- setupVAO [(posVBO,0,4)]--,(colVBO,1,4)]
|
||||
fadecircvao <- setupVAO [(posVBO,0,4)]
|
||||
|
||||
return $ RenderData
|
||||
|
||||
+20
-35
@@ -34,6 +34,8 @@ import qualified Data.IntMap as IM
|
||||
|
||||
import Control.DeepSeq
|
||||
|
||||
import qualified SDL as SDL
|
||||
|
||||
white = (1,1,1,1)
|
||||
black = (0,0,0,1)
|
||||
|
||||
@@ -130,25 +132,6 @@ picToList j (SetDepth a pic) = fmap (setDepthRen a) $ picToList j pic
|
||||
picToList j (Color c pic) = fmap (colorRen c) $ picToList j pic
|
||||
picToList j (Pictures pics) = concatMap (picToList j) pics
|
||||
|
||||
--picToFTree :: Picture -> IM.IntMap (FTree RenderType)
|
||||
--{-# INLINE picToFTree #-}
|
||||
--picToFTree (Polygon i ps) = IM.singleton i $ FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
--picToFTree (PolygonCol i vs)
|
||||
-- = let (ps,cs) = unzip vs
|
||||
-- in IM.singleton i $ FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
||||
--picToFTree (Circle i r) = IM.singleton i $ FLeaf $ RenderCirc $ ((0,0,0),black,r)
|
||||
--picToFTree (ThickArc i startA endA rad wdth)
|
||||
-- = IM.singleton i $ FLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
|
||||
--picToFTree Blank = IM.singleton 0 $ FLeaf $ RenderBlank
|
||||
--picToFTree (Line i ps) = IM.singleton 0 $ FLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat black
|
||||
--picToFTree (Text i s) = IM.singleton i $ FLeaf $ RenderText $ stringToList s
|
||||
--picToFTree (Scale x y pic) = fmap (FBranch (scaleRen x y)) $ picToFTree pic
|
||||
--picToFTree (Translate x y pic) = fmap (FBranch (translateRen x y)) $ picToFTree pic
|
||||
--picToFTree (Rotate a pic) = fmap (FBranch (rotateRen a)) $ picToFTree pic
|
||||
--picToFTree (SetDepth a pic) = fmap (FBranch (setDepthRen a)) $ picToFTree pic
|
||||
--picToFTree (Color c pic) = fmap (FBranch (colorRen c)) $ picToFTree pic
|
||||
--picToFTree (Pictures pics) = fmap FBranches $ IM.unionsWith (++) $ map (fmap return . picToFTree) pics
|
||||
|
||||
picToFTree :: Int -> Picture -> FTree RenderType
|
||||
--{-# INLINE picToFTree #-}
|
||||
picToFTree x (Polygon i ps)
|
||||
@@ -314,10 +297,11 @@ threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
|
||||
|
||||
|
||||
renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO ()
|
||||
[(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
|
||||
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
aticks <- SDL.ticks
|
||||
-- calculate world transformation matrix
|
||||
let scalMat = Linear.Matrix.transpose $
|
||||
V4 (V4 (2*zoom/winx) 0 0 (0::GLfloat))
|
||||
@@ -348,23 +332,20 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
,_wallShadowShader pdata
|
||||
] $ \shad -> do
|
||||
currentProgram $= Just (fst shad)
|
||||
uniform (snd shad !! 0) $= Vector2 winx winy
|
||||
uniform (snd shad !! 1) $= zoom
|
||||
uniform (snd shad !! 2) $= rot
|
||||
uniform (snd shad !! 3) $= Vector2 tranx trany
|
||||
|
||||
-- matrixMode $= Projection
|
||||
-- loadIdentity
|
||||
uniform (snd shad !! 0) $= Vector2 winx winy
|
||||
uniform (snd shad !! 1) $= zoom
|
||||
uniform (snd shad !! 2) $= rot
|
||||
uniform (snd shad !! 3) $= Vector2 tranx trany
|
||||
uniform (snd shad !! 4) $= wmata
|
||||
|
||||
bticks <- SDL.ticks
|
||||
|
||||
-- draw lightmap
|
||||
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
|
||||
let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
|
||||
wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
|
||||
-- wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
|
||||
foldWalls n ((x,y),(z,w),(a,b),(c,d)) = do
|
||||
pokeFourOff wallPtr n (x,y,z,w)
|
||||
pokeFourOff wallPtr2 n (a,b,c,d)
|
||||
-- pokeFourOff wallPtr2 n (a,b,c,d)
|
||||
return $ n+1
|
||||
nWalls <- foldM foldWalls 0 wallPoints
|
||||
|
||||
@@ -385,18 +366,19 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
bindArrayBuffers (1) $ _vaoBufferTargets $ _fadeCircVAO pdata
|
||||
blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
ticksAfterL <- SDL.ticks
|
||||
-- draw picture
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
clear [DepthBuffer]
|
||||
-- draw layer 0
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) (picToFTree 0 pic)
|
||||
ticks2 <- renderTree pdata rot zoom (tranx,trany) (winx,winy) (picToFTree 0 pic)
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 1 pic
|
||||
ticks3 <- renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 1 pic
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 2 pic
|
||||
ticks4 <- renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 2 pic
|
||||
-- reset uniforms (hacky for now)
|
||||
idmat <- (newMatrix RowMajor [1,0,0,0
|
||||
,0,1,0,0
|
||||
@@ -418,7 +400,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
uniform (snd shad !! 2) $= (0::Float)
|
||||
uniform (snd shad !! 3) $= Vector2 (0::Float) 0
|
||||
uniform (snd shad !! 4) $= idmat
|
||||
|
||||
return (ticksAfterL, ticks2+ticks3+ticks4)
|
||||
|
||||
bufferOffset :: Integral a => a -> Ptr b
|
||||
bufferOffset = plusPtr nullPtr . fromIntegral
|
||||
@@ -428,9 +410,10 @@ bufferOffset = plusPtr nullPtr . fromIntegral
|
||||
-- it does not set nor change the blend function or depth buffer
|
||||
-- nor does it set uniforms
|
||||
renderTree :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
-> f RenderType -> IO ()
|
||||
-> f RenderType -> IO Word32
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
|
||||
pokeStartTicks <- SDL.ticks
|
||||
-- poke necessary data
|
||||
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
|
||||
-- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
|
||||
@@ -440,6 +423,7 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
(twoPtrsVAO $ _lineVAO pdata)
|
||||
(threePtrsVAO $ _arcVAO pdata)
|
||||
) $ tree
|
||||
pokeEndTicks <-SDL.ticks
|
||||
|
||||
depthFunc $= Just Less
|
||||
|
||||
@@ -481,3 +465,4 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 0)
|
||||
drawArrays Points 0 (fromIntegral $ nTextVs)
|
||||
return (pokeEndTicks - pokeStartTicks)
|
||||
|
||||
Reference in New Issue
Block a user