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

Commit before connecting each vao to unique vbos

Browse Source
This commit is contained in:
jgk
2021-03-02 00:54:00 +01:00
parent 1e198b551e
commit 18492f00d2
8 changed files with 34 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files
package.yaml
+1
View File
@@ -28,6 +28,7 @@ dependencies:
- sdl2-mixer
- text
- OpenGL
- OpenGLRaw
- raw-strings-qq
- bytestring
- lens
shader/wallShadow.geom
+1 -1
View File
@@ -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;
shader/wallShadow.vert
+5 -5
View File
@@ -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()
{
src/Dodge/Rendering.hs
+5 -5
View File
@@ -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
src/Picture.hs
-14
View File
@@ -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 #-}
src/Picture/Data.hs
-6
View File
@@ -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
src/Picture/Preload.hs
+4 -4
View File
@@ -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"
src/Picture/Render.hs
+18 -27
View File
@@ -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