Add destruction to mounted lights

src/Dodge/Data/WorldEffect.hs

@@ -30,6 +30,7 @@ data WdWd
     | WdWdNegateTrig Int
 --    | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
     | MakeTempLight LSParam Int
+    | MakeTempLightFade Float LSParam Int
     | UseInvItem Int Int -- invid presstime
     | WdWdBurstFireRepetition Int (NewInt InvInt)
     --deriving (Eq, Show, Read) --, Generic)

src/Dodge/DrWdWd.hs

@@ -2,6 +2,7 @@
 
 module Dodge.DrWdWd (updateDoor) where
 
+import Dodge.LightSource
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
@@ -9,7 +10,6 @@ import qualified Data.Set as S
 import Dodge.Block.Debris
 import Dodge.Data.World
 import Dodge.Door.DoorLerp
---import Dodge.LightSource
 import Dodge.ShiftPoint
 import Dodge.SoundLogic
 import Dodge.Wall.Delete
@@ -82,21 +82,20 @@ destroyDoor dr w =
         --        & muchWlDustAt awl (0.5 * uncurry (+) (_drPos dr))
         --        & flip (foldl' (flip $ muchWlDustAt awl)) (map (pos +.+) ps)
         & stopPushing (_drPushes dr)
-        & destroyMounts (_drMounts dr)
+        & (destroyMounts pa) (_drMounts dr)
     )
   where
+    pa = doDoorLerp dr (dr ^. drLerp)
     is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
-    ps = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr (dr ^. drLerp))
+    ps = (dr ^. drFootPrint) & each . each %~ shiftPointBy pa
     wlids = IM.keysSet $ _drFootPrint dr
 
-destroyMounts :: [MountedObject] -> World -> World
+destroyMounts :: Point2A -> [MountedObject] -> World -> World
-destroyMounts mos w = foldl' (flip destroyMount) w mos
+destroyMounts pa mos w = foldl' (flip $ destroyMount pa) w mos
 
-destroyMount :: MountedObject -> World -> World
+destroyMount :: Point2A -> MountedObject -> World -> World
-destroyMount mo = case mo of
+destroyMount pa = \case
---    MountedLS lsid -> destroyLS lsid
+    MountedLight x _ _ -> destroyLSFlashAt $ x & _xy %~ shiftPointBy pa
---    MountedProp prid -> cWorld . lWorld . props . at prid .~ Nothing
-    MountedLight{} -> id -- should make sound + flash
     MountedSPic{} -> id -- make debris?
 
 stopPushing :: Maybe Int -> World -> World

src/Dodge/LightSource.hs

@@ -4,7 +4,8 @@ module Dodge.LightSource (
     lsPosCol,
     lsPosRad,
     lsColPosID,
-    destroyLS,
+--    destroyLS,
+    destroyLSFlashAt,
 ) where
 
 import Dodge.Data.World
@@ -29,17 +30,18 @@ lsPosCol pos col = lsColPos col pos
 lsColPosRad :: Point3 -> Point3 -> Float -> LightSource
 lsColPosRad col p r = LS 0 $ LSParam p r col
 
-destroyLS :: Int -> World -> World
+--destroyLS :: Int -> World -> World
-destroyLS lsid w =
+--destroyLS lsid w =
-    w
+--    w
-        & cWorld . lWorld . lightSources . at lsid .~ Nothing
+--        & cWorld . lWorld . lightSources . at lsid .~ Nothing
-        & destroyLSFlashAt p3
+--        & destroyLSFlashAt p3
-        & soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3)
+--  where
-  where
+--    --        & soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3)
-    ls = w ^?! cWorld . lWorld . lightSources . ix lsid -- unsafe
+--
-    p3 = _lsPos $ _lsParam ls
+--    ls = w ^?! cWorld . lWorld . lightSources . ix lsid -- unsafe
+--    p3 = _lsPos $ _lsParam ls
 
 destroyLSFlashAt :: Point3 -> World -> World
 destroyLSFlashAt x =
-    cWorld . lWorld . worldEvents .:~ MakeTempLight 
+    (cWorld . lWorld . worldEvents .:~ MakeTempLightFade 0.05 (LSParam x 150 1) 20)
-        (LSParam x 150 1) 20
+        . soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 x)

src/Dodge/Placement/Instance/LightSource.hs

