Cleanup

src/Dodge/Render/ShapePicture.hs

@@ -21,31 +21,30 @@ import ShapePicture
 
 worldSPic :: Config -> Universe -> SPic
 worldSPic cfig u =
---    (mempty :!: extraPics cfig u)
+    (mempty :!: extraPics cfig u)
---        <> foldup propSPic (filtOn _prPos _props)
+        <> foldup propSPic (filtOn _prPos _props)
---        <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
+        <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
---        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
+        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
---        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
+        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
---        <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
+        <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
---        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
+        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
---        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
+        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
---        <> foldup
+        <> foldup
---            (Prelude.uncurry floorItemSPic)
+            (Prelude.uncurry floorItemSPic)
---            ( IM.intersectionWith
+            ( IM.intersectionWith
---                (,)
+                (,)
---                (lw ^. items)
+                (lw ^. items)
---                (filtOn _flItPos _floorItems)
+                (filtOn _flItPos _floorItems)
---            )
+            )
---        <> foldup btSPic (filtOn _btPos _buttons)
+        <> foldup btSPic (filtOn _btPos _buttons)
---        <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
+        <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
---        <> foldMap' drawChasm (w ^. cWorld . chasms)
+        <> foldMap' drawChasm (w ^. cWorld . chasms)
---        <> w ^. cWorld . lWorld . tempSPic
+        <> w ^. cWorld . lWorld . tempSPic
---        <> 
+        <> testSPic cfig u
-          testSPic cfig u
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
-    --foldup = foldMap'
+    foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g lw)
     filtOn' f g = filter (pointIsClose . f) (g lw)
     pointIsClose = cullPoint cfig w
@@ -54,26 +53,27 @@ testSPic :: Config -> Universe -> SPic
 testSPic cfig u = noShape $ testPic cfig u
 
 testPic :: Config -> Universe -> Picture
-testPic _ _ = f
+testPic _ _ = mempty
-    $ mempty
+--    f
-    <> color white (line [0,10])
+--    $ mempty
-    <> text "A"
+--    <> color white (line [0,10])
-    <> translate 20 20 (arc pi 0 10)
+--    <> text "A"
-    <> translate 0 20 (circleSolidCol white red 10)
+--    <> translate 20 20 (arc pi 0 10)
-  where
+--    <> translate 0 20 (circleSolidCol white red 10)
-    f x = translate 5 20 (setLayer DebugLayer x) <> setLayer BloomLayer x
---    fold $ do
---    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
-----    return mempty
---    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
---    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
---        ^? ix invid . _2
---    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
 --  where
