Continue work on shadow rendering

2023-03-14 11:20:38 +00:00
parent 9947979b52
commit 6af041bb8c
20 changed files with 418 additions and 381 deletions
@@ -10,7 +10,7 @@ defaultLS =
        , _lsParam =
            LSParam
                { _lsPos = V3 0 0 50
-                , _lsRad = 700
+                , _lsRad = 450
                , _lsCol = 0.6
                }
        , _lsDir = 0
@@ -2,9 +2,7 @@ module Dodge.LightSource (
    tlsTimeRadFunPos,
    tlsTimeRadColPos,
    lsRadCol,
-    lsPosRadCol,
    lsColPosRad,
-    lsPosColRad,
    lsColPos,
    lsPosCol,
    lsPosRad,
@@ -46,27 +44,22 @@ tlsTimeRadFunPos t rmax intensityF p =
 --            & tlsParam . lsCol .~ f (intensityF (_tlsTime tls) )
 --    f x' = V3 x' x' x'

-lsPosColRad :: Point3 -> Point3 -> Float -> LightSource
-lsPosColRad p col = lsColPosRad col p
-
-lsPosRadCol :: Point3 -> Float -> Point3 -> LightSource
-lsPosRadCol p r col =
-    defaultLS
-        & lsParam . lsPos .~ p
-        & lsParam . lsRad .~ r
-        & lsParam . lsCol .~ col
-
 lsColPosID :: Point3 -> Point3 -> Int -> LightSource
 lsColPosID col p i = lsColPos col p & lsID .~ i

 lsColPos :: Point3 -> Point3 -> LightSource
-lsColPos col pos = lsColPosRad col pos 700
+lsColPos col pos = lsColPosRad col pos 450

 lsPosCol :: Point3 -> Point3 -> LightSource
 lsPosCol pos col = lsColPos col pos

 lsColPosRad :: Point3 -> Point3 -> Float -> LightSource
-lsColPosRad col pos r = lsPosRadCol pos r col
+lsColPosRad col p r = 
+    defaultLS
+        & lsParam . lsPos .~ p
+        & lsParam . lsRad .~ r
+        & lsParam . lsCol .~ col
+

 lsRadCol :: Float -> Point3 -> LightSource
 lsRadCol r col =
@@ -114,14 +114,18 @@ doDrawing' win pdata u = do
    glClear $ sum [GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT]
    glDepthFunc GL_LESS
    -- draw wall occlusions from the camera's point of view
-    glUseProgram (pdata ^. lightingWallShadShader . shadProg')
+--    glEnable GL_CULL_FACE
+--    glCullFace GL_BACK
+    glUseProgram (pdata ^. lightingWallShadShader . shadName)
    glUniform3f (pdata ^?! lightingWallShadShader . shadUnis' . ix 0) vfx vfy 20
+    glUniform1f (pdata ^?! lightingWallShadShader . shadUnis' . ix 1) 100
    glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO' . vaoName
    unless (debugOn Remove_LOS cfig) $
        glDrawArrays
            (marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim')
            0
            (fromIntegral nWalls)
+--    glDisable GL_CULL_FACE
    --draw walls onto base buffer
    if cfig ^. graphics_wall_textured
        then renderTextureWalls pdata nWalls
@@ -130,7 +134,7 @@ doDrawing' win pdata u = do
    renderLayer BottomLayer shadV layerCounts
    --draw object shapes onto base buffer
    let fs = _shapeShader pdata
-    glUseProgram (_shadProg' fs)
+    glUseProgram (_shadName fs)
    glBindVertexArray $ fs ^. shadVAO' . vaoName
    glDrawElements
        (marshalEPrimitiveMode $ _shadPrim' fs)
@@ -140,7 +144,6 @@ doDrawing' win pdata u = do
    --draw floor onto base buffer
    drawShader (_textureArrayShader pdata) nFls
    --draw lightmap into its own buffer
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
    createLightMap
        cfig
        pdata
@@ -159,6 +162,11 @@ doDrawing' win pdata u = do
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    drawShader (_fullscreenShader pdata) 4
+    with GL_COLOR_ATTACHMENT0 $ \ptr ->
+        glInvalidateNamedFramebufferData 
+            (pdata ^. fboLighting . _1 . unFBO)
+            1
+            ptr
    --draw bloom onto bloom buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
    glClear GL_COLOR_BUFFER_BIT
@@ -168,21 +176,17 @@ doDrawing' win pdata u = do
    renderLayer BloomNoZWrite shadV layerCounts
    glDepthMask GL_TRUE
    renderLayer BloomLayer shadV layerCounts
-    --glDepthMask GL_TRUE
    --setup downscale viewport for blurring bloom
    setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
-    --bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
-    --textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
-    glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) -- Just (snd $ _fboBloom pdata)
+    glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO)
    glDisable GL_BLEND
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
    glEnable GL_BLEND
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    --draw clouds onto cloud buffer
-    --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthFunc GL_LEQUAL
    glDepthMask GL_FALSE
@@ -191,24 +195,20 @@ doDrawing' win pdata u = do
    --blendColor $= Color4 0.5 0.5 0.5 0.5
    --glBlendFuncSeparate GL_SRC_ALPHASaturate,One) , (One,GL_ONE_MINUS_SRC_ALPHA))
    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
-    --drawBuffers $= [FBOColorAttachment 0, NoBuffers]
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glClear GL_COLOR_BUFFER_BIT
    renderLayer MidLayer shadV layerCounts
-    --renderWindows pdata windowPoints
    drawShader (_windowShader pdata) nWins
    when (_graphics_cloud_shadows cfig) $ do
        ----render transparency depths
        glDepthMask GL_TRUE
        glDisable GL_BLEND
        withArray [GL_NONE, GL_COLOR_ATTACHMENT1] $ \ptr -> glDrawBuffers 2 ptr
-        --drawBuffers $= [NoBuffers, FBOColorAttachment 1]
        renderLayer MidLayer shadV layerCounts
        drawShader (_windowShader pdata) nWins
        ----draw lightmap for cloud buffer
        glDepthMask GL_FALSE
        glEnable GL_BLEND
-        --bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        createLightMap
            cfig
@@ -224,31 +224,24 @@ doDrawing' win pdata u = do
        glClearColor 0 0 0 0
    --apply lightmap to cloud buffer
    glClearColor 0 0 0 0
-    --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthMask GL_FALSE
-    --drawBuffers $= [FBOColorAttachment 0, NoBuffers]
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glDepthFunc GL_ALWAYS
-    --textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
    glEnable GL_BLEND
-    --glBlendFunc GL_ZERO, GL_ONE_MINUS_SRC_ALPHA)
    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
-    --bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    --Draw blurred bloom onto base buffer
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE
-    --textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    --draw shadowed clouds onto base buffer
-    --textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
    drawShader (_fullscreenShader pdata) 4
    --set viewport for radial distortion
@@ -260,7 +253,6 @@ doDrawing' win pdata u = do
        [] -> do
            bindTO $ fst $ snd $ _fboBase pdata
            glBindFramebuffer GL_FRAMEBUFFER 0
-            --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
            drawShader (_fullscreenShader pdata) 4
        rds -> do
            let bindDrawDist :: Distortion -> IO ()
@@ -270,14 +262,11 @@ doDrawing' win pdata u = do
                    drawShader (_barrelShader pdata) 1
                fboList =
                    take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
-                        -- ++ [defaultFramebufferObject]
                        ++ [FBO 0]
                toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
                bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
            glActiveTexture GL_TEXTURE1
-            --activeTexture $= TextureUnit 1
            zipWithM_ (>>) bindings $ map bindDrawDist rds
-            --activeTexture $= TextureUnit 0
            glActiveTexture GL_TEXTURE1
    glDepthFunc GL_ALWAYS
    glEnable GL_BLEND
@@ -288,7 +277,6 @@ doDrawing' win pdata u = do
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-    --bufferUBO (pdata ^. matUBO) $ isoMatrix 0 1 (V2 0 0) (V2 2 2)
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. isoMatUBO)
    renderLayer FixedCoordLayer shadV layerCounts
    renderFoldable shadV $ fixedCoordPictures u
@@ -303,9 +291,6 @@ doDrawing' win pdata u = do
            )
    SDL.glSwapWindow win