@@ -1,6 +1,8 @@
 module Dodge.Placement.Instance.LightSource (
     mntLSOn,
     aShape,
+    aBar,
+    lShape,
     mntLightLnkCond,
     mntLS,
     vShape,
@@ -93,6 +95,9 @@ lShape wp (V3 x y z) =
     wallposUp = wp +.+ n
     turnpos = V2 x y +.+ n
 
+aBar :: Float -> [Point2] -> Shape
+aBar h ps = foldMap (uncurry $ thinHighBar (h+0.1)) $ zip ps $ tail ps
+
 jShape :: Point2 -> Point3 -> Shape
 jShape wallpos (V3 x y z) =
     thinHighBar z wallposUp turn1

src/Dodge/Room/LongDoor.hs

@@ -1,13 +1,9 @@
 {-# LANGUAGE TupleSections #-}
+
 -- | Rooms containing long doors, probably with a big reveal behind them.
 module Dodge.Room.LongDoor where
 
-import ShapePicture
-import Linear
-import Dodge.Door.PutSlideDoor
-import Dodge.Default.Wall
 import Control.Monad
-import Dodge.LevelGen.Switch
 import Data.Maybe
 import qualified Data.Set as S
 import Dodge.Cleat
@@ -15,7 +11,10 @@ import Dodge.Creature
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Room
+import Dodge.Default.Wall
+import Dodge.Door.PutSlideDoor
 import Dodge.LevelGen.PlacementHelper
+import Dodge.LevelGen.Switch
 import Dodge.LightSource
 import Dodge.Placement.Instance
 import Dodge.PlacementSpot
@@ -27,8 +26,10 @@ import Dodge.Terminal
 import Dodge.Tree
 import Geometry
 import LensHelp
+import Linear
 import Picture
 import RandomHelp
+import ShapePicture
 
 twinSlowDoorRoom ::
     -- | Half width
@@ -104,58 +105,38 @@ addButtonSlowDoor x h rm = do
     f g y = g $ y ^. _1 . _y
     theterminal =
         putMessageTerminal terminalColor (simpleTermMessage themessage)
-            & plSpot .~ rprBoolShift (isUnusedLnkType InLink) 
+            & plSpot
-                (shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
+                .~ rprBoolShift
-    themessage = [ "WARNING:" , "LARGE BIOMASS DETECTED" ]
+                    (isUnusedLnkType InLink)
+                    (shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
+    themessage = ["WARNING:", "LARGE BIOMASS DETECTED"]
     openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3 * x / 2) (- x / 2)
---    amountedlight dr xoff mpl = Just
---        . moveLSThen
---            (WdP2fDoorPosition (fromJust $ _plMID dr))
---            (V3 15 xoff 89)
---            (aShape (V2 15 0) (V3 15 xoff 90))
---        $ \plls plpr ->
---            Just $
---                ptCont (PutWorldUpdate (const $ const $ over gwWorld $ setmount dr plls plpr)) $
---                    const mpl
---    setmount pldr plls plpr =
---        cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
---            <>~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
     butDoor = putLitButOnPos
-         (dim $ light red)
+        (dim $ light red)
         (rprBool (isUnusedLnkType InLink))
-        $ \btplmnt -> Just $
+        $ \btplmnt -> Just
-            putDoubleDoorThen
+            . putDoubleDoorThen
                 defaultDoorWall
                 (WdBlBtOn $ fromJust $ _plMID btplmnt)
                 30
                 (V2 0 h)
                 (V2 x h)
                 0.5
-                $ \dr1 dr2 -> 
+            $ \dr1 dr2 ->
-                        Just 
+                Just
-                    $ sps0 $ PutWorldUpdate $ const $ const 
+                    . sps0
-                    $ (gwWorld . cWorld . lWorld . doors . ix (dr1 ^?! plMID . _Just)
+                    . PutWorldUpdate
-                        . drMounts .~ 
+                    . const
-                                [MountedSPic (noPic $ aShape (V2 25 0) (V3 25 50 50))
+                    . const
-                                , MountedSPic (noPic $ aShape (V2 25 0) (V3 25 (-50) 50))
+                    $ domount dr1 id . domount dr2 negate
-                                , MountedLight (V3 25 (-50) 50) 200 0.5
+    domount drx g =
-                                , MountedLight (V3 25 50 50) 200 0.5
+        gwWorld . cWorld . lWorld . doors . ix (drx ^?! plMID . _Just)
-                                ])
+            . drMounts
-                    
+            .~ [ MountedSPic (noPic $ aBar 50 $ g <$> [V2 lsx 9, V2 lsx ly, lp])
-                    . (gwWorld . cWorld . lWorld . doors . ix (dr2 ^?! plMID . _Just)
+               , MountedLight (V3 (lx - 1) ly 50 & _xy %~ g) 200 0.5
-                        . drMounts .~ 
+               ]
-                                [MountedSPic (noPic $ aShape (V2 (-25) 0) (V3 (-25) 50 50))
+    lsx = 30
-                             , MountedSPic (noPic $ aShape (V2 (-25) 0) (V3 (-25) (-50) 50))
+    lp@(V2 lx ly) = V2 100 (-20)
-                                , MountedLight (V3 (-25) (-50) 50) 200 0.5
-                                , MountedLight (V3 (-25) 50 50) 200 0.5
-                                ])
---                    amountedlight dr1 50 $
---                        amountedlight dr1 (-50) $
---                            amountedlight dr2 50 $
---                                amountedlight
---                                    dr2
---                                    (-50)
---                                    Nothing
 
 slowDoorRoom :: RandomGen g => State g Room
 slowDoorRoom = do

src/Dodge/Save.hs

@@ -39,6 +39,7 @@ writeSaveSlot ss u = do
     createDirectoryIfMissing True "generated/saves"
     BS.writeFile (saveSlotPath ss) $ encode (u ^. uvWorld . cWorld)
     --AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
+    putStrLn "Saved"
     return Just
 
 readSaveSlot :: SaveSlot -> IO (Universe -> Maybe Universe)

src/Dodge/WorldEffect.hs

@@ -44,6 +44,11 @@ doWdWd we = case we of
     MakeTempLight x t ->
         (cWorld . lWorld . lights .:~ x)
             . (cWorld . lWorld . worldEvents .:~ MakeTempLight x (t -1))
+    MakeTempLightFade _ _ 0 -> id
+    MakeTempLightFade y x t ->
+        (cWorld . lWorld . lights .:~ x)
+            . (cWorld . lWorld . worldEvents 
+                .:~ MakeTempLightFade y (x&lsCol . each -~ y) (t -1))
     UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w)
     WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
         cr <- w ^? cWorld . lWorld . creatures . ix cid