Commit before connecting each vao to unique vbos

package.yaml

@@ -28,6 +28,7 @@ dependencies:
 - sdl2-mixer
 - text
 - OpenGL
+- OpenGLRaw
 - raw-strings-qq
 - bytestring
 - lens

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;

shader/wallShadow.vert

@@ -4,11 +4,11 @@ layout (location = 0) in vec4 poss;
 
 //out vec4 vBackPoss;
 
-uniform vec2 winSize;
+//uniform vec2 winSize;
-uniform float zoom;
+//uniform float zoom;
-uniform float rotation;
+//uniform float rotation;
-uniform vec2 translation;
+//uniform vec2 translation;
-uniform mat4 worldMat;
+//uniform mat4 worldMat;
 
 void main()
 {

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
 

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

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

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
+    dummyptr <- mallocArray numDrawableElements
-    poke dummyptr 0
+    pokeArray dummyptr [0..2000]
-    bindBuffer ArrayBuffer$= Just dummyvbo
+    bindBuffer ArrayBuffer $= Just dummyvbo
-    bufferData ArrayBuffer$= (fromIntegral floatSize, dummyptr, StaticDraw)
+    bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw)
 
 -- load charmap as texture
 --    Right cmap <- readImage "data/texture/smudgedDirt.png"

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,11 +221,6 @@ 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)
@@ -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)
+--        drawElements Points (fromIntegral nWalls) UnsignedByte (_dummyPtr pdata)
-        cullFace $= Nothing
+--        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
+    startWallTicks <- SDL.ticks
-    endWallTicks <- 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