Improve rendering of autodoor shadows, have leak though

src/Dodge/LevelGen.hs

@@ -2,14 +2,13 @@
 {-# LANGUAGE FlexibleInstances #-}
 module Dodge.LevelGen 
     ( module Dodge.LevelGen
-    --, module Dodge.LevelGen.StaticWalls
     , cutWalls
     , createInnerWalls
     , checkWalls
     , nubWalls
     )
     where
--- imports {{{
+
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
@@ -36,33 +35,6 @@ import qualified Data.Map as M
 import Data.Graph.Inductive hiding ((&))
 import Data.Graph.Inductive.NodeMap
 import Data.Tree
--- }}}
-
-
---
-
-
---collidePointAllWalls :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap Wall
---collidePointAllWalls p1 p2 walls = IM.filter f walls
---    where f wall
---            = case myIntersectSegSeg p1 p2 (_wlLine wall !! 0) (_wlLine wall !! 1) 
---                of Nothing -> False
---                   _       -> True
---
----- returns walls that collide with lines, and the point of collision
---collidePointAllWallsPoints :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Wall,Point2)
---collidePointAllWallsPoints p1 p2 walls = IM.mapMaybe f walls
---    where f wall
---            = case myIntersectSegSeg p1 p2 (_wlLine wall !! 0) (_wlLine wall !! 1) 
---                of Nothing -> Nothing
---                   Just p  -> Just (wall,p)
---
---collidePointAllWallsPoints' :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Wall,[Point2])
---collidePointAllWallsPoints' p1 p2 walls = IM.mapMaybe f walls
---    where f wall
---            = case myIntersectSegSeg p1 p2 (_wlLine wall !! 0) (_wlLine wall !! 1) 
---                of Nothing -> Nothing
---                   Just p  -> Just (wall,[p])
 
 treeTrunk :: [a] -> Tree a -> Tree a
 treeTrunk [] t     = t
@@ -335,7 +307,6 @@ putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pair
           wWithBlock = addBlock (p:ps) i c b is w
 
 putWindowBlock :: Point2 -> Point2 -> World -> World
---putWindowBlock a b w = foldr makeBlockAt w $ zip ps ns
 putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
     where d = dist a b
           rot = argV (b -.- a)
@@ -444,12 +415,12 @@ mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
                                , [hwu,hwd]
                                , [hwd,prd,pr,hw]
                                ]
-                               [ [plld,pld]
+                               [ [plld,pld,pl,pl]
                                , [pld,plu]
-                               , [plu,pllu]
-                               , [prru,pru]
+                               , [plu,pllu,pl,pl]
+                               , [prru,pru,pr,pr]
                                , [pru,prd]
-                               , [prd,prrd]
+                               , [prd,prrd,pr,pr]
                                ]
     where norm = 10 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
           hw = 0.5 *.* (pl +.+ pr)