--    eTicks <- SDL.ticks
--    return (eTicks - sTicks)
-
 fpsText :: (Show a, Ord a, Num a) => a -> Picture
 fpsText x = color col $ text $ "ms/frame " ++ show x
  where
@@ -26,7 +26,7 @@ drawCPUShadows pdata s pos rad = do
        0
        (fromIntegral $ floatSize * i)
        (theshad ^. shadVAO' . vaoVBO . vboPtr)
-    glUseProgram (theshad ^. shadProg')
+    glUseProgram (theshad ^. shadName)
    glBindVertexArray . _vaoName $ _shadVAO' theshad
    glDrawArrays
        (marshalEPrimitiveMode $ _shadPrim' theshad)
@@ -126,7 +126,7 @@ rezColor = do
    col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
    h <- takeOne [30, 50, 80, 90, 90, 90, 90]
    rad <- takeOne [150, 200, 200, 250, 250, 300, 300, 300]
-    return $ lsPosColRad (V3 0 0 h) col rad
+    return $ lsColPosRad col (V3 0 0 h) rad

 rezInvBox :: LightSource -> Room
 rezInvBox = swapInOutLinks . rezBox
@@ -26,7 +26,7 @@ roomCritLS = do
    col <- takeOne [0.5, 0.6]
    h <- takeOne [30, 35]
    rad <- takeOne [300]
-    return $ lsPosColRad (V3 0 0 h) col rad
+    return $ lsColPosRad col (V3 0 0 h) rad

 smallRoom :: Room
 smallRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15, 25) (30, 45) (pi, 2 * pi)]
@@ -1,31 +1,38 @@
 {-# LANGUAGE BangPatterns #-}
+
 --{-# LANGUAGE TupleSections #-}
 {- Testing for and finding intersection points.  -}
 module Geometry.Intersect where
-import Geometry.Data
-import Geometry.Vector
-import Geometry.LHS
-import Control.Applicative

+import Control.Applicative
 import Data.List
 import Data.Maybe
+import Geometry.Data
+import Geometry.LHS
+import Geometry.Vector
+
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectLineLine' #-}
 intersectLineLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
    | den == 0 = Nothing
-    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
-  where 
-    den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
-    t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
+    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+  where
+    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+
 intersectSegSegErrorTest :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegSegErrorTest #-}
 intersectSegSegErrorTest a b c d = case intersectSegSeg a b c d of
-    Nothing | intersectSegSegFullTest a b c d -> 
-            error $ "intersectSegSeg did not intersect"++show a ++ show b ++ show c++ show d
-    Just x | not $ intersectSegSegFullTest a b c d -> 
-            error $ "intersectSegSeg did intersect"++show a ++ show b ++ show c++ show d
-                ++ " at " ++ show x
+    Nothing
+        | intersectSegSegFullTest a b c d ->
+            error $ "intersectSegSeg did not intersect" ++ show a ++ show b ++ show c ++ show d
+    Just x
+        | not $ intersectSegSegFullTest a b c d ->
+            error $
+                "intersectSegSeg did intersect" ++ show a ++ show b ++ show c ++ show d
+                    ++ " at "
+                    ++ show x
    m -> m

 -- | If two segments intersect, return 'Just' that point.
@@ -34,146 +41,166 @@ intersectSegSeg :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 intersectSegSeg (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
    | V2 x1 y1 == V2 x2 y2 || V2 x3 y3 == V2 x4 y4 = Nothing
    | den == 0 = Nothing
-    | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
-        = Nothing
-    | den < 0 && (t' > 0 || u' > 0 || t' < den || u' < den)
-        = Nothing
-    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
-  where 
-    den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
-    t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
-    u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
-- | Intended to intersect a segment with a half-line-segment, ie a segment
-- extending infinitely in one direction.
+    | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den) =
+        Nothing
+    | den < 0 && (t' > 0 || u' > 0 || t' < den || u' < den) =
+        Nothing
+    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+  where
+    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+    u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
+
+{- | Intended to intersect a segment with a half-line-segment, ie a segment
+ extending infinitely in one direction.
+-}
 intersectSegLineFrom :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineFrom #-}
 intersectSegLineFrom (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
    | den == 0 = Nothing
-    | den > 0 && ( t' < 0 || u' < 0 || t' > den )
-        = Nothing
-    | den < 0 && ( t' > 0 || u' > 0 || t' < den )
-        = Nothing
-    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
-  where 
-    den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
-    t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
-    u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+    | den > 0 && (t' < 0 || u' < 0 || t' > den) =
+        Nothing
+    | den < 0 && (t' > 0 || u' > 0 || t' < den) =
+        Nothing
+    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+  where
+    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+    u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
+
 -- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
 intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineext #-}
 intersectSegLineext (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
    | den == 0 = Nothing
-    | den > 0 && ( t' < 0 || u' < den || t' > den )
-        = Nothing
-    | den < 0 && ( t' > 0 || u' > - den || t' < den )
-        = Nothing
-    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
-  where 
-    den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
-    t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
-    u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+    | den > 0 && (t' < 0 || u' < den || t' > den) =
+        Nothing
+    | den < 0 && (t' > 0 || u' > - den || t' < den) =
+        Nothing
+    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+  where
+    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+    u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
+
 -- | Intersect a segment with a line.
 intersectSegLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLine #-}
 intersectSegLine (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
    | den == 0 = Nothing
-    | den > 0 && (t' < 0 || t' > den)
-        = Nothing
-    | den < 0 && (t' > 0 || t' < den)
-        = Nothing
-    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) ( y1 + (y2-y1)*t'/den)
-  where 
-    den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
-    t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
-    --u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+    | den > 0 && (t' < 0 || t' > den) =
+        Nothing
+    | den < 0 && (t' > 0 || t' < den) =
+        Nothing
+    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+  where
+    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+
+--u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+
 -- | A test that should align with Just values from intersectSegSeg.
-intersectSegSegFullTest
-    :: Point2
-    -> Point2
-    -> Point2
-    -> Point2
-    -> Bool
+intersectSegSegFullTest ::
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Bool
 {-# INLINE intersectSegSegFullTest #-}
-intersectSegSegFullTest x y z w
-    = f x y z w && f z w x y && x /= y && z /= w 
+intersectSegSegFullTest x y z w =
+    f x y z w && f z w x y && x /= y && z /= w
        && normalizeV (x -.- y) /= normalizeV (z -.- w)
        && normalizeV (y -.- x) /= normalizeV (z -.- w)
  where
-    f a b c d =  ( not (isRHS a b c) && not (isLHS a b d) ) 
-              || ( not (isLHS a b c) && not (isRHS a b d) )
-- | It is not always necessary to find a point of intersection, sometimes a
-- test may suffice.
-intersectSegSegTest
-    :: Point2
-    -> Point2
-    -> Point2
-    -> Point2
-    -> Bool
+    f a b c d =
+        (not (isRHS a b c) && not (isLHS a b d))
+            || (not (isLHS a b c) && not (isRHS a b d))
+
+{- | It is not always necessary to find a point of intersection, sometimes a
+ test may suffice.
+-}
+intersectSegSegTest ::
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Bool
 {-# INLINE intersectSegSegTest #-}
-intersectSegSegTest x y z w
-    = f x y z w && f z w x y && x /= y && z /= w
+intersectSegSegTest x y z w =
+    f x y z w && f z w x y && x /= y && z /= w
  where
-    f a b c d =  ( not (isRHS a b c) && not (isLHS a b d) ) 
-              || ( not (isLHS a b c) && not (isRHS a b d) )
-intersectSegSegPreTest
-    :: Point2
-    -> Point2
-    -> Point2
-    -> Point2
-    -> Maybe Point2
+    f a b c d =
+        (not (isRHS a b c) && not (isLHS a b d))
+            || (not (isLHS a b c) && not (isRHS a b d))
+
+intersectSegSegPreTest ::
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Maybe Point2
 {-# INLINE intersectSegSegPreTest #-}
 intersectSegSegPreTest a b c d
    | intersectSegSegTest a b c d = myIntersectSegSeg a b c d
    | otherwise = Nothing
-- | Due to floating point issues, 'intersectSegSeg'' is not always 
-- accurate---'myIntersectSegSeg'
-- fixes at least some of
-- the problem cases by transforming the points into rationals and then doing the
-- intersection.
-- This version is, probably, slower---both testing and benchmarking should be
-- done.
-myIntersectSegSeg 
-    :: Point2
-    -> Point2
-    -> Point2
-    -> Point2
-    -> Maybe Point2
+
+{- | Due to floating point issues, 'intersectSegSeg'' is not always
+ accurate---'myIntersectSegSeg'
+ fixes at least some of
+ the problem cases by transforming the points into rationals and then doing the
+ intersection.
+ This version is, probably, slower---both testing and benchmarking should be
+ done.
+-}
+myIntersectSegSeg ::
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Point2 ->
+    Maybe Point2
 {-# INLINE myIntersectSegSeg #-}
 myIntersectSegSeg a@(V2 ax ay) b@(V2 bx by) c@(V2 cx cy) d@(V2 dx dy) = case ratIntersectLineLine a b c d of
-    Nothing    -> Nothing
-    Just (V2 x y) -> if inbetween x && inbetween' y 
-        then Just (V2 x y)
-        else Nothing
-  where 
-    inbetween  x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) 
-        &&  ((cx <= x && x <= dx) || (dx <= x && x <= cx))
-    inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) 
-        &&  ((cy <= y && y <= dy) || (dy <= y && y <= cy))
+    Nothing -> Nothing
+    Just (V2 x y) ->
+        if inbetween x && inbetween' y
+            then Just (V2 x y)
+            else Nothing
+  where
+    inbetween x =
+        ((ax <= x && x <= bx) || (bx <= x && x <= ax))
+            && ((cx <= x && x <= dx) || (dx <= x && x <= cx))
+    inbetween' y =
+        ((ay <= y && y <= by) || (by <= y && y <= ay))
+            && ((cy <= y && y <= dy) || (dy <= y && y <= cy))
+
 -- | Polymorphic intersection of fractional line points.
-myIntersectLineLine :: (Eq a,Fractional a) => V2 a -> V2 a -> V2 a -> V2 a -> Maybe (V2 a)
+myIntersectLineLine :: (Eq a, Fractional a) => V2 a -> V2 a -> V2 a -> V2 a -> Maybe (V2 a)
 {-# INLINE myIntersectLineLine #-}
 myIntersectLineLine a@(V2 ax _) b c@(V2 cx _) d
    | isNothing (linGrad a b) = V2 ax <$> axisInt (c *-* V2 ax 0) (d *-* V2 ax 0)
    | isNothing (linGrad c d) = V2 cx <$> axisInt (a *-* V2 cx 0) (b *-* V2 cx 0)
-    | otherwise              
-        = case linGrad a b ^-^ linGrad c d of
+    | otherwise =
+        case linGrad a b ^-^ linGrad c d of
            Just 0 -> Nothing
-            _      -> liftA2 V2 newx ((linGrad a b ^*^ newx) ^+^ axisInt a b)
-  where 
+            _ -> liftA2 V2 newx ((linGrad a b ^*^ newx) ^+^ axisInt a b)
+  where
    (^-^) = liftA2 (-)
    (^+^) = liftA2 (+)
    (^/^) = liftA2 (/)
    (^*^) = liftA2 (*)
-    newx  = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
-    (*-*) (V2 ax' ay) (V2 bx by) = V2 (ax'-bx) (ay-by)
+    newx = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
+    (*-*) (V2 ax' ay) (V2 bx by) = V2 (ax' - bx) (ay - by)
+
 -- | Transforms floating points to rationals then performs line intersection.
 ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE ratIntersectLineLine #-}
-ratIntersectLineLine a b c d = toNumPoint2 
-    <$> myIntersectLineLine (toRatPoint2 a) (toRatPoint2 b) (toRatPoint2 c) (toRatPoint2 d)
-  where 
-    toRatPoint2 (V2 x y) = V2 (toRational x)  (toRational y)
-    toNumPoint2 (V2 x y) = V2 (fromRational x)  (fromRational y)
+ratIntersectLineLine a b c d =
+    toNumPoint2
+        <$> myIntersectLineLine (toRatPoint2 a) (toRatPoint2 b) (toRatPoint2 c) (toRatPoint2 d)
+  where
+    toRatPoint2 (V2 x y) = V2 (toRational x) (toRational y)
+    toNumPoint2 (V2 x y) = V2 (fromRational x) (fromRational y)
+
 {- | Round the floats within a 'Point2' to the nearest integer.
 __Examples__
 Rounding jumps after intervals of .5:
@@ -188,66 +215,83 @@ but is symmetric around 0:
 -}
 roundPoint2 :: Point2 -> Point2
 roundPoint2 (V2 x y) = V2 (fromIntegral (round x :: Int)) (fromIntegral (round y :: Int))
+
 -- | Given two points, finds the linear gradient if it is non-infinite.
-linGrad :: (Eq a,Fractional a) => V2 a -> V2 a -> Maybe a
+linGrad :: (Eq a, Fractional a) => V2 a -> V2 a -> Maybe a
 {-# INLINE linGrad #-}
-linGrad (V2 x y) (V2 a b) 
-    | x-a == 0  = Nothing
-    | otherwise = Just $ (y-b)/(x-a)
+linGrad (V2 x y) (V2 a b)
+    | x - a == 0 = Nothing
+    | otherwise = Just $ (y - b) / (x - a)
+
 -- | Given two points, finds the intersection with the y axis if it exists.
-axisInt :: (Eq a,Fractional a) => V2 a -> V2 a -> Maybe a
+axisInt :: (Eq a, Fractional a) => V2 a -> V2 a -> Maybe a
 {-# INLINE axisInt #-}
-axisInt p (V2 a b) = (\lg -> b - (a*lg)) <$> linGrad p (V2 a b)
+axisInt p (V2 a b) = (\lg -> b - (a * lg)) <$> linGrad p (V2 a b)
+
 -- | Placeholder, undefined.
 intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
 intersectSegsSeg = undefined
+
 -- | Placeholder: should intersect a segment with a bezier curve.
 intersectSegBezquad :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 -> [Point2]
 intersectSegBezquad = undefined

-- | finds one (if any) of the points of intersection between a segment and a
-- polygon.
-- Can almost certainly be optimised.
+{- | finds one (if any) of the points of intersection between a segment and a
+ polygon.
+ Can almost certainly be optimised.
+-}
 intersectSegPolyFirst :: Point2 -> Point2 -> [Point2] -> Maybe Point2
 intersectSegPolyFirst a b xs = foldr (<|>) Nothing $ zipWith lineColl xs (tail xs ++ [head xs])
  where
    lineColl = intersectSegSeg a b

-- | Given a line and a point return the point on the line closest to the
-- point.
-closestPointOnLine 
-    :: Point2 -- ^ First line point. 
-    -> Point2 -- ^ Second line point.
-    -> Point2 -- ^ Point not on line.
-    -> Point2
+{- | Given a line and a point return the point on the line closest to the
+ point.
+-}
+closestPointOnLine ::
+    -- | First line point.
+    Point2 ->
+    -- | Second line point.
+    Point2 ->
+    -- | Point not on line.
+    Point2 ->
+    Point2
 {-# INLINE closestPointOnLine #-}
-closestPointOnLine !a  !b  !p  = a +.+ u *.* (b -.- a)
-  where u = closestPointOnLineParam a b p
-- | Given a line and a point return a value corresponding to how far along the
-- line the point is.
-closestPointOnLineParam 
-    :: Point2   -- ^ First line point. 
-    -> Point2   -- ^ Second line point.
-    -> Point2   -- ^ Point not on line.
-    -> Float
-{-# INLINE closestPointOnLineParam #-}
-closestPointOnLineParam !a !b !p
-    = (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
+closestPointOnLine !a !b !p = a +.+ u *.* (b -.- a)
+  where
+    u = closestPointOnLineParam a b p

-- | Given a segment and external point, find the closest point on the segment.
-- clamps to the end of the segment
+{- | Given a line and a point return a value corresponding to how far along the
+ line the point is.
+-}
+closestPointOnLineParam ::
+    -- | First line point.
+    Point2 ->
+    -- | Second line point.
+    Point2 ->
+    -- | Point not on line.
+    Point2 ->
+    Float
+{-# INLINE closestPointOnLineParam #-}
+closestPointOnLineParam !a !b !p =
+    (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
+
+{- | Given a segment and external point, find the closest point on the segment.
+ clamps to the end of the segment
+-}
 closestPointOnSeg :: Point2 -> Point2 -> Point2 -> Point2
 closestPointOnSeg segP1 segP2 p
    | closestPointOnLineParam segP1 segP2 p <= 0 = segP1
    | closestPointOnLineParam segP1 segP2 p >= 1 = segP2
-    | otherwise                                  = closestPointOnLine segP1 segP2 p
+    | otherwise = closestPointOnLine segP1 segP2 p

-- | Given a segment and external point, find the closest point on the segment.
-- does not return closest points beyond the segment
+{- | Given a segment and external point, find the closest point on the segment.
+ does not return closest points beyond the segment
+-}
 orthogonalPointOnSeg :: Point2 -> Point2 -> Point2 -> Maybe Point2
 orthogonalPointOnSeg a b p
    | param < 0 || param > 1 = Nothing
-    | otherwise              = Just $ a +.+ param *.* normalizeV (b -.- a)
+    | otherwise = Just $ a +.+ param *.* normalizeV (b -.- a)
  where
    param = closestPointOnLineParam a b p

@@ -257,9 +301,9 @@ inSegArea a b c = param >= 0 && param <= dotV (b -.- a) (b -.- a)
    param = dotV (b -.- a) (c -.- a)

 intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
-intersectCircSeg c r a b 
+intersectCircSeg c r a b
    | y < 0 = []
-    | otherwise = nub $ filter (inSegArea a b) [ d -.- v, d +.+ v ]
+    | otherwise = nub $ filter (inSegArea a b) [d -.- v, d +.+ v]
  where
    d = closestPointOnLine a b c
    x = dist d c
@@ -24,6 +24,8 @@ import SDL
 import System.Mem
 import Data.Foldable

+-- the following can break if passed a window config not set up for opengl
+ 
 -- | Create a game loop with an SDL window.
 setupLoop ::
    -- | Target seconds per frame
@@ -131,7 +131,7 @@ preloadRender = do
    -- lighting shaders
    lightingWallShadShad <-
        makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] EPoints wpVAO
-            >>= addUniforms ["lightPos"]
+            >>= addUniforms ["lightPos","rad"]
    lightingCapShad <-
        makeShaderUsingVAO "lighting/cap" [vert, geom] ETriangles shPosVAO
            >>= addUniforms ["lightPos"]
@@ -50,6 +50,7 @@ createLightMap ::
 createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos drawCPUShadows = case shadsdrawtype of
    InstancingShads -> instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos
    NoShadows -> do
+        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        let ltextShad = _lightingTextureShader pdata
        -- we assume that the renderbuffer's depth has been correctly set elsewhere
        -- we will not be changing that here
@@ -64,10 +65,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
        -- to consider: adding normals/a "material" for each fragment
        glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
        glEnable GL_STENCIL_TEST
-        --stencilTest $= Enabled
        glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP
-        --stencilOpSeparate Front $= (OpKeep, OpKeep, OpIncrWrap)
-        --stencilOpSeparate Back $= (OpKeep, OpKeep, OpDecrWrap)
        glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP
        flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
            glDepthFunc GL_LESS
@@ -75,7 +73,6 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
            glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
            glClear GL_STENCIL_BUFFER_BIT
            glDisable GL_CULL_FACE
-            --cullFace $= Nothing
            glStencilFunc GL_ALWAYS 0 255
            --draw lightmap itself
            glDepthFunc GL_ALWAYS
@@ -83,7 +80,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
            bindTO toPos
            glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
            glStencilFunc GL_EQUAL 0 255
-            glUseProgram (ltextShad ^. shadProg') --Just (_shadProg ltextShad)
+            glUseProgram (ltextShad ^. shadName) --Just (_shadProg ltextShad)
            glUniform3f (_shadUnis' ltextShad V.! 0) x y z
            glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad
            --bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad)
@@ -107,6 +104,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
        glDepthFunc GL_ALWAYS
        glDepthMask GL_FALSE
    _ -> do
+        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        let llinesShad = _lightingLineShadowShader pdata
            lcapShad = _lightingCapShader pdata
            lwallShad = _lightingWallShadShader pdata
@@ -124,10 +122,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
        -- to consider: adding normals/a "material" for each fragment
        glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
        glEnable GL_STENCIL_TEST
-        --stencilTest $= Enabled
        glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP
-        --stencilOpSeparate Front $= (OpKeep, OpKeep, OpIncrWrap)
-        --stencilOpSeparate Back $= (OpKeep, OpKeep, OpDecrWrap)
        glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP
        flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
            glDepthFunc GL_LESS
@@ -135,15 +130,11 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
            glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
            glClear GL_STENCIL_BUFFER_BIT
            glDisable GL_CULL_FACE
-            --cullFace $= Nothing
            glStencilFunc GL_ALWAYS 0 255
            --draw wall shadows
-            --currentProgram $= Just (_shadProg lwallShad)
-            glUseProgram (_shadProg' lwallShad)
-            --uniform (_shadUnis lwallShad V.! 0)
-            --    $= Vector3 x y z
+            glUseProgram (_shadName lwallShad)
            glUniform3f (_shadUnis' lwallShad V.! 0) x y z
-            --bindVertexArrayObject $= lwallShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
+            glUniform1f (_shadUnis' lwallShad V.! 1) rad
            glBindVertexArray $ lwallShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
            glDrawArrays
                (marshalEPrimitiveMode $ _shadPrim' lwallShad)
@@ -152,7 +143,8 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
            case shadsdrawtype of
                GeoObjShads -> do
                    --draw silhouette shadows
-                    glUseProgram (_shadProg' llinesShad)
+                    glEnable GL_DEPTH_CLAMP
+                    glUseProgram (_shadName llinesShad)
                    glUniform3f (_shadUnis' llinesShad V.! 0) x y z
                    glUniform1f (_shadUnis' llinesShad V.! 1) rad
                    glBindVertexArray (_vaoName $ _shadVAO' llinesShad)
@@ -164,7 +156,8 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
                    --draw caps on the near plane as required
                    glEnable GL_CULL_FACE
                    glCullFace GL_BACK
-                    glUseProgram (_shadProg' lcapShad)
+                    glCullFace GL_FRONT
+                    glUseProgram (_shadName lcapShad)
                    glUniform3f (_shadUnis' lcapShad V.! 0) x y z
                    glBindVertexArray $ lcapShad ^. shadVAO' . vaoName --Just (_vao $ _shadVAO lcapShad)
                    glDrawElements
@@ -172,15 +165,17 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
                        (fromIntegral nCaps)
                        GL_UNSIGNED_SHORT
                        nullPtr
+                    glDisable GL_DEPTH_CLAMP
                CPUObjShads -> drawCPUShadows (V3 x y z) rad
                NoObjShads -> return ()
            --draw lightmap itself
            glDepthFunc GL_ALWAYS
            -- bind world position texture
+            glDisable GL_CULL_FACE
            bindTO toPos
            glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
            glStencilFunc GL_EQUAL 0 255
-            glUseProgram (ltextShad ^. shadProg') --Just (_shadProg ltextShad)
+            glUseProgram (ltextShad ^. shadName) --Just (_shadProg ltextShad)
            glUniform3f (_shadUnis' ltextShad V.! 0) x y z
            glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad
            --bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad)
@@ -190,7 +185,6 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra
                0
                (fromIntegral (4 :: Int))
        --cleanup: may not be necessary, depending on what comes after...
-        glDisable GL_CULL_FACE
        glDisable GL_STENCIL_TEST

 lightsToArray :: [(Point3, Float, Point3)] -> [Float]
@@ -252,14 +246,14 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
    glDisable GL_CULL_FACE
    glStencilFunc GL_ALWAYS 0 255
    --draw wall shadows
-    glUseProgram $ pdata ^. shadowWallShader . shadProg'
-    glBindVertexArray $ pdata ^. shadowWallShader . shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
+    glUseProgram $ pdata ^. shadowWallShader . shadName
+    glBindVertexArray $ pdata ^. shadowWallShader . shadVAO' . vaoName
    glDrawArrays
        (marshalEPrimitiveMode $ pdata ^. shadowWallShader . shadPrim')
        0
        (fromIntegral nWalls)
    --draw silhouette shadows
-    glUseProgram $ pdata ^. shadowEdgeShader . shadProg'
+    glUseProgram $ pdata ^. shadowEdgeShader . shadName
    glBindVertexArray $ pdata ^. shadowEdgeShader . shadVAO' . vaoName
    glDrawElements
        (marshalEPrimitiveMode $ pdata ^. shadowEdgeShader . shadPrim')
@@ -267,9 +261,10 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
        GL_UNSIGNED_SHORT
        nullPtr
    --draw caps on the near plane as required
-    glEnable GL_CULL_FACE
+    --glEnable GL_CULL_FACE
    glCullFace GL_BACK
-    glUseProgram (_shadProg' lcapShad)
+    --glCullFace GL_FRONT
+    glUseProgram (_shadName lcapShad)
    glBindVertexArray $ lcapShad ^. shadVAO' . vaoName
    glDrawElements
        (marshalEPrimitiveMode $ _shadPrim' lcapShad)
@@ -280,15 +275,14 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
    glDepthFunc GL_ALWAYS
    glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
    glStencilFunc GL_EQUAL 0 255
-    glUseProgram (pdata ^. shadowLightShader . shadProg')
+    glUseProgram (pdata ^. shadowLightShader . shadName)
    -- bind world position texture
    bindTO toPos
-    glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName
+--    glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName
    glDrawArrays
        (marshalEPrimitiveMode $ pdata ^. shadowLightShader . shadPrim')
        0
        1
-    -- this was the end of the loop
    glDisable GL_CULL_FACE
    glDisable GL_STENCIL_TEST
    --draw to the lighting framebuffer here
@@ -298,7 +292,7 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
    glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO)
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
-    glUseProgram (pdata ^. shadowCombineShader . shadProg') --Just (_shadProg ltextShad)
+    glUseProgram (pdata ^. shadowCombineShader . shadName)
    glDrawArrays
        (marshalEPrimitiveMode EPoints)
        0
@@ -26,7 +26,7 @@ drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> I
 drawShaderLay l countsVector shadIn fs = do 
    i <- UMV.read countsVector shadIn
    --currentProgram $= Just (_shadProg' fs)
-    glUseProgram (_shadProg' fs)
+    glUseProgram (_shadName fs)
    glBindVertexArray $ fs ^. shadVAO' . vaoName
    --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs)
    case _shadTex' fs of 
@@ -44,7 +44,7 @@ drawShader :: FullShader -> Int -> IO ()
 {-# INLINE drawShader #-}
 drawShader fs i = do 
    --currentProgram $= Just (_shadProg fs)
-    glUseProgram (_shadProg' fs)
+    glUseProgram (_shadName fs)
    glBindVertexArray $ fs ^. shadVAO' . vaoName
    --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs)
    case _shadTex' fs of 
@@ -91,5 +91,5 @@ addUniforms uniStrings shad = do foldM addUniform shad uniStrings

 addUniform :: FullShader -> String -> IO FullShader
 addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
-    loc <- glGetUniformLocation (_shadProg' shad) cstr
+    loc <- glGetUniformLocation (_shadName shad) cstr
    return $ shad & shadUnis' %~ (V.++ V.fromList [loc])
@@ -35,7 +35,7 @@ makeShader s shaderlist sizes pm = do
    vaob <- setupVAO sizes
    return $
        FullShader
-            { _shadProg' = prog
+            { _shadName = prog
            , _shadVAO' = vaob
            , _shadPrim' = pm
            , _shadTex' = Nothing
@@ -54,7 +54,7 @@ makeByteStringShaderUsingVAO s shaderlist pm vao = do
    prog <- makeShaderProgram s shaderlist
    return $
        FullShader
-            { _shadProg' = prog
+            { _shadName = prog
            , _shadVAO' = vao
            , _shadPrim' = pm
            , _shadTex' = Nothing
@@ -74,7 +74,7 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
    prog <- makeSourcedShader s shaderlist
    return $
        FullShader
-            { _shadProg' = prog
+            { _shadName = prog
            , _shadVAO' = theVAO
            , _shadPrim' = pm
            , _shadTex' = Nothing
@@ -101,7 +101,7 @@ makeShaderSized s shaderlist sizes ndraw pm = do
    vaob <- setupVAOSized ndraw sizes
    return $
        FullShader
-            { _shadProg' = prog
+            { _shadName = prog
            , _shadVAO' = vaob
            , _shadPrim' = pm
            , _shadTex' = Nothing
@@ -19,7 +19,7 @@ module Shader.Data
    , eboName
    , eboPtr

-    , shadProg'
+    , shadName
    , shadVAO'
    , shadPrim'
    , shadTex'
@@ -35,7 +35,7 @@ import Foreign
 import Control.Lens
 {- | Datatype containing the necessary information for a single shader.  -}
 data FullShader = FullShader
-    { _shadProg' :: GLuint -- should be shaderID
+    { _shadName :: GLuint -- should be shaderID
    , _shadVAO'  :: VAO
    , _shadPrim' :: EPrimitiveMode
    , _shadTex'  :: Maybe ShaderTexture