Fix long door bug.

src/Dodge/LevelGen/DoorPane.hs

@@ -1,6 +1,7 @@
 module Dodge.LevelGen.DoorPane
     ( linearPane
     , mkDoubleDoor
+    , mkSingleDoor
     ) where
 import Dodge.Data
 import Dodge.LevelGen.MoveDoor
@@ -33,6 +34,28 @@ linearPane c isPathable cond n closedPos openPos = Door
     openDoor = moveDoorToward openPos
     closeDoor = moveDoorToward closedPos
 
+mkSingleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
+mkSingleDoor c isPathable cond pl hw is 
+    = addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond)
+    is
+    leftDoor
+    (map shiftLeft leftDoor)
+  where 
+    leftDoor = 
+        [ (pld +.+ perp,hwd)
+        , (hwd,         hwu)
+        , (hwu,         plu +.+ perp)
+        , (plu +.+ perp,pld +.+ perp)
+        ]
+    shiftLeft  = h (+.+ (pl -.- hw))
+    h func (x,y) = (func x,func y)
+    norm = 9 *.* normalizeV ( vNormal (hw -.- pl))
+    perp = 5 *.* normalizeV (pl -.- hw)
+    plu = pl +.+ norm
+    pld = pl -.- norm
+    hwu = hw +.+ norm
+    hwd = hw -.- norm
+
 mkDoubleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
 mkDoubleDoor c isPathable cond pl pr is 
     = addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond)