Try to add compute shaders

2023-04-11 14:55:57 +01:00
parent 69a76dbf93
commit d79216555b
21 changed files with 457 additions and 246 deletions
@@ -20,7 +20,7 @@ import Dodge.Render
 import Dodge.SoundLogic.LoadSound
 import Dodge.TestString
 import Dodge.Update
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 import Loop
 import Music
 --import Picture
@@ -30,7 +30,7 @@ import Preload.Render

 import SDL (($=))
 import qualified SDL
-import qualified SDL.Mixer as Mix
+--import qualified SDL.Mixer as Mix
 import Sound
 import System.Directory

@@ -59,7 +59,7 @@ winConfig x y winpos =
        { SDL.windowGraphicsContext =
            SDL.OpenGLContext $
                SDL.defaultOpenGL
-                    { SDL.glProfile = SDL.Core SDL.Normal 4 3
+                    { SDL.glProfile = SDL.Core SDL.Normal 4 5
                    , SDL.glColorPrecision = SDL.V4 8 8 8 8
                    }
        , SDL.windowPosition = theWinPos
@@ -128,13 +128,18 @@ doSideEffects u = do

 doPreload :: IO PreloadData
 doPreload = do
+    putStrLn "Start Render preload"
    rData <- preloadRender
+    putStrLn "Start sound preload"
    lChunks <- loadSounds
-    lMusic <- loadMusic
-    Mix.playMusic Mix.Forever (lMusic IM.! 0)
+    putStrLn "Skip music preload!"
+--    lMusic <- loadMusic
+--    Mix.playMusic Mix.Forever (lMusic IM.! 0)
+    putStrLn "Return PreloadData"
    return
        PreloadData
            { _renderData = rData
            , _soundData = SoundData{_loadedChunks = lChunks}
-            , _musicData = MusicData{_loadedMusic = lMusic}
+            --, _musicData = MusicData{_loadedMusic = lMusic}
+            , _musicData = MusicData{_loadedMusic = undefined}
            }
@@ -21,31 +21,31 @@ description:         Description text, TODO link to README.md

 dependencies:
 - base >= 4.7 && < 5
+- aeson
+- aeson-pretty
 - containers
- unordered-containers
+- deepseq
+- dlist
+- directory
+- extra
+- foldl
 - graphviz
- template-haskell
- sdl2
- sdl2-mixer
 - OpenGLRaw
 - text
 - bytestring
 - lens
 - mtl
 - fgl
- random
 - JuicyPixels
- vector
- dlist
- deepseq
+- random
+- sdl2
+- sdl2-mixer
+- template-haskell
 - transformers
- foldl
+- unordered-containers
+- vector
 - linear
- aeson
- aeson-pretty
 #- store
- directory
- extra
 - primitive
 - monad-parallel
 - parallel
@@ -71,7 +71,7 @@ executables:
      #- -eventlog
    - -rtsopts
    - -with-rtsopts=+RTS
-    - -with-rtsopts=-N2
+    - -with-rtsopts=-N
    #- -with-rtsopts=-l
    - -flate-dmd-anal
    - -fno-liberate-case 
@@ -0,0 +1,7 @@
+#version 450 core
+layout(local_size_x= 1, local_size_y=1) in;
+uniform sampler2DArray screenTexture;
+layout(rgba8, binding = 5) uniform restrict writeonly image2D img_output;
+void main()
+{
+}
@@ -0,0 +1,40 @@
+#version 450 core
+layout(local_size_x= 16, local_size_y=1) in;
+layout(rgba8, binding = 5) uniform restrict writeonly image2D img_output;
+layout (std140, binding = 1) uniform LightsBlock
+{
+    vec4 posBool[20];
+    vec4 colRad[20];
+} ;
+layout (binding = 0) uniform sampler2D posTexture;
+layout (binding = 1) uniform sampler2D normals;
+void main ()
+{
+    shared vec3[20] larray;
+    uint i = gl_LocalInvocationID.x;
+    vec3 lightamount = vec3(0,0,0);
+    ivec2 pixel_coords = ivec2(gl_GlobalInvocationID.xy);
+    vec2 tex_coords = vec2((4*pixel_coords.x+4)/800.0, (4*pixel_coords.y+4)/835.0);
+    vec3 pos = texture(posTexture,tex_coords).xyz;
+    vec3 lightPos = posBool[i].xyz;
+    vec4 lumRad = colRad[i];
+    vec3 distVec = lightPos - pos;
+    float dist = dot (distVec,distVec);
+    if (dist > lumRad.a) { }
+    else 
+    {
+        float x = 1 - dist / lumRad.a;
+        vec3 norm = texture(normals,tex_coords).xyz;
+        float y1 = dot(normalize(norm), normalize(distVec));
+        float y = float(y1 > 0 ? 1 : 0);
+        lightamount = y*x*lumRad.rgb;
+
+    }
+      larray[i] = lightamount;
+    if (i == 0)
+        //{   vec3 inverselight = 1 - lightamount;
+        {   vec3 inverselight = vec3(0,0,0);
+//            for (uint j=1 ; j < 20; ++j) {inverselight = inverselight * (1 - larray[j]);}
+            imageStore(img_output, pixel_coords, vec4(inverselight,1));
+        }
+}
@@ -32,5 +32,5 @@ float rad = lumRad.a;
  float y = y2;
  float x = 1 - dist / rad;
  vec3 c = y* (x * x * x) * lumRad.rgb;
-  fColor = vec4(c, 0);
+  fColor = vec4(c, 1);
 }
@@ -1,35 +1,11 @@
--{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE StrictData #-}
+module Color (
+    module Color,
+    module Color.Data,
+) where

-module Color where
-
-import Data.Aeson
-import Data.Aeson.TH
+import Color.Data
 import Geometry
-
-data PaletteColor
-    = RED
-    | GREEN
-    | BLUE
-    | YELLOW
-    | CYAN
-    | MAGENTA
-    | ROSE
-    | VIOLET
-    | AZURE
-    | AQUAMARINE
-    | CHARTREUSE
-    | ORANGE
-    | WHITE
-    | BLACK
-    deriving (Eq, Ord, Enum, Show, Read) --Generic, Flat)
-
-type RGBA = Point4
-
-type Color = Point4
+import Control.Lens

 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}