---    f cr loc = foldMap g $ map (muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
+--    f x = translate 5 20 (setLayer DebugLayer x) <> setLayer BloomLayer x
---      where
+----    fold $ do
---        g :: Point3Q -> Picture
+----    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
---        g pq = translate3 (pq ^. _1) $ crossPic 5
+------    return mempty
+----    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+----    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
+----        ^? ix invid . _2
+----    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
+----  where
+----    f cr loc = foldMap g $ map (muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
+----      where
+----        g :: Point3Q -> Picture
+----        g pq = translate3 (pq ^. _1) $ crossPic 5
 
 
 drawBlock :: Block -> SPic

src/Picture/Data.hs

@@ -20,7 +20,6 @@ data Verx = Verx
 data Layer
     = BloomLayer
     | DebugLayer
---    | DebugLayer1
     | FixedCoordLayer
     deriving (Eq, Ord, Enum, Bounded, Show, Read) --Generic, Flat)
 

src/Render.hs

@@ -1,10 +1,9 @@
 module Render (
     createLightMap,
     renderLayer,
-    pingPongBetween,
-    bindFBO,
 ) where
 
+import Shader.Parameters
 import Dodge.Base.Coordinate
 import Dodge.Data.Camera
 import Control.Lens
@@ -18,7 +17,6 @@ import Foreign hiding (rotate)
 import Geometry.Data
 import Graphics.GL.Core45
 import Picture.Data
-import Shader
 import Shader.Data
 
 {- | Determine where light is shining in the world.
@@ -104,12 +102,11 @@ renderLightingNoShadows positiontexture normaltexture lightPoints pdata = do
 renderFlatLighting :: RenderData -> IO ()
 renderFlatLighting pdata = do
     glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
-    withArray [0, 0, 0, 1] $ \ptr ->
+    withArray [0, 0, 0, 1] $
         glClearNamedFramebufferfv
             (pdata ^. fboLighting . _1 . unFBO)
             GL_COLOR
             0
-            ptr
     glDisable GL_CULL_FACE
     glDepthFunc GL_ALWAYS
     glDepthMask GL_FALSE
@@ -206,21 +203,6 @@ renderShadows isclouds cam cfig shadrendertype nWalls nSils nCaps positiontextur
     glStencilOp GL_KEEP GL_KEEP GL_KEEP
     glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
 
--- assumes that vertices have already been sent to the shader
-pingPongBetween ::
-    (FBO, TO) ->
-    (FBO, TO) ->
-    GLuint ->
-    IO ()
-pingPongBetween (fb1, to1) (fb2, to2) fs = do
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2)
-    glBindTextureUnit 0 (_unTO to1)
-    glUseProgram fs
-    glDrawArrays GL_TRIANGLES 0 6
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1)
-    glBindTextureUnit 0 (_unTO to2)
-    glDrawArrays GL_TRIANGLES 0 6
-
 renderLayer ::
     Layer ->
     MV.MVector (PrimState IO) (GLuint, VBO) ->
@@ -233,7 +215,20 @@ renderLayer layer shads counts = do
   where
     ln = fromEnum layer
 
-bindFBO :: FBO -> IO ()
+drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (GLuint, VBO) -> IO ()
-bindFBO fb =
+{-# INLINE drawShaderLay #-}
-    --bindFramebuffer Framebuffer $= fb
+drawShaderLay l countsVector shadIn fs = do
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb)
+--    putStr $ "  shader: " <> show shadIn
+    i <- UMV.read countsVector shadIn
+--    putStrLn $ "    count:  " <> show i
+    glUseProgram (fst fs)
+    glUniform1i 0 . fromIntegral $ (l * numSubElements)
+    glDrawArrays
+        GL_TRIANGLES
+        (fromIntegral $ l * numSubElements)
+        (drawCountMod shadIn i)
+
+drawCountMod :: Int -> Int -> GLsizei
+drawCountMod i n
+    | i == 3 = fromIntegral $ 2 * n  -- modifies ellipse draw count
+    | otherwise = fromIntegral n

src/Shader.hs

@@ -1,27 +0,0 @@
-module Shader (drawShaderLay) where
-
---import Picture.Data
-import Control.Monad.Primitive
-import qualified Data.Vector.Unboxed.Mutable as UMV
-import Graphics.GL.Core45
-import Shader.Data
-import Shader.Parameters
-
-drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (GLuint, VBO) -> IO ()
-{-# INLINE drawShaderLay #-}
-drawShaderLay l countsVector shadIn fs = do
-    putStr $ "  shader: " <> show shadIn
-    i <- UMV.read countsVector shadIn
-    putStrLn $ "    count:  " <> show i
-    glUseProgram (fst fs)
-    glUniform1i 0 . fromIntegral $ (l * numSubElements)
---    if l == fromEnum DebugLayer && shadIn == 0 then print i else return ()
-    glDrawArrays
-        GL_TRIANGLES
-        (fromIntegral $ l * numSubElements)
-        (drawCountMod shadIn i)
-
-drawCountMod :: Int -> Int -> GLsizei
-drawCountMod i n
-    | i == 3 = fromIntegral $ 2 * n  -- modifies ellipse draw count
-    | otherwise = fromIntegral n