Various refactoring

2021-08-17 19:08:18 +02:00
parent 807bc908d1
commit 9bdb9a227f
18 changed files with 313 additions and 191 deletions
@@ -0,0 +1,66 @@
+module Dodge.LevelGen.DoorPane
+    ( linearPane
+    , mkDoubleDoor
+    ) where
+import Dodge.Data
+import Dodge.LevelGen.MoveDoor
+import Picture
+import qualified DoubleStack as DS
+import Geometry.Vector
+
+-- | A door pane that moves linearly between open and closed positions using a
+-- boolean trigger.
+linearPane 
+    :: Color 
+    -> Bool             -- ^ Pathable flag
+    -> (World -> Bool)  -- ^ Opening condition
+    -> Int              -- ^ Wall id
+    -> (Point2,Point2)  -- ^ Closed position
+    -> (Point2,Point2)  -- ^ Open position
+    -> Wall
+linearPane c isPathable cond n closedPos openPos = Door
+    { _wlLine = closedPos
+    , _wlID = n
+    , _doorMech = dm
+    , _wlColor = c
+    , _wlSeen = False
+    , _wlIsSeeThrough = False
+    , _doorPathable = isPathable
+    , _drPositions = DS.singleton closedPos
+    }
+  where 
+    dm = doorMechan n (zoneps closedPos) openDoor closeDoor cond 
+    openDoor = moveDoorToward openPos
+    closeDoor = moveDoorToward closedPos
+
+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)
+    is
+    (leftDoor ++ rightDoor)
+    (map shiftLeft leftDoor ++ map shiftRight rightDoor)
+  where 
+    leftDoor = 
+        [ (pld +.+ perp,hwd)
+        , (hwd,         hwu)
+        , (hwu,         plu +.+ perp)
+        , (plu +.+ perp,pld +.+ perp)
+        ]
+    rightDoor =
+        [ (pru -.- perp,hwu)
+        , (hwu,         hwd)
+        , (hwd,         prd -.- perp)
+        , (prd -.- perp,pru -.- perp)
+        ]
+    shiftRight = h (+.+ (0.5 *.* (pr -.- pl)))
+    shiftLeft  = h (+.+ (0.5 *.* (pl -.- pr)))
+    h func (x,y) = (func x,func y)
+    norm = 9 *.* normalizeV ( vNormal (pr -.- pl))
+    hw = 0.5 *.* (pl +.+ pr)
+    perp = 5 *.* normalizeV (pl -.- pr)
+    plu = pl +.+ norm
+    pld = pl -.- norm
+    pru = pr +.+ norm
+    prd = pr -.- norm
+    hwu = hw +.+ norm
+    hwd = hw -.- norm