@@ -165,4 +141,5 @@ numColor _ = toV4 (1, 1, 1, 1)
 light4 :: Color -> Color
 light4 = light . light . light . light

-deriveJSON defaultOptions ''PaletteColor
+toColor256 :: Color -> Color256
+toColor256 = over each floor . (255 *) . normalizeColor
@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+--{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Color.Data where
+
+import Data.Aeson
+import Data.Aeson.TH
+import Data.Word
+import Geometry
+
+data PaletteColor
+    = RED
+    | GREEN
+    | BLUE
+    | YELLOW
+    | CYAN
+    | MAGENTA
+    | ROSE
+    | VIOLET
+    | AZURE
+    | AQUAMARINE
+    | CHARTREUSE
+    | ORANGE
+    | WHITE
+    | BLACK
+    deriving (Eq, Ord, Enum, Show, Read) --Generic, Flat)
+
+type RGBA = Point4
+
+type Color = Point4
+
+type Color256 = V4 Word8
+
+deriveJSON defaultOptions ''PaletteColor
@@ -11,7 +11,8 @@ import Graphics.GL.Core45
 import Shader.Data

 data RenderData = RenderData
-    { _lightingWallShadShader :: Shader
+    { _computeShadowShader :: GLuint
+    , _lightingWallShadShader :: Shader
    , _lightingLineShadowShader :: Shader
    , _lightingCapShader :: Shader
    , _lightingTextureShader :: Shader
@@ -100,6 +100,7 @@ data ShadowRendering
    | NoObjShads
    | NoShadows
    | NoLighting
+    | ComputeShader
    deriving (Show, Eq, Ord, Enum, Bounded)

 data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
@@ -15,6 +15,12 @@ import Dodge.Tree
 import LensHelp
 import RandomHelp

+startWorldTreeTest :: Annotation
+startWorldTreeTest  =
+    OnwardList $
+            [ IntAnno $ AnTree . startRoom
+            ]
+
 initialAnoTree :: Annotation
 initialAnoTree =
    OnwardList $
@@ -103,4 +109,5 @@ initialAnoTree =

 -- | A test level tree.
 initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
-initialRoomTree = annoToRoomTree initialAnoTree
+--initialRoomTree = annoToRoomTree initialAnoTree
+initialRoomTree = annoToRoomTree startWorldTreeTest
@@ -91,7 +91,7 @@ baseBlockPane =
        --, _wlColor = greyN 0.5
        , _wlColor = dark $ dark orange
        --, _wlOpacity = Opaque 10
-        , _wlOpacity = Opaque 14
+        , _wlOpacity = Opaque 17
        , _wlUnshadowed = True
        , _wlFireThrough = True
        , _wlPenetrable = True
@@ -209,6 +209,9 @@ doDrawing' win pdata u = do
        pdata
    glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
    --apply lightmap to base buffer
+    glDisable GL_CULL_FACE
+    glDepthFunc GL_ALWAYS
+    glDepthMask GL_FALSE
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
    glBindTextureUnit 0 (pdata ^. fboLighting . _2 . unTO)
    glEnable GL_BLEND
@@ -244,100 +247,100 @@ doDrawing' win pdata u = do
    replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
    glEnable GL_BLEND
    setViewport _graphics_world_resolution cfig
-    --draw clouds onto cloud buffer
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
-    glDepthFunc GL_LEQUAL
-    glDepthMask GL_FALSE
-    --blendFunc $= (SrcAlphaSaturate,One)
-    --blendColor $= Color4 0.5 0.5 0.5 0.5
-    --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
-    --blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
-    --glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
-    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
-    --glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
-    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
-    withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
-        glClearNamedFramebufferfv
-            (pdata ^. fboCloud . _1 . unFBO)
-            GL_COLOR
-            0
-            ptr
-    --    renderLayer MidLayer shadV layerCounts
-    glUseProgram (pdata ^. cloudShader . shaderUINT)
-    glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
-    glDrawElements
-        (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
-        (fromIntegral nCloudIs)
-        GL_UNSIGNED_SHORT
-        nullPtr
-    drawShader (_windowShader pdata) nWins
-    when (_graphics_cloud_shadows cfig) $ do
-        ----render transparency depths
-        glDepthMask GL_TRUE
-        glDepthFunc GL_ALWAYS
-        glDisable GL_BLEND
-        withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> glDrawBuffers 3 ptr
-        withArray [0, 0, 0, 0] $ \ptr ->
-            glClearNamedFramebufferfv
-                (pdata ^. fboCloud . _1 . unFBO)
-                GL_COLOR
-                1
-                ptr
-        withArray [0, 0, 0, 0] $ \ptr ->
-            glClearNamedFramebufferfv
-                (pdata ^. fboCloud . _1 . unFBO)
-                GL_COLOR
-                2
-                ptr
-        glEnable GL_BLEND
-        -- we sum the positions weighted by alpha, and sum the alpha
-        glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
-        -- and sum the normals weighted by alpha
-        glBlendFunci 2 GL_SRC_ALPHA GL_ONE
-        glUseProgram (pdata ^. cloudShader . shaderUINT)
-        glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
-        glDepthMask GL_TRUE
-        glDrawElements
-            (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
-            (fromIntegral nCloudIs)
-            GL_UNSIGNED_SHORT
-            nullPtr
-        drawShader (_windowShader pdata) nWins
-        glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
-        withArray [0, 0, 0, 0] $ \ptr ->
-            glClearNamedFramebufferfv
-                (pdata ^. fboPos . _1 . unFBO)
-                GL_COLOR
-                0
-                ptr
-        glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
-        glDepthMask GL_FALSE
-        drawShader (pdata ^. alphaDivideShader) 4
-        ----draw lightmap for cloud buffer
-        glDepthFunc GL_LESS
-        glEnable GL_BLEND
-        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
-        createLightMap
-            cfig
-            (fromIntegral trueNWalls)
-            nSilIndices
-            nIndices
-            (pdata ^. fboPos . _2)
-            (pdata ^. fboCloud . _2 . _3)
-            lightPoints
-            pdata
-    glInvalidateBufferData (pdata ^. vboShapes . vboName)
-    --apply lightmap to cloud buffer
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
-    glDepthMask GL_FALSE
-    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
-    glDepthFunc GL_ALWAYS
-    glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
-    glEnable GL_BLEND
-    glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
-    drawShader (_fullscreenShader pdata) 4
-    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
+--    --draw clouds onto cloud buffer
+--    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
+--    glDepthFunc GL_LEQUAL
+--    glDepthMask GL_FALSE
+--    --blendFunc $= (SrcAlphaSaturate,One)
+--    --blendColor $= Color4 0.5 0.5 0.5 0.5
+--    --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
+--    --blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
+--    --glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
+--    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
+--    --glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
+--    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
+--    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
+--    withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
+--        glClearNamedFramebufferfv
+--            (pdata ^. fboCloud . _1 . unFBO)
+--            GL_COLOR
+--            0
+--            ptr
+--    --    renderLayer MidLayer shadV layerCounts
+--    glUseProgram (pdata ^. cloudShader . shaderUINT)
+--    glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
+--    glDrawElements
+--        (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
+--        (fromIntegral nCloudIs)
+--        GL_UNSIGNED_SHORT
+--        nullPtr
+--    drawShader (_windowShader pdata) nWins
+--    when (_graphics_cloud_shadows cfig) $ do
+--        ----render transparency depths
+--        glDepthMask GL_TRUE
+--        glDepthFunc GL_ALWAYS
+--        glDisable GL_BLEND
+--        withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> glDrawBuffers 3 ptr
+--        withArray [0, 0, 0, 0] $ \ptr ->
+--            glClearNamedFramebufferfv
+--                (pdata ^. fboCloud . _1 . unFBO)
+--                GL_COLOR
+--                1
+--                ptr
+--        withArray [0, 0, 0, 0] $ \ptr ->
+--            glClearNamedFramebufferfv
+--                (pdata ^. fboCloud . _1 . unFBO)
+--                GL_COLOR
+--                2
+--                ptr
+--        glEnable GL_BLEND
+--        -- we sum the positions weighted by alpha, and sum the alpha
+--        glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
+--        -- and sum the normals weighted by alpha
+--        glBlendFunci 2 GL_SRC_ALPHA GL_ONE
+--        glUseProgram (pdata ^. cloudShader . shaderUINT)
+--        glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
+--        glDepthMask GL_TRUE
+--        glDrawElements
+--            (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
+--            (fromIntegral nCloudIs)
+--            GL_UNSIGNED_SHORT
+--            nullPtr
+--        drawShader (_windowShader pdata) nWins
+--        glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
+--        withArray [0, 0, 0, 0] $ \ptr ->
+--            glClearNamedFramebufferfv
+--                (pdata ^. fboPos . _1 . unFBO)
+--                GL_COLOR
+--                0
+--                ptr
+--        glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
+--        glDepthMask GL_FALSE
+--        drawShader (pdata ^. alphaDivideShader) 4
+--        ----draw lightmap for cloud buffer
+--        glDepthFunc GL_LESS
+--        glEnable GL_BLEND
+--        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
+--        createLightMap
+--            cfig
+--            (fromIntegral trueNWalls)
+--            nSilIndices
+--            nIndices
+--            (pdata ^. fboPos . _2)
+--            (pdata ^. fboCloud . _2 . _3)
+--            lightPoints
+--            pdata
+--    glInvalidateBufferData (pdata ^. vboShapes . vboName)
+--    --apply lightmap to cloud buffer
+--    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
+--    glDepthMask GL_FALSE
+--    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
+--    glDepthFunc GL_ALWAYS
+--    glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
+--    glEnable GL_BLEND
+--    glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
+--    drawShader (_fullscreenShader pdata) 4
+--    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    -- bind base buffer for drawing bloom then clouds
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    --Draw blurred bloom onto base buffer
@@ -346,9 +349,9 @@ doDrawing' win pdata u = do
    glBindTextureUnit 0 (_unTO . snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-    --draw shadowed clouds onto base buffer
-    glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
-    drawShader (_fullscreenShader pdata) 4
+--    --draw shadowed clouds onto base buffer
+--    glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
+--    drawShader (_fullscreenShader pdata) 4
    --set viewport for radial distortion
    --setViewportSize (round winx) (round winy)
    setViewport (const FullRes) cfig
@@ -19,6 +19,7 @@ import Dodge.Data.Universe
 testStringInit :: Universe -> [String]
 testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount
    , show $ getSmoothScrollValue (u ^. uvWorld . input)
+    , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
    ]
 --    [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam) 
 --        (u ^. uvWorld . cWorld . lWorld)
@@ -201,7 +201,8 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]

 text :: String -> Picture
 {-# INLINE text #-}
-text = translate (-50) (-100) . drawText (10)
+--text = translate (-50) (-100) . drawText (10)
+text = translate (-50) (-100) . drawText (-10)

 drawText :: Float -> String -> [Verx]
 drawText gap = map f . stringToList gap
@@ -6,20 +6,20 @@ module Preload.Render (
 ) where

 import Control.Concurrent
-import Shader.AuxAddition
-import Shape.Data
-import GLHelp
 import Control.Lens
 import Control.Monad
 import Data.Preload.Render
 import qualified Data.Vector.Mutable as MV
 import Foreign
 import Framebuffer.Setup
+import GLHelp
+import Graphics.GL.Core45
 import Shader
+import Shader.AuxAddition
 import Shader.Compile
 import Shader.Data
 import Shader.Parameters
-import Graphics.GL.Core45
+import Shape.Data

 {- BINDING LIST:
 0   base
@@ -30,22 +30,44 @@ import Graphics.GL.Core45

 preloadRender :: IO RenderData
 preloadRender = do
+    putStrLn "Number cores available:"
+    getNumCapabilities >>= print
+
+    forM_ [0, 1, 2] $ \i -> do
+        putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_COUNT " ++ show i
+        alloca $ \ptr -> do
+            glGetIntegeri_v GL_MAX_COMPUTE_WORK_GROUP_COUNT i ptr
+            x <- peek ptr
+            putStrLn $ show x
+
+    forM_ [0, 1, 2] $ \i -> do
+        putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_SIZE " ++ show i
+        alloca $ \ptr -> do
+            glGetIntegeri_v GL_MAX_COMPUTE_WORK_GROUP_SIZE i ptr
+            x <- peek ptr
+            putStrLn $ show x
+    putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_INVOCATIONS"
+    alloca $ \ptr -> do
+        glGetIntegerv GL_MAX_COMPUTE_WORK_GROUP_INVOCATIONS ptr
+        x <- peek ptr
+        putStrLn $ show x
+
    -- set up uniform buffer object
+    putStrLn "Setup UBO"
    theUBO <- mglCreate glCreateBuffers
    glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
    glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO

-    getNumCapabilities >>= print
-    
--    orthonormalUBO <- mglCreate glCreateBuffers
--    withArray idMat $ \ptr ->
--        glNamedBufferStorage orthonormalUBO 64 ptr 0
+    --    orthonormalUBO <- mglCreate glCreateBuffers
+    --    withArray idMat $ \ptr ->
+    --        glNamedBufferStorage orthonormalUBO 64 ptr 0

    lightsubo <- mglCreate glCreateBuffers
    glNamedBufferData lightsubo 640 nullPtr GL_STREAM_DRAW
    glBindBufferBase GL_UNIFORM_BUFFER 1 lightsubo

    -- setup shape geometry/cap VBO and two VAOs
+    putStrLn "Setup shape VBO, VAO, EBO"
    shVBO <- setupVBO nShapeVerxComp
    shPosVAO <- setupVAOUsingVBO [4] shVBO
    shEBO <- setupEBO shPosVAO
@@ -55,11 +77,17 @@ preloadRender = do
    glVertexArrayElementBuffer (shapeshader ^. shaderVAO . vaoName) (shEBO ^. eboName)

    --setup silhouette edge VAO
+    putStrLn "Setup silhouette VAO, EBO"
    shedgevao <- setupVAOUsingVBO [4] shVBO
    shedgeebo <- setupEBO shedgevao

+    putStrLn "Setup wall/windows VBO, VAO, EBO, shader"
    let wallverxstrd = 8
    wallvbo <- setupVBO wallverxstrd
+    winvbo <- setupVBO 8
+    windowshader <- makeShaderUsingVBO "wall/blank" [vert, geom, frag] [4, 4] pmPoints winvbo
+    wallshader <- makeShaderUsingVBO "wall/basic" [vert, geom, frag] [4, 4] pmPoints wallvbo
+    putStrLn "Setup lighting shaders"
    lightingWallShadShad <-
        makeShaderUsingVBO "lighting/wallShadow" [vert, geom] [4] pmPoints wallvbo
    lightingCapShad <-
@@ -72,24 +100,29 @@ preloadRender = do
        makeShaderUsingVAO "shadow/cap" [vert, geom] pmTriangles shPosVAO
    shadowwallshader <-
        makeShaderUsingVBO "shadow/wallShadow" [vert, geom] [4] pmPoints wallvbo
-    shadowlightshader <- makeShaderSized "shadow/light" [vert, geom, frag] 
-        [1] 1
+    shadowlightshader <-
+        makeShaderSized
+            "shadow/light"
+            [vert, geom, frag]
+            [1]
+            1
            pmPoints
-    shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 pmPoints
+    shadowcombineshader <- makeShaderSized "shadow/combine" [vert, geom, frag] [1] 1 pmPoints
    poke (shadVBOptr shadowlightshader) 1

-    -- 2D draw shaders
+    putStrLn "Setup 2D shaders"
    bslist <- makeShaderVBO "dualTwoD/basic" [vert, frag] [3, 4] pmTriangles
    aslist <- makeShaderVBO "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles
    eslist <- makeShaderVBO "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
    cslist <-
        makeShaderVBO "picture/charArray" [vert, frag] [3, 4, 4] pmTriangles
--    initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR
--    initTexture2DArray 50 "data/texture/charMapVert16Block.png" 2 16 32 95 GL_NEAREST GL_NEAREST
-    initTexture2DArray 50 "data/texture/charMapVert8Block.png" 2 8 16 95 GL_NEAREST GL_NEAREST
+    --    initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR
+    initTexture2DArray 50 "data/texture/charMapVert16Block.png" 2 16 32 95 GL_NEAREST GL_NEAREST
+    --initTexture2DArray 50 "data/texture/charMapVert8Block.png" 2 8 16 95 GL_NEAREST GL_NEAREST
    --initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
    --initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_NEAREST GL_LINEAR

+    putStrLn "Setup full screen shaders"
    screentexturevbo <- mglCreate glCreateBuffers
    withArray (concat cornerList) $ \ptr ->
        glNamedBufferStorage
@@ -97,8 +130,8 @@ preloadRender = do
            (fromIntegral $ floatSize * length (concat cornerList))
            ptr
            0
-    screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo
-    alphadivideshader <- makeShaderUsingVAO "texture2D/alphaDivide" [vert,frag] pmTriangleStrip screentexturevao
+    screentexturevao <- setupVAOvbo' [2, 2] 4 screentexturevbo
+    alphadivideshader <- makeShaderUsingVAO "texture2D/alphaDivide" [vert, frag] pmTriangleStrip screentexturevao
    fsShad <- makeShaderUsingVAO "texture/simple" [vert, frag] pmTriangleStrip screentexturevao
    bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] pmTriangleStrip screentexturevao
    colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] pmTriangleStrip screentexturevao
@@ -107,22 +140,22 @@ preloadRender = do
        makeShaderUsingVAO "lighting/texture" [vert, frag] pmTriangleStrip screentexturevao
    barrelShad <- makeShaderVBO "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] pmPoints
    -- blank wallShader
-    winvbo <- setupVBO 8
-    windowshader <- makeShaderUsingVBO "wall/blank" [vert, geom, frag] [4,4] pmPoints winvbo
-    wallshader <- makeShaderUsingVBO "wall/basic" [vert,geom,frag] [4,4] pmPoints wallvbo
+    putStrLn "Setup floor VBO, shader"
    let floorverxstrd = 8
    floorvbo <- setupVBOStatic floorverxstrd
-    floorshader <- makeShaderUsingVBO "floor/arrayPos" [vert, frag] [4,4] pmTriangles floorvbo
+    floorshader <- makeShaderUsingVBO "floor/arrayPos" [vert, frag] [4, 4] pmTriangles floorvbo
    initTexture2DArraySquare 40 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
    initTexture2DArraySquare 41 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"

-    let cloudverxsizes = [4,4,4,4]
+    putStrLn "Setup cloud VBO, shader"
+    let cloudverxsizes = [4, 4, 4, 4]
    cloudvbo <- setupVBO (sum cloudverxsizes)
-    (cloudshader, cloudebo)
-        <- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes pmTriangles cloudvbo
+    (cloudshader, cloudebo) <-
+        makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes pmTriangles cloudvbo
    framebuf2 <- newTextureFramebuffer
    framebuf3 <- newTextureFramebuffer

+    putStrLn "Setup framebuffers"
    rboBaseBloomName <- mglCreate glCreateRenderbuffers
    glNamedRenderbufferStorage
        rboBaseBloomName
@@ -156,10 +189,16 @@ preloadRender = do
        , aslist
        , eslist
        ]
+
+    -- setup compute shader
+    computeshadowshader <- makeSourcedShader "compute/shadow" [GL_COMPUTE_SHADER]
+
    initializeGLState
+    putStrLn "Return preload"
    return $
        RenderData
-            { _pictureShaders = shadV
+            { _computeShadowShader = computeshadowshader
+            , _pictureShaders = shadV
            , _shapeShader = shapeshader -- & shaderVAO' .~ shPosColVAO
            , _shapeEBO = shEBO
            , _silhouetteEBO = shedgeebo
@@ -193,8 +232,8 @@ preloadRender = do
            , _fboOverlay = fbooverlay
            , _rboBaseBloom = rboBaseBloomName
            , _matUBO = theUBO
--            , _orthonormalMatUBO = orthonormalUBO
-            , _lightsUBO = lightsubo
+            , --            , _orthonormalMatUBO = orthonormalUBO
+              _lightsUBO = lightsubo
            , _vboWindows = winvbo
            , _vboShapes = shVBO
            , _floorVBO = floorvbo
@@ -215,6 +254,7 @@ cornerList =
    , [1, 1, 1, 1]
    , [1, -1, 1, 0]
    ]
+
 --cornerListForTriangles :: [[Float]]
 --cornerListForTriangles =
 --    [ [-1, 1, 0, 1]
@@ -229,11 +269,11 @@ initializeGLState :: IO ()
 initializeGLState = do
    glEnable GL_DEPTH_TEST

-
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload _ = return ()
+
 --cleanUpRenderPreload pd = do
-    -- TODO fix this
-    --mapM_ freeShaderPointers $ _pictureShaders pd
-    --freeShaderPointers' $ _lightingWallShadShader pd
-    --freeShaderPointers' $ _fullscreenShader pd
+-- TODO fix this
+--mapM_ freeShaderPointers $ _pictureShaders pd
+--freeShaderPointers' $ _lightingWallShadShader pd
+--freeShaderPointers' $ _fullscreenShader pd
@@ -44,6 +44,7 @@ createLightMap cfig = case shadrendertype of
    InstancingShads -> instanceLightMap cfig
    NoShadows -> const . const . const renderLightingNoShadows
    NoLighting -> const . const . const . const . const . const renderFlatLighting
+    ComputeShader -> renderComputeShadows
    _ -> renderShadows shadrendertype
  where
    shadrendertype = cfig ^. graphics_shadow_rendering
@@ -103,6 +104,28 @@ renderLightingNoShadows positiontexture normaltexture lightPoints pdata = do
    glDisable GL_CULL_FACE
    glDisable GL_STENCIL_TEST

+renderComputeShadows ::
+    GLsizei ->
+    Int ->
+    Int ->
+    TO ->
+    TO ->
+    [(Point3, Float, Point3)] ->
+    RenderData ->
+    IO ()
+renderComputeShadows _ _ _ toPos tanormals lightPoints rd = do
+    withArray (lightsToArray lightPoints) $ \ptr ->
+        glNamedBufferSubData (rd ^. lightsUBO) 0 620 ptr
+    glBindTextureUnit 0 (toPos ^. unTO)
+    glBindTextureUnit 1 (tanormals ^. unTO)
+    glBindImageTexture 5 (rd ^. fboLighting . _2 . unTO) 0 GL_FALSE 0 GL_WRITE_ONLY GL_RGBA8
+    glUseProgram (rd ^. computeShadowShader)
+    glDispatchCompute 800 835 1
+    -- the following should be later, just before the texture is accessed
+    --glMemoryBarrier GL_SHADER_IMAGE_ACCESS_BARRIER_BIT
+    glMemoryBarrier GL_TEXTURE_FETCH_BARRIER_BIT
+    return ()
+
 renderFlatLighting :: RenderData -> IO ()
 renderFlatLighting pdata = do
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
@@ -145,12 +168,14 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
            ptr
    -- for each of the lights:
    -- 1. stencil out the shadows from this light's point of view
-    -- 2. calculate lighting based on each fragment's position
-    -- to consider: adding normals/a "material" for each fragment
+    -- 2. calculate lighting based on each fragment's position and normal
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    glEnable GL_STENCIL_TEST
    glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP
    glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP
+    -- bind world position texture-- these will be used by the lighting shader
+    glBindTextureUnit 0 (positiontexture ^. unTO)
+    glBindTextureUnit 1 (normaltexture ^. unTO)
    flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
        glDepthFunc GL_LESS
        -- setup stencil
@@ -200,10 +225,7 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
            _ -> return ()
        --draw lightmap itself
        glDepthFunc GL_ALWAYS
-        -- bind world position texture
        glDisable GL_CULL_FACE
-        glBindTextureUnit 0 (positiontexture ^. unTO)
-        glBindTextureUnit 1 (normaltexture ^. unTO)
        glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
        glStencilFunc GL_EQUAL 0 255
        glUseProgram (ltextShad ^. shaderUINT) --Just (_shadProg ltextShad)
@@ -12,6 +12,7 @@ module Shader.Compile (
    setupVAOvbo',
    setupEBO,
    setupVertexAttribPointer,
+    makeSourcedShader,
 ) where

 import Control.Lens
@@ -66,7 +67,8 @@ makeShaderEBO s shaderlist sizes pm vbo = do
    shad <- makeShaderUsingVBO s shaderlist sizes pm vbo
    ebo <- setupEBO (shad ^. shaderVAO)
    glVertexArrayElementBuffer (shad ^. shaderVAO . vaoName) (ebo ^. eboName)
-    return ( shad
+    return
+        ( shad
        , ebo
        )

@@ -183,6 +185,7 @@ shaderTypeExt :: GLenum -> String
 shaderTypeExt GL_VERTEX_SHADER = ".vert"
 shaderTypeExt GL_GEOMETRY_SHADER = ".geom"
 shaderTypeExt GL_FRAGMENT_SHADER = ".frag"
+shaderTypeExt GL_COMPUTE_SHADER = ".comp"
 shaderTypeExt _ = undefined

 -- I think that this requires that the correct shader program is bound?
@@ -207,7 +210,7 @@ setupVAOUsingVBO sizes vbo = do
    vaoname <- mglCreate glCreateVertexArrays
    glBindVertexArray vaoname
    setupVertexAttribs vbo vaoname sizes strd
-    return VAO { _vaoName = vaoname }
+    return VAO{_vaoName = vaoname}

 setupEBO :: VAO -> IO EBO
 setupEBO vao = do
@@ -3,22 +3,23 @@ module Shader.Poke (
    pokeLayVerxs,
    pokeArrayOff,
    pokeShape,
+    pokeShape',
    pokeWallsWindows,
    memoTopPrismEdgeIndices,
-    pokeFloors
+    pokeFloors,
 ) where

-import Geometry.Vector
-import Dodge.Data.Wall
-import Geometry.Triangulate
 import Control.Monad.Primitive
 import qualified Data.Vector as V
 import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Unboxed as UV
 import qualified Data.Vector.Unboxed.Mutable as UMV
+import Dodge.Data.Wall
 import Foreign
 import Geometry.Data
+import Geometry.Triangulate
+import Geometry.Vector
 import Graphics.GL.Core45
 import Linear.V3 (cross)
 import Picture.Data
@@ -34,6 +35,7 @@ pokeVerxs ::
 pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList

 pokeVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
+{-# INLINE pokeVerx #-}
 pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = shadnum} = do
    typeOff <- UMV.unsafeRead offsets sn
    basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
@@ -53,9 +55,10 @@ pokeWallsWindows ::
 pokeWallsWindows wiptr truewlptr wis truewls = do
    wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis)
    wlcounts3 <- VFSM.foldlM' (pokeWall truewlptr) 0 (VFSM.fromList truewls)
-    return ( wlcounts2, wlcounts3)
+    return (wlcounts2, wlcounts3)

-pokeFloors :: Ptr Float ->
+pokeFloors ::
+    Ptr Float ->
    [(Point3, Point3)] ->
    IO Int
 pokeFloors flptr fls = VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)
@@ -72,8 +75,9 @@ pokeF ptr i' (V3 a b c, V3 d e f) = do
    return $ i' + 1

 pokeWall :: Ptr Float -> Int -> Wall -> IO Int
+{-# INLINE pokeWall #-}
 pokeWall ptr nw wl = do
-    UV.imapM_ f $ UV.fromList [x,y,x1,y1,t,a,1,1]
+    UV.imapM_ f $ UV.fromList [x, y, x1, y1, t, a, 1, 1]
    return $ nw + 1
  where
    f i = pokeElemOff ptr (nw * 8 + i)
@@ -94,6 +98,15 @@ pokeW ptr i' ((V2 a b, V2 c d), V4 e f g h) = do
    pokeElemOff ptr (i + 7) h
    return $ i' + 1

+pokeShape' ::
+    Ptr Float ->
+    Ptr GLushort ->
+    Ptr GLushort ->
+    (Int, Int, Int) ->
+    [Surface] ->
+    IO (Int, Int, Int)
+pokeShape' = pokeShape $ const False
+
 pokeShape ::
    (Surface -> Bool) ->
    Ptr Float ->
@@ -102,7 +115,8 @@ pokeShape ::
    (Int, Int, Int) ->
    [Surface] ->
    IO (Int, Int, Int)
-pokeShape shadowtest ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is 
+pokeShape shadowtest ptr iptr ieptr is =
+    VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
        . VFSM.fromList

 pokeShapeObj ::
@@ -139,12 +153,17 @@ pokeRoundedFaces sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = d
            (pokeIndex nv iptr)
            nsi
            (memoTopPrismIndices V.! (size - 3))
-    nei' <- if sfid then return nei
-        else UV.foldM' (pokeIndex nv ieptr) nei $
+    nei' <-
+        if sfid
+            then return nei
+            else
+                UV.foldM' (pokeIndex nv ieptr) nei $
                    memoTopPrismEdgeIndices V.! (size - 3)
    return (nv', nsi', nei')
  where
-    xdata | sfid = 0
+    xdata
+        | sfid = 0 -- this records whether the shadow should be shown or not
+        -- honestly, I think things where faster without this
        | otherwise = 1
 pokeRoundedFaces _ _ _ _ _ _ _ _ = undefined

@@ -166,13 +185,16 @@ pokeCylinder sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
            (pokeIndex nv iptr)
            nsi
            (memoCylinderIndices V.! (size - 3))
-    nei' <- if sfid
+    nei' <-
+        if sfid
            then return nei
-        else UV.foldM' (pokeIndex nv ieptr) nei $
+            else
+                UV.foldM' (pokeIndex nv ieptr) nei $
                    memoTopPrismEdgeIndices V.! (size - 3)
    return (nv', nsi', nei')
  where
-    xdata | sfid = 0
+    xdata
+        | sfid = 0
        | otherwise = 1
 pokeCylinder _ _ _ _ _ _ _ _ = undefined

@@ -185,6 +207,7 @@ pokeRoundedCurve xdata col ptr tc bc = go True
    go _ [] n = return n

 pokeCylinderCaps :: Float -> Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
+{-# INLINE pokeCylinderCaps #-}
 pokeCylinderCaps xdata col ptr tc bc = go True
  where
    go True (x : xs) n = pokeJustVInvNormal xdata tc col ptr n x >>= go False xs
@@ -209,17 +232,22 @@ pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do
            (pokeIndex nv iptr)
            nsi
            (memoFlatIndices V.! (size -3))
-    nei' <- if sfid then return nei
-        else UV.foldM' (pokeIndex nv ieptr) nei $
+    nei' <-
+        if sfid
+            then return nei
+            else
+                UV.foldM' (pokeIndex nv ieptr) nei $
                    memoBoxEdgeIndices V.! (size - 3)
    return (nv', nsi', nei')
  where
    svsv = UV.fromList svs
-    xdata | sfid = 0
+    xdata
+        | sfid = 0
        | otherwise = 1

 -- should probably use a vector of Point3
 pokeBoxSurface :: Float -> Point4 -> Ptr Float -> UV.Vector Point3 -> Int -> [Int] -> IO Int
+{-# INLINE pokeBoxSurface #-}
 pokeBoxSurface xdata col ptr vs n is =
    UV.foldM'
        (pokeFlatV xdata norm col ptr)
@@ -241,11 +269,11 @@ boxSurfaces size =
  where
    f x = map (`mod` (size * 2)) [x, x + 1, x + 3, x + 2]

-boxSurfaces' :: Int -> [[Int]]
-boxSurfaces' n =
+boxSurfacesIndices :: Int -> [[Int]]
+boxSurfacesIndices n =
    [0 .. n -1] :
    reverse [n .. n * 2 -1] :
-    [ map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]
+        [map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]

 pokeIndex ::
    -- | base index
@@ -261,11 +289,11 @@ pokeIndex nv eiptr ni ioff = do
    pokeElemOff eiptr ni (fromIntegral $ nv + ioff)
    return $ ni + 1

-
 memoFlatIndices :: V.Vector (UV.Vector Int)
+{-# INLINE memoFlatIndices #-}
 memoFlatIndices =
    V.generate 10 $
-        UV.fromList . concatMap polyToTris . boxSurfaces' . (+ 3)
+        UV.fromList . concatMap polyToTris . boxSurfacesIndices . (+ 3)

 memoTopPrismIndices :: V.Vector (UV.Vector Int)
 {-# INLINE memoTopPrismIndices #-}
@@ -289,10 +317,21 @@ topPrismEdgeIndices ::
    [Int]
 topPrismEdgeIndices n = concatMap f [0 .. n -1]
  where
-    f i = map g
-            [ 0 , 2 ,  1 , 4 
-            , 0 , 1 , -2 , 3 
-            , 1 , 3 , -1 , 2 
+    f i =
+        map
+            g
+            [ 0
+            , 2
+            , 1
+            , 4
+            , 0
+            , 1
+            , -2
+            , 3
+            , 1
+            , 3
+            , -1
+            , 2
            ]
      where
        g j = (2 * i + j) `mod` (2 * n)
@@ -308,9 +347,19 @@ boxEdgeIndices ::
    [Int]
 boxEdgeIndices n = concatMap f [0 .. n -1]
  where
-    f i = [ g 0 , g 1 ,n + g 0 , g 2 
-          , g 0 , n + g 0 , n + g (-1) , g 1
-          , n + g 0 , n + g 1 , n + g (-1) , g 1
+    f i =
+        [ g 0
+        , g 1
+        , n + g 0
+        , g 2
+        , g 0
+        , n + g 0
+        , n + g (-1)
+        , g 1
+        , n + g 0
+        , n + g 1
+        , n + g (-1)
+        , g 1
        ]
      where
        g j = (i + j) `mod` n
@@ -323,14 +372,22 @@ cylinderIndices n =

 cylinderRoundIndices :: Int -> [Int]
 cylinderRoundIndices n =
-    [ 2 * n -2 , 2 * n -1 , 1
-    , 2 * n -2 , 1 , 0 -- last side triangle (applies mod 2n)
+    [ 2 * n -2
+    , 2 * n -1
+    , 1
+    , 2 * n -2
+    , 1
+    , 0 -- last side triangle (applies mod 2n)
    ]
        ++ concatMap g [0 .. n -2] -- other triangles on sides
  where
    g x =
-        [ 2 * x , 2 * x + 1 , 2 * x + 3
-        , 2 * x , 2 * x + 3 , 2 * x + 2
+        [ 2 * x
+        , 2 * x + 1
+        , 2 * x + 3
+        , 2 * x
+        , 2 * x + 3
+        , 2 * x + 2
        ]

 topPrismIndices :: Int -> [Int]
@@ -338,21 +395,27 @@ topPrismIndices n =
    concatMap f [1 .. n -2] -- triangles on top face
        ++ concatMap f' [1 .. n -2] -- triangles on bottom face
        -- these should be checked
-        ++ [ 2 * n -2 , 2 * n -1 , 1
-           , 2 * n -2 , 1 , 0 -- last side triangle (applies mod 2n)
+        ++ [ 2 * n -2
+           , 2 * n -1
+           , 1
+           , 2 * n -2
+           , 1
+           , 0 -- last side triangle (applies mod 2n)
           ]
        ++ concatMap g [0 .. n -2] -- other triangles on sides
  where
    f x = [0, 2 * x, 2 * x + 2]
    f' x = [1, 2 * x + 3, 2 * x + 1]
    g x =
-        [ 2 * x , 2 * x + 1 , 2 * x + 3
-        , 2 * x , 2 * x + 3 , 2 * x + 2
+        [ 2 * x
+        , 2 * x + 1
+        , 2 * x + 3
+        , 2 * x
+        , 2 * x + 3
+        , 2 * x + 2
        ]

 -- consider changing the position to a vec4
-- and just doing two pokes rather than seven
-- (especially if adding normal data)
 pokeJustV ::
    Float ->
    Point3 ->
@@ -15,6 +15,7 @@ pokeCloud vptr iptr (nv,ni) cl = do
    return (nv + 4, ni + 6)

 pokeCloudVerx :: Ptr Float -> Cloud -> Int -> Int -> (Float, Float) -> IO ()
+{-# INLINE pokeCloudVerx #-}
 pokeCloudVerx ptr cl nv i (dx, dy) =
    UV.imapM_ (pokeCloudFloat ptr (nv + i)) $ UV.fromList 
        [x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
@@ -26,7 +27,9 @@ pokeCloudVerx ptr cl nv i (dx, dy) =
    a = a' * min 1 (fromIntegral (_clTimer cl) / fadet)

 pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
+{-# INLINE pokeCloudFloat #-}
 pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)

 pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
+{-# INLINE pokeCloudIndex #-}
 pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)