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
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