From 18492f00d2b22cb96cceef21927dbf2aa0655b9f Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 2 Mar 2021 00:54:00 +0100 Subject: [PATCH] Commit before connecting each vao to unique vbos --- package.yaml | 1 + shader/wallShadow.geom | 2 +- shader/wallShadow.vert | 10 +++++----- src/Dodge/Rendering.hs | 10 +++++----- src/Picture.hs | 14 ------------- src/Picture/Data.hs | 6 ------ src/Picture/Preload.hs | 8 ++++---- src/Picture/Render.hs | 45 +++++++++++++++++------------------------- 8 files changed, 34 insertions(+), 62 deletions(-) diff --git a/package.yaml b/package.yaml index e92e4577d..7f58e0f11 100644 --- a/package.yaml +++ b/package.yaml @@ -28,6 +28,7 @@ dependencies: - sdl2-mixer - text - OpenGL +- OpenGLRaw - raw-strings-qq - bytestring - lens diff --git a/shader/wallShadow.geom b/shader/wallShadow.geom index 1dfe654a8..12734aa95 100644 --- a/shader/wallShadow.geom +++ b/shader/wallShadow.geom @@ -1,6 +1,6 @@ #version 430 core layout (points) in; -layout (triangle_strip, max_vertices = 10) out; +layout (triangle_strip, max_vertices = 4) out; //in vec4 vBackPoss[]; uniform vec2 lightPos; diff --git a/shader/wallShadow.vert b/shader/wallShadow.vert index dfa9d1717..d80c47672 100644 --- a/shader/wallShadow.vert +++ b/shader/wallShadow.vert @@ -4,11 +4,11 @@ layout (location = 0) in vec4 poss; //out vec4 vBackPoss; -uniform vec2 winSize; -uniform float zoom; -uniform float rotation; -uniform vec2 translation; -uniform mat4 worldMat; +//uniform vec2 winSize; +//uniform float zoom; +//uniform float rotation; +//uniform vec2 translation; +//uniform mat4 worldMat; void main() { diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 29c02281c..72efa7412 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -166,9 +166,9 @@ collectDrawings w = pictures $ (map screenShift $ ppPicts = map ppDraw (IM.elems (_pressPlates w)) crPicts = map crDraw $ IM.elems $ _creatures w clPicts = map clDraw $ IM.elems $ _clouds w - wallShadows = map (drawWallShadow w) $ wallShadowsToDraw w + wallShadows = map (setLayer 0 . drawWallShadow w) $ wallShadowsToDraw w smokeShadows = map (drawSmokeShadow w) $ _smoke w - wlPicts = map drawWall (wallsToDraw w) + wlPicts = map (setLayer 0 . drawWall) (wallsToDraw w) itFloorPicts = map (drawItem) (IM.elems (_floorItems w)) yourPos = _crPos $ you w yourRot = _crDir $ you w @@ -202,7 +202,7 @@ collectDrawings w = pictures $ (map screenShift $ where tst x y sc t = translate x y $ scale sc sc $ color white $ text t hudDrawings :: World -> Picture -hudDrawings w = (onLayer InvLayer) +hudDrawings w = setLayer 1 $ (onLayer InvLayer) $ pictures [ displayInv 0 w , dShadCol white $ displayHP 0 w @@ -225,10 +225,10 @@ clDraw :: Cloud -> Drawing clDraw c = uncurry translate (_clPos c) $ (_clPict c c) drawCursor :: World -> Picture -drawCursor w = translate (105-halfWidth w) +drawCursor w = setLayer 1 + $ translate (105-halfWidth w) (halfHeight w - (25* (fromIntegral iPos)) - 20 ) - $ setLayer 1 $ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)] where iPos = _crInvSel $ _creatures w IM.! _yourID w diff --git a/src/Picture.hs b/src/Picture.hs index 0f6cca80e..427556277 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -105,20 +105,6 @@ setDepth d pic = OverPic (\(x,y,_) -> (x,y,-d)) id id pic setLayer :: Int -> Picture -> Picture {-# INLINE setLayer #-} setLayer i pic = OnLayer i pic ---setLayer _ Blank = Blank ---setLayer i (Polygon _ ps) = Polygon i ps ---setLayer i (PolygonCol _ ps) = PolygonCol i ps ---setLayer i (Circle _ x) = Circle i x ---setLayer i (ThickArc _ a b r w) = ThickArc i a b r w ---setLayer i (Line _ x) = Line i x ---setLayer i (Scale x y p) = Scale x y $ setLayer i p ---setLayer i (Translate x y p) = Translate x y $ setLayer i p ---setLayer i (Rotate x p) = Rotate x $ setLayer i p ---setLayer i (SetDepth x p) = SetDepth x $ setLayer i p ---setLayer i (Color x p) = Color x $ setLayer i p ---setLayer i (Pictures p) = Pictures $ map (setLayer i) p ---setLayer i (OverPic f f' f'' pic) = OverPic f f' f'' (setLayer i pic) - scale3 :: Float -> Float -> Point3 -> Point3 {-# INLINE scale3 #-} diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index e8e9ad98c..e460afe62 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -61,7 +61,6 @@ data RenderType | RenderCirc (Point3,Point4,Float) | RenderArc (Point3,Point4,Point4) | RenderLine [(Point3,Point4)] - | RenderBlank data Picture = Blank @@ -71,11 +70,6 @@ data Picture | Circle Int Float | ThickArc Int Float Float Float Float | Line Int [Point2] - | Scale Float Float Picture - | Translate Float Float Picture - | Rotate Float Picture - | SetDepth Float Picture - | Color RGBA Picture | Pictures [Picture] | OverPic (Point3 -> Point3) (Float -> Float) (Point4 -> Point4) Picture | OnLayer Int Picture diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index d9771c3d2..fc0346b83 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -116,10 +116,10 @@ preloadRender = do --the following vbo is set up to contain one fixed vertex dummyvbo <- genObjectName - dummyptr <- malloc - poke dummyptr 0 - bindBuffer ArrayBuffer$= Just dummyvbo - bufferData ArrayBuffer$= (fromIntegral floatSize, dummyptr, StaticDraw) + dummyptr <- mallocArray numDrawableElements + pokeArray dummyptr [0..2000] + bindBuffer ArrayBuffer $= Just dummyvbo + bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw) -- load charmap as texture -- Right cmap <- readImage "data/texture/smudgedDirt.png" diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 8cc213cbb..6b44f716d 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -26,6 +26,8 @@ import Foreign hiding (rotate) import Codec.Picture +import Graphics.GL.Core43 + import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,imageWidth,Polygon,Color,T) import qualified Graphics.Rendering.OpenGL as GL @@ -66,7 +68,6 @@ overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs overPos f (RenderCirc (a,b,c)) = RenderCirc (f a,b,c) overPos f (RenderArc (a,b,c)) = RenderArc (f a,b,c) -overPos _ RenderBlank = RenderBlank overCol :: (Point4 -> Point4) -> RenderType -> RenderType {-# INLINE overCol #-} @@ -75,7 +76,6 @@ overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs overCol f (RenderCirc (a,b,c)) = RenderCirc (a,f b,c) overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c) -overCol _ RenderBlank = RenderBlank overSca :: (Float -> Float) -> RenderType -> RenderType {-# INLINE overSca #-} @@ -135,11 +135,6 @@ picToAlt x (Text i s) | i == x = Ap.pure $ RenderText $ stringToList s | otherwise = Ap.empty picToAlt j Blank = Ap.empty -picToAlt j (Scale x y pic) = fmap (scaleRen x y) $ picToAlt j pic -picToAlt j (Translate x y pic) = fmap (translateRen x y) $ picToAlt j pic -picToAlt j (Rotate a pic) = fmap (rotateRen a) $ picToAlt j pic -picToAlt j (SetDepth a pic) = fmap (setDepthRen a) $ picToAlt j pic -picToAlt j (Color c pic) = fmap (colorRen c) $ picToAlt j pic picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics picToList :: Int -> Picture -> [RenderType] @@ -165,11 +160,6 @@ picToList x (Text i s) | i == x = [RenderText $ stringToList s] | otherwise = [] picToList j Blank = [] -picToList j (Scale x y pic) = fmap (scaleRen x y) $ picToList j pic -picToList j (Translate x y pic) = fmap (translateRen x y) $ picToList j pic -picToList j (Rotate a pic) = fmap (rotateRen a) $ picToList j pic -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 :: Int -> Picture -> FTree RenderType @@ -231,18 +221,13 @@ picToLTree mx (Text i s) | Just i == mx || Nothing == mx = LLeaf $ RenderText $ stringToList s | otherwise = LBranches [] picToLTree j Blank = LBranches [] -picToLTree j (Scale x y pic) = fmap (scaleRen x y) $ picToLTree j pic -picToLTree j (Translate x y pic) = fmap (translateRen x y) $ picToLTree j pic -picToLTree j (Rotate a pic) = fmap (rotateRen a) $ picToLTree j pic -picToLTree j (SetDepth a pic) = fmap (setDepthRen a) $ picToLTree j pic -picToLTree j (Color c pic) = fmap (colorRen c) $ picToLTree j pic picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics picToLTree j (OverPic f f' f'' (OverPic g g' g'' pic)) = picToLTree j $ OverPic (f . g) (f' . g') (f'' . g'') pic picToLTree j (OverPic f f' f'' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f' f'') ps) picToLTree j (OverPic f f' f'' pic) = fmap (overPos f . overSca f' . overCol f'') $ picToLTree j pic picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic | otherwise = LBranches [] -picToLTree Nothing (OnLayer _ pic) = picToLTree Nothing pic +picToLTree Nothing (OnLayer _ pic) = picToLTree Nothing pic doubleLine :: [Point2] -> [Point2] doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs) @@ -296,6 +281,7 @@ pokeThreeOff ptr n (x,y,z) = do pokeElemOff ptr (3*n+0) x pokeElemOff ptr (3*n+1) y pokeElemOff ptr (3*n+2) z + pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO () {-# INLINE pokeFourOff #-} pokeFourOff ptr n (x,y,z,w) = do @@ -391,7 +377,7 @@ threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32) renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do - startWallTicks <- SDL.ticks + wallPokeStart <- SDL.ticks depthFunc $= Just Lequal -- calculate world transformation matrix @@ -432,26 +418,29 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p -- draw lightmap bindVertexArrayObject $= Just (_vao $ _wallVAO pdata) - wallPokeStart <- SDL.ticks let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata -- wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1 foldWalls n ((x,y),(z,w)) = do pokeFourOff wallPtr n (x,y,z,w) +-- pokeElemOff (_dummyPtr pdata) n (fromIntegral n) -- pokeFourOff wallPtr2 n (a,b,c,d) return $ n+1 nWalls <- foldM foldWalls 0 wallPoints - wallPokeEnd <- SDL.ticks forM_ lightPoints $ \(x,y,r,lum) -> do - cullFace $= Just Front +-- cullFace $= Just Front clear [DepthBuffer] currentProgram $= Just (fst $ _wallShadowShader pdata) bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata bindVertexArrayObject $= Just (_vao $ _wallVAO pdata) uniform (_wssLightPos pdata) $= Vector2 (x) (y) blendFunc $= (Zero,One) - drawArrays Points (fromIntegral 0) (fromIntegral $ length wallPoints) - cullFace $= Nothing +-- drawElements Points (fromIntegral nWalls) UnsignedByte (_dummyPtr pdata) +-- withArray [0..(nWalls-1)::Int] $ \ptr -> +---- --drawElements Points (fromIntegral nWalls) UnsignedByte ptr +-- glDrawElements GL_POINTS (fromIntegral $ length wallPoints) GL_UNSIGNED_BYTE ptr + drawArrays Points (fromIntegral 0) (fromIntegral $ nWalls) +-- cullFace $= Nothing currentProgram $= Just (fst $ _fadeCircleShader pdata) bindVertexArrayObject $= Just (_vao $ _fadeCircVAO pdata) let fadeCircPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _fadeCircVAO pdata @@ -459,8 +448,8 @@ 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 - endWallTicks <- SDL.ticks + startWallTicks <- SDL.ticks + wallPokeEnd <- SDL.ticks ticksS <- SDL.ticks ticksAfterL <- SDL.ticks -- draw picture @@ -499,10 +488,12 @@ 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 + endWallTicks <- SDL.ticks --return (ticksAfterL, ticks2+ticks3+ticks4, endWallTicks - startWallTicks) ticksE <- SDL.ticks --return (ticksAfterL, ticksE - ticksS) - return (ticksAfterL, ticks2 + ticks3 + ticks4) + --return (ticksAfterL, ticks2 + ticks3 + ticks4) + return (ticksAfterL, wallPokeEnd - wallPokeStart) bufferOffset :: Integral a => a -> Ptr b bufferOffset = plusPtr nullPtr . fromIntegral