From 1e9a07d1c806e4daf0d99bb6e87a264ede54b3d1 Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 1 Apr 2021 11:28:53 +0200 Subject: [PATCH] Reorganise rendering in Dodge --- app/Main.hs | 64 +-------- package.yaml | 20 +++ src/Dodge/Base.hs | 11 +- src/Dodge/Render.hs | 122 ++++++++++++++++++ src/Dodge/{Rendering => Render}/HUD.hs | 2 +- src/Dodge/{Rendering => Render}/MenuScreen.hs | 2 +- src/Dodge/Render/PerspectiveMatrix.hs | 50 +++++++ src/Dodge/{Rendering.hs => Render/Picture.hs} | 20 +-- src/Dodge/Update.hs | 7 +- src/Dodge/WorldEvent/SpawnParticle.hs | 1 + src/Dodge/WorldEvent/ThingsHit.hs | 2 +- src/MatrixHelper.hs | 2 +- src/Picture/Render.hs | 27 +--- 13 files changed, 217 insertions(+), 113 deletions(-) create mode 100644 src/Dodge/Render.hs rename src/Dodge/{Rendering => Render}/HUD.hs (99%) rename src/Dodge/{Rendering => Render}/MenuScreen.hs (98%) create mode 100644 src/Dodge/Render/PerspectiveMatrix.hs rename src/Dodge/{Rendering.hs => Render/Picture.hs} (95%) diff --git a/app/Main.hs b/app/Main.hs index d3c3a114d..ddcf6053c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,7 +10,7 @@ import Dodge.Layout import Dodge.LoadSound import Dodge.Update import Dodge.Event -import Dodge.Rendering +import Dodge.Render import Dodge.Menu import Dodge.Floor import Dodge.LoadConfig @@ -53,7 +53,7 @@ main = do (fmap (setWindowSize sizex sizey keyConfig) firstWorld) ( \preData w -> do startTicks <- SDL.ticks - doTheRender preData w + doDrawing (_renderData preData) w playSoundQueue (_soundData preData) (_soundQueue w) newSoundData <- playAndUpdate (_sounds w) (_soundData preData) @@ -81,63 +81,3 @@ setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World setWindowSize x y z w = w & windowX .~ fromIntegral x & windowY .~ fromIntegral y & keyConfig .~ z -doTheRender :: PreloadData a -> World -> IO (Word32) -doTheRender preData w = do - sTicks <- SDL.ticks - clear [ColorBuffer,DepthBuffer] - let pdata = _renderData preData - rot = _cameraRot w - zoom = _cameraZoom w - trans@(tranx,trany) = _cameraCenter w - wins@(winx,winy) = (_windowX w,_windowY w) - wallPointsCol = wallsPointsAndCols w - windowPoints = wallsWindows w - lightPoints = lightsForGloom' w - viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w - pic = worldPictures w - let wallPoints = map fst wallPointsCol - - setCommonUniforms pdata rot zoom trans wins - - depthFunc $= Just Less - - pmat <- (newMatrix RowMajor - $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) - ) :: IO (GLmatrix GLfloat) - - createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat - - blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) - clear [DepthBuffer] - - renderBackground pdata rot zoom trans wins - - renderWalls pdata wallPointsCol pmat - - setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat - - depthFunc $= Just Lequal - - renderFoldable pdata $ picToLTree (Just 0) pic - --- reset blend so that light map doesn't apply --- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One)) --- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - renderFoldable pdata $ picToLTree (Just 1) pic - --- set drawing for on top - blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) - - renderFoldable pdata $ picToLTree (Just 2) pic - - depthMask $= Disabled - renderWalls pdata windowPoints pmat - depthMask $= Enabled - - resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata) ----------------------- - blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w) - eTicks <- SDL.ticks - return (eTicks - sTicks) diff --git a/package.yaml b/package.yaml index 4e1a8d080..d93b19c2b 100644 --- a/package.yaml +++ b/package.yaml @@ -79,3 +79,23 @@ tests: - -with-rtsopts=-N dependencies: - loop + +benchmarks: + loop-benchmarks: + dependencies: + - criterion + ghc-options: + - -threaded + - -O2 + - -rtsopts + - -with-rtsopts=-N + - -flate-dmd-anal + - -fno-liberate-case + - -fno-state-hack + - -funfolding-use-threshold1000 + - -funfolding-keeness-factor1000 + - -fllvm + - -optlo-O3 + main: Bench.hs + source-dirs: bench + diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index c37542b2a..2b9144773 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -280,6 +280,12 @@ zoneOfLine :: Point2 -> Point2 -> [(Int,Int)] zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f $ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb)) where f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]] + +zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet +{-# INLINE zoneOfLine' #-} +zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1) + where (x,y) = zoneOfPoint a + (x',y') = zoneOfPoint b --zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f -- $ digitalLine (zoneOfPoint (aa-n,ab-n)) (zoneOfPoint (ba-n,bb-n)) -- where f (x,y) = [(p,r) | p <-[x,x+1] , r<-[y,y+1]] @@ -294,11 +300,6 @@ expandLine xs = IM.map expandSet --expandSet s = s where mk = IS.findMax s -zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet -{-# INLINE zoneOfLine' #-} -zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1) - where (x,y) = zoneOfPoint a - (x',y') = zoneOfPoint b --zoneOfLine a b = concatMap zoneNearPoint $ divideLine (2 * zoneSize) a b --zoneOfLine a b = concatMap zoneNearPoint $ divideLine zoneSize a b diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs new file mode 100644 index 000000000..7fc6b254f --- /dev/null +++ b/src/Dodge/Render.hs @@ -0,0 +1,122 @@ +module Dodge.Render + ( module Dodge.Render.Picture + , doDrawing + , doDrawing' + ) + where +import Dodge.Data +import Dodge.Base + +import Dodge.Render.HUD +import Dodge.Render.MenuScreen +import Dodge.Render.Picture +import Dodge.Render.PerspectiveMatrix + +import Geometry +import Picture +import Shader + +import Picture.Render +import Picture.Preload + +import Data.Graph.Inductive.Query.DFS +import Data.Graph.Inductive.Graph + +import Control.Monad.State +import Data.List +import Data.Bifunctor + +import Foreign (Word32) +import Data.Function +import Control.Applicative +import Control.Lens +import Data.Maybe +import qualified Data.IntMap.Strict as IM +import qualified Data.Map as M +import qualified Data.Set as S +import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) + +import qualified SDL + +doDrawing :: RenderData -> World -> IO (Word32) +doDrawing pdata w = do + sTicks <- SDL.ticks + clear [ColorBuffer,DepthBuffer] + let rot = _cameraRot w + zoom = _cameraZoom w + trans@(tranx,trany) = _cameraCenter w + wins@(winx,winy) = (_windowX w,_windowY w) + wallPointsCol = wallsPointsAndCols w + windowPoints = wallsWindows w + lightPoints = lightsForGloom' w + viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w + pic = worldPictures w + wallPoints = map fst wallPointsCol + setCommonUniforms pdata rot zoom trans wins + depthFunc $= Just Less + pmat <- (newMatrix RowMajor $ perspectiveMatrix w) :: IO (GLmatrix GLfloat) + createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat + blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) +-- clear [DepthBuffer] + depthFunc $= Just Always + renderBackground pdata rot zoom trans wins + depthFunc $= Just Lequal + renderWalls pdata wallPointsCol pmat + setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat +-- depthFunc $= Just Lequal + renderFoldable pdata $ picToLTree (Just 0) pic +-- reset blend so that light map doesn't apply +-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One)) +-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + renderFoldable pdata $ picToLTree (Just 1) pic + +-- set drawing for on top + blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) + + renderFoldable pdata $ picToLTree (Just 2) pic + + depthMask $= Disabled + renderWalls pdata windowPoints pmat + depthMask $= Enabled + + resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata) +---------------------- + blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w) + eTicks <- SDL.ticks + return (eTicks - sTicks) +doDrawing' :: RenderData -> World -> IO (Word32) +doDrawing' pdata w = do + bindFramebuffer Framebuffer $= defaultFramebufferObject + sTicks <- SDL.ticks + clear [ColorBuffer,DepthBuffer] + let rot = _cameraRot w + zoom = _cameraZoom w + trans@(tranx,trany) = _cameraCenter w + wins@(winx,winy) = (_windowX w,_windowY w) + wallPointsCol = wallsPointsAndCols w + windowPoints = wallsWindows w + lightPoints = lightsForGloom' w + viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w + pic = worldPictures w + wallPoints = map fst wallPointsCol + pmat <- (newMatrix RowMajor + $ perspectiveMatrix w) :: IO (GLmatrix GLfloat) + setCommonUniforms pdata rot zoom trans wins + + depthMask $= Disabled + renderBackground pdata rot zoom trans wins + depthMask $= Enabled + blend $= Enabled + blendFunc $= (SrcAlpha, OneMinusSrcAlpha) + -- not sure why renderWalls and setWallDepth aren't combined + renderWalls pdata wallPointsCol pmat + setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat + depthFunc $= Just Lequal + renderFoldable pdata $ picToLTree (Just 0) pic + renderFoldable pdata $ picToLTree (Just 1) pic + renderFoldable pdata $ picToLTree (Just 2) pic + eTicks <- SDL.ticks + return (eTicks - sTicks) + diff --git a/src/Dodge/Rendering/HUD.hs b/src/Dodge/Render/HUD.hs similarity index 99% rename from src/Dodge/Rendering/HUD.hs rename to src/Dodge/Render/HUD.hs index 3ec96ef85..e2dc56816 100644 --- a/src/Dodge/Rendering/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -1,4 +1,4 @@ -module Dodge.Rendering.HUD +module Dodge.Render.HUD where import Dodge.Data diff --git a/src/Dodge/Rendering/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs similarity index 98% rename from src/Dodge/Rendering/MenuScreen.hs rename to src/Dodge/Render/MenuScreen.hs index 3661baead..b27ea3a43 100644 --- a/src/Dodge/Rendering/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -1,4 +1,4 @@ -module Dodge.Rendering.MenuScreen +module Dodge.Render.MenuScreen ( menuScreen ) where diff --git a/src/Dodge/Render/PerspectiveMatrix.hs b/src/Dodge/Render/PerspectiveMatrix.hs new file mode 100644 index 000000000..4ea325552 --- /dev/null +++ b/src/Dodge/Render/PerspectiveMatrix.hs @@ -0,0 +1,50 @@ +module Dodge.Render.PerspectiveMatrix + where +import Dodge.Data + +import Geometry + +import Linear.Matrix +import Linear.V4 +import Graphics.Rendering.OpenGL (GLfloat) + +perspectiveMatrix :: World -> [GLfloat] +perspectiveMatrix w = + let rot = _cameraRot w + zoom = _cameraZoom w + (tranx,trany) = _cameraCenter w + (winx,winy) = (_windowX w,_windowY w) + (viewFromx,viewFromy) = _cameraViewFrom w + scalMat = Linear.Matrix.transpose $ V4 + (V4 (2*zoom/winx) 0 0 (0::GLfloat)) + (V4 0 (2*zoom/winy) 0 0) + (V4 0 0 0.5 0) --scaled to make walls shorter + (V4 0 0 0 1) + rotMat = Linear.Matrix.transpose $ + V4 (V4 (cos rot) (sin (-rot)) 0 0) + (V4 (sin rot) (cos rot) 0 0) + (V4 0 0 1 0) + (V4 0 0 0 1) + tranMat3 = Linear.Matrix.transpose $ + V4 (V4 1 0 0 0) + (V4 0 1 0 0) + (V4 0 0 1 0) + (V4 (-tranx) (-trany) 0 1) + tranMat2 = Linear.Matrix.transpose $ + V4 (V4 1 0 0 0) + (V4 0 1 0 0) + (V4 0 0 1 0) + (V4 (viewFromx-tranx) (viewFromy-trany) 0 1) + perMat = Linear.Matrix.transpose $ + V4 (V4 1 0 0 0) + (V4 0 1 0 0) + (V4 0 0 1 1) + (V4 0 0 0 1) + tranMat1 = Linear.Matrix.transpose $ + V4 (V4 1 0 0 0) + (V4 0 1 0 0) + (V4 0 0 1 0) + (V4 (-viewFromx) (-viewFromy) 0 1) + wmat = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1 + vToL (V4 a b c d) = [a,b,c,d] + in concatMap vToL $ vToL wmat diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Render/Picture.hs similarity index 95% rename from src/Dodge/Rendering.hs rename to src/Dodge/Render/Picture.hs index ddbe643cc..e6c2ad832 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Render/Picture.hs @@ -1,29 +1,17 @@ -module Dodge.Rendering where --- imports {{{ +module Dodge.Render.Picture + where import Dodge.Data import Dodge.Base ---import Dodge.Inventory -import Dodge.Rendering.HUD -import Dodge.Rendering.MenuScreen +import Dodge.Render.HUD +import Dodge.Render.MenuScreen import Geometry import Picture -import Data.Graph.Inductive.Query.DFS -import Data.Graph.Inductive.Graph - -import Control.Monad.State -import Data.List -import Data.Bifunctor - -import Data.Function -import Control.Applicative import Control.Lens import Data.Maybe import qualified Data.IntMap.Strict as IM -import qualified Data.Map as M -import qualified Data.Set as S worldPictures :: World -> Picture worldPictures w = pictures $ concat diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 6edfb7168..4faa832be 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -71,8 +71,11 @@ updateLightSources w = set tempLightSources (catMaybes tlss) w' updateProjectiles w = IM.foldr' _pjUpdate w $ _projectiles w updateParticles' :: World -> World -updateParticles' w = set particles' (catMaybes ps) w' - where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w +updateParticles' w = + --set particles' [] w + set particles' (catMaybes ps) w' + where + (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w updateCreatures :: World -> World updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 487ee9248..8c25c3d50 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -167,6 +167,7 @@ moveFlamelet w pt & btPassThrough' .~ Nothing & btVel' .~ 0.8 *.* vel damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w +-- damcrs = w closeCrs cr = dist ep (_crPos cr) < _crRad cr + size dodam cr = over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Flaming 3 sp ep ep) diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 73c0b7b80..3360f0b25 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -17,7 +17,7 @@ thingsHit sp ep w where hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr)) $ _creatures w - -- $ creaturesAlongLine sp ep w +-- $ creaturesAlongLine sp ep w crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs crs = zip crPs (map E3x1 hitCrs) diff --git a/src/MatrixHelper.hs b/src/MatrixHelper.hs index 1e9b52aa8..ae8ba552f 100644 --- a/src/MatrixHelper.hs +++ b/src/MatrixHelper.hs @@ -11,7 +11,7 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) = let scalMat = Linear.Matrix.transpose $ V4 (V4 (2*zoom/winx) 0 0 (0::GLfloat)) (V4 0 (2*zoom/winy) 0 0) - (V4 0 0 0.5 0) --scale to make walls shorter + (V4 0 0 0.5 0) --scaled to make walls shorter (V4 0 0 0 1) rotMat = Linear.Matrix.transpose $ V4 (V4 (cos rot) (sin (-rot)) 0 0) diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index c1fbccce6..a04c83bb0 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -3,7 +3,7 @@ module Picture.Render ( module Picture.Render , picToLTree - , perspectiveMatrix +-- , perspectiveMatrix ) where @@ -114,30 +114,23 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints (viewFromx,viewFromy) pmat = do bindFramebuffer Framebuffer $= (_spareFBO pdata) - -- clear buffer to full alpha and furthest depth clearColor $= Color4 0 0 0 1 clearDepth $= 1 clear [ColorBuffer,DepthBuffer] - depthFunc $= Just Less - -- store wall and light positions into buffer nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints bindShaderBuffers [_wallLightShader pdata] [nWallLights] nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints bindShaderBuffers [_wallShadowShader pdata] [nWalls] - -- set uniforms for shader that draws lights currentProgram $= Just (_shaderProgram $ _wallLightShader pdata) uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 1) $= pmat - -- draw walls from your point of view in order to set z buffer colorMask $= (Color4 Disabled Disabled Disabled Disabled) - let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy) - currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata) uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) $= Vector2 viewFromx viewFromy @@ -147,23 +140,20 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints $= (0 :: Float) cullFace $= Just Back drawShader (_wallShadowShader pdata) nWalls - -- for each of the lights: --- stencil out the walls from this lights point of view +-- stencil out the walls from this light's point of view -- draw fading lightmap circles on the floor -- draw fading lightmaps on the walls depthMask $= Disabled blendFunc $= (Zero, OneMinusSrcAlpha) stencilTest $= Enabled forM_ lightPoints $ \(x,y,r,lum) -> do - -- bind buffer for floor light circle let lightPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata (x',y') = zTran $ rotateV (0 - rot) $ (x,y) -.- (tranx,trany) zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy) pokeFourOff lightPtr 0 (x',y',r,lum) - -- stencil out walls colorMask $= (Color4 Disabled Disabled Disabled Disabled) clear [StencilBuffer] @@ -177,14 +167,12 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints cullFace $= Just Front stencilOp $= (OpKeep,OpKeep,OpDecr) drawShader (_wallShadowShader pdata) nWalls - -- draw floor light circles cullFace $= Nothing colorMask $= (Color4 Disabled Disabled Disabled Enabled) bindShaderBuffers [_lightSourceShader pdata] [1] stencilFunc $= (Equal, 0, 255) drawShader (_lightSourceShader pdata) 1 - -- draw wall light "circles" currentProgram $= Just (_shaderProgram $ _wallLightShader pdata) uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata) @@ -192,34 +180,25 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 2) $= Vector2 r lum drawShader (_wallLightShader pdata) nWallLights - depthMask $= Enabled cullFace $= Nothing stencilTest $= Disabled - blend $= Disabled - bindFramebuffer Framebuffer $= defaultFramebufferObject - colorMask $= (Color4 Disabled Disabled Disabled Enabled) bindShaderBuffers [_fullscreenShader pdata] [4] textureBinding Texture2D $= Just (_fboTexture pdata) drawShader (_fullscreenShader pdata) 4 - colorMask $= (Color4 Enabled Enabled Enabled Enabled) - blend $= Enabled renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO () renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do - depthFunc $= Just Less - +-- depthFunc $= Just Less -- set drawing for on top --blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) - -- draw background bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata - currentProgram $= Just (_shaderProgram $ _backgroundShader pdata) bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata) let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata