justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Include tick counting code

Browse Source
This commit is contained in:
jgk
2021-02-27 02:09:04 +01:00
parent 4fc6917741
commit 3b4b387943
9 changed files with 64 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+10 -2
View File
@@ -54,7 +54,8 @@ main = do
(-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade
\preData w -> --do render setparams w egFade
do
renderPicture' (_renderData preData)
startTicks <- SDL.ticks
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w)
(_cameraPos w)
(_windowX w,_windowY w)
@@ -65,9 +66,16 @@ main = do
renderTree (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)
(_windowX w,_windowY w)
(picToList 1 $ fixedCoordPictures w)
endRenderTicks <- SDL.ticks
playSoundQueue (_soundData preData) (_soundQueue w)
newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
return $ preData {_soundData = newSoundData}
endMixerTicks <- SDL.ticks
return $ (preData {_soundData = newSoundData})
& renderTime +~ (endRenderTicks - startTicks)
& mixerTime +~ (endMixerTicks - endRenderTicks)
& renderLighting +~ (lightTicks - startTicks)
& renderPicture +~ (endRenderTicks - lightTicks)
& pokeTime +~ timeSpentPoking
)
(flip $ menuEvents $ flip handleEvent)
(\w -> Just $ update w)
shader/basic.vert
-18
View File
@@ -9,24 +9,6 @@ uniform float rotation;
uniform vec2 translation;
uniform mat4 worldMat;
mat4 tranMat = mat4
( 1.0, 0.0, 0.0, 0.0
, 0.0, 1.0, 0.0, 0.0
, 0.0, 0.0, 1.0, 0.0
, -translation.x, -translation.y, 0.0, 1.0
) ;
mat4 rotMat = mat4
( cos(rotation), sin(-rotation), 0.0, 0.0
, sin(rotation), cos(rotation), 0.0, 0.0
, 0.0, 0.0, 1.0, 0.0
, 0.0, 0.0, 0.0, 1.0
) ;
mat4 scalMat = mat4
( 2*zoom/winSize.x, 0.0, 0.0, 0.0
, 0.0, 2*zoom/winSize.y, 0.0, 0.0
, 0.0, 0.0, 1.0, 0.0
, 0.0, 0.0, 0.0, 1.0
) ;
void main()
{
gl_Position = worldMat * vec4(position.xyz,1);
shader/fadeCircle.frag
+1
View File
@@ -9,6 +9,7 @@ void main()
float dist = min(1 , 2*distance(pos,cenPosT) / (gParams.x));
//float c = pow(gParams.y*dist,2);
float c = gParams.y * pow(1-dist,2);
//float c = gParams.y;
fColor = vec4( c,c,c ,c );
// fColor = vec4( 1,0,0 , 1);
// fColor = vec4( 1,0,0 , pow(dist,2) );
shader/wallShadow.geom
+7 -19
View File
@@ -2,35 +2,23 @@
layout (points) in;
layout (triangle_strip, max_vertices = 10) out;
in vec4 vBackPoss[];
//in vec4 vBackPoss[];
uniform vec2 lightPos;
void main()
{
vec2 posa = gl_in[0].gl_Position.xy;
vec2 posb = gl_in[0].gl_Position.zw;
vec2 posc = vBackPoss[0].xy;
vec2 posd = vBackPoss[0].zw;
// vec2 posc = vBackPoss[0].xy;
// vec2 posd = vBackPoss[0].zw;
// gl_Position = vec4 (posa, 0 , 1);
// EmitVertex();
// gl_Position = vec4 (posa + (200 * (posa - lightPos)), 0 , 1);
// EmitVertex();
// gl_Position = vec4 (posb, 0 , 1);
// EmitVertex();
// gl_Position = vec4 (posb + (200 * (posb - lightPos)), 0 , 1);
// EmitVertex();
// gl_Position = vec4 (posb + (200 * (posb - lightPos)), 0 , 1);
// EmitVertex();
// gl_Position = vec4 (posd, 0 , 1);
// EmitVertex();
gl_Position = vec4 (posd, 0 , 1);
gl_Position = vec4 (posa, 0 , 1);
EmitVertex();
gl_Position = vec4 (posd + (200 * (posd - lightPos)), 0 , 1);
gl_Position = vec4 (posa + (200 * (posa - lightPos)), 0 , 1);
EmitVertex();
gl_Position = vec4 (posc, 0 , 1);
gl_Position = vec4 (posb, 0 , 1);
EmitVertex();
gl_Position = vec4 (posc + (200 * (posc - lightPos)), 0 , 1);
gl_Position = vec4 (posb + (200 * (posb - lightPos)), 0 , 1);
EmitVertex();
EndPrimitive();
shader/wallShadow.vert
+3 -3
View File
@@ -1,8 +1,8 @@
#version 430 core
layout (location = 0) in vec4 poss;
layout (location = 1) in vec4 backPoss;
//layout (location = 1) in vec4 backPoss;
out vec4 vBackPoss;
//out vec4 vBackPoss;
uniform vec2 winSize;
uniform float zoom;
@@ -13,5 +13,5 @@ uniform mat4 worldMat;
void main()
{
gl_Position = poss;
vBackPoss = backPoss;
// vBackPoss = backPoss;
}
src/Dodge/Rendering.hs
+13 -26
View File
@@ -57,26 +57,20 @@ fixedCoordPictures w = pictures
worldPictures :: World -> Picture
worldPictures w
= pictures $ map screenShift $ concat
[ decPicts
, ppPicts
, itFloorPicts
, crPicts
, clPicts
, buttonPicts
, ptPicts
, ptPicts'
, afterPtPicts'
, wlPicts
, wallShadows
, smokeShadows
]
= pictures $ concat [ decPicts
, ppPicts
, itFloorPicts
, crPicts
, clPicts
, buttonPicts
, ptPicts
, ptPicts'
, afterPtPicts'
, wlPicts
, wallShadows
, smokeShadows
]
where
screenShift = id--scale zoomx zoomy . rotate (0 - (_cameraRot w) )
-- . uncurry translate ((0,0) -.- _cameraPos w)
zoomx = 2 * _cameraZoom w / _windowX w
zoomy = 2 * _cameraZoom w / _windowY w
scaler = scale (2 / _windowX w) (2 / _windowY w)
decPicts = IM.elems $ _decorations w
ptPicts = map _ptPict (IM.elems (_particles w))
ptPicts' = map _ptPict' $ _particles' w
@@ -565,13 +559,6 @@ displayHP n w = translate (halfWidth w-70) (halfHeight w-40) $
testPic w = blank
wallsForGloom :: World -> [(Point2,Point2)]
wallsForGloom w = map (\(x:y:_) -> (screenShift x,screenShift y)) $
map _wlLine $ filter (not . _wlIsSeeThrough)
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
zoom = _cameraZoom w
wallsForGloom' :: World -> [(Point2,Point2,Point2,Point2)]
wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThrough)
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
src/Loop.hs
+9 -12
View File
@@ -14,7 +14,7 @@ import Geometry
import Preload
import Control.Lens ((.~),(&))
import Control.Lens ((.~),(&),(+~))
winConfig x y = defaultWindow
{ windowGraphicsContext
@@ -80,6 +80,7 @@ doLoop setup window startWorld
GL.clear [GL.ColorBuffer,GL.DepthBuffer]
newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
glSwapWindow window
endSideTicks <- ticks
--worldSideEffects setup updatedWorld
events <- pollEvents
--let-- maybeUpdatedWorld :: Maybe (WorldView world0)
@@ -91,12 +92,17 @@ doLoop setup window startWorld
--worldSideEffects setup updatedWorld
--glSwapWindow window
--GL.flush
endSimTicks <- ticks
performGC
endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)
let delay = max 0 (10 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
threadDelay (delay * 1000)
doLoop newParams window updatedWorld worldSideEffects eventFn worldUpdate
Nothing -> return ()
endTime <- ticks
let newNewParams = newParams & idleTime +~ (endTime - endLoopTicks)
& gcTime +~ (endLoopTicks - endSimTicks)
& simTime +~ (endSimTicks - endSideTicks)
doLoop newNewParams window updatedWorld worldSideEffects eventFn worldUpdate
Nothing -> showTiming setup
applyEvents :: (world0 -> Event -> Maybe world0)
-> world0
@@ -115,15 +121,6 @@ applyEvents eventFn startWorld events worldUpdate =
WindowClosedEvent _ -> Nothing
_ -> f w e
-- applyResizeExits :: (world -> Event -> Maybe world) -> (world -> Event -> Maybe world)
-- applyResizeExits f w e
-- = case eventPayload e of
-- QuitEvent -> Nothing
-- WindowClosedEvent _ -> Nothing
-- WindowSizeChangedEvent
-- (WindowSizeChangedEventData {windowSizeChangedEventWindow = V2 x y})
-- -> GL.viewport
-- _ -> f w e
applyEventIO :: (world -> Event -> Maybe world) -> Maybe world -> Event -> IO (Maybe world)
applyEventIO fn mw e = case eventPayload e of
QuitEvent -> return Nothing
src/Picture/Preload.hs
+1 -1
View File
@@ -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
src/Picture/Render.hs
+20 -35
View File
@@ -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)