Commit before connecting each vao to unique vbos
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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 #-}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
+18
-27
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user