Fix autodoor wall rendering

src/Dodge/Data.hs

@@ -553,7 +553,6 @@ data Wall
         , _wlDraw :: Maybe (Wall -> Drawing)
         , _wlSeen :: Bool
         , _wlIsSeeThrough :: Bool
-        , _wlCastShadow :: Bool
         }
     | Door 
         { _wlLine :: [Point2] , _wlID :: Int 

src/Dodge/LevelGen/AutoDoor.hs

@@ -24,15 +24,15 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
           is = [i..]
 
 mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
-mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
+mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
                                xs
-                               [ True
-                               , False
-                               , True
-                               , True
-                               , False
-                               , True
-                               ]
+--                               [ True
+--                               , False
+--                               , True
+--                               , True
+--                               , False
+--                               , True
+--                               ]
                                [ [pld,hwd,hw,pl]
                                , [hwd,hwu]
                                , [hwu,plu,pl,hw]
@@ -68,24 +68,8 @@ mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
                  | otherwise = dm w
             where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
 
-drawAutoDoor :: Wall -> Drawing
-drawAutoDoor wl = onLayerL [levLayer WlLayer, layer2] 
-        $ pictures [color c $ polygon [x,x +.+ n2,y +.+ n2, y]
-                   ,color (dark c) $ line [x,y]
-                   ]
-    where 
-        (x:y:_) = _wlLine wl
-        c = _wlColor wl
-        nm = errorNormalizeV 543 (y -.- x)
-        t = 5 *.* nm
-        n = vNormal t
-        n2 = 3 *.* n
-        layer2 | _wlIsSeeThrough wl = 0
-               | isJust $ wl ^? doorMech = 1
-               | otherwise = 2
-
-autoDoorPane :: [Point2] -> Int -> Bool -> [Point2] -> [Point2] -> Wall
-autoDoorPane trigL n castShad closedPos openPos = AutoDoor
+autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall
+autoDoorPane trigL n closedPos openPos = AutoDoor
     { _wlLine = closedPos
     , _wlID = n
     , _doorMech = dm
@@ -93,7 +77,6 @@ autoDoorPane trigL n castShad closedPos openPos = AutoDoor
     , _wlDraw = Nothing
     , _wlSeen = False
     , _wlIsSeeThrough = False
-    , _wlCastShadow = castShad
     }
     where 
         a = closedPos !! 0

src/Dodge/Prototypes.hs

@@ -35,7 +35,6 @@ basicAutoDoor = AutoDoor { _wlLine = [(0,0),(50,0)]
                    , _wlDraw = Nothing
                    , _wlSeen = False
                    , _wlIsSeeThrough = False
-                   , _wlCastShadow = True
                    }
 basicDoor = Door { _wlLine = [(0,0),(50,0)]
                    , _wlID = 0

src/Picture/Preload.hs

@@ -7,15 +7,13 @@ module Picture.Preload
     where
 
 import Picture.Data
+import Shader
+import Geometry (Point2,Point3,Point4)
 
 import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
 
 import Control.Lens
-
 import Foreign
-import Shader
-
-import Geometry (Point2,Point3,Point4)
 
 import qualified Control.Foldl as F
 
@@ -34,7 +32,6 @@ makeLenses ''RenderData
 
 preloadRender :: IO RenderData
 preloadRender = do
--- compile shader programs
 -- lighting shaders
     lsShad <- makeShader "lighting/lightmapCircle" [vert,geom,frag] [(0,4)] Points 
                     (return . return . flat4)
@@ -63,17 +60,16 @@ preloadRender = do
                                        ,[[ 1,-1],[1,0]]
                                        ]
                                  )
-    n <- F.foldM (pokeShader fsShad) [()]
+    n <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
 
 -- background shader
     bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
                                 "data/texture/smudgedDirt.png"
--- input a list of (attribute location, attrib length) pairs
--- these will have buffers and pointers created
-    backgroundvao <- setupVAO [(0,4),(1,2)]
 
+-- framebuffer for lighting
     (fbo,fboTO) <- setupFramebuffer
 
+-- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
     
     return $ RenderData
@@ -119,6 +115,7 @@ cleanUpRenderPreload pd = do
     freeShaderPointers $ _lightSourceShader pd
     freeShaderPointers $ _wallShadowShader pd
     freeShaderPointers $ _backgroundShader pd
+    freeShaderPointers $ _fullscreenShader pd
 
 {-# INLINE pokeBezQStrat #-}
 pokeBezQStrat :: RenderType -> [[[Float]]]
@@ -144,9 +141,6 @@ pokeLineStrat _ = []
 pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
 pokeEllStrat _ = []
 
-bufferOffset :: Integral a => a -> Ptr b
-bufferOffset = plusPtr nullPtr . fromIntegral
-
 vert = VertexShader
 geom = GeometryShader
 frag = FragmentShader
@@ -154,9 +148,6 @@ frag = FragmentShader
 pokeWPStrat :: (Point2,Point2) -> [[[Float]]]
 pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]
 
-pokeLightWallStrat :: Point3 -> [[[Float]]]
-pokeLightWallStrat (x,y,z) = [[[x,y,z]]]
-
 pokeBGStrat :: a -> [[[Float]]]
 pokeBGStrat = const []