Add destruction to mounted lights

2025-10-26 14:39:33 +00:00
parent c55c3e874d
commit 0adf3f57b4
7 changed files with 64 additions and 70 deletions
@@ -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)
@@ -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 mos w = foldl' (flip destroyMount) w mos
+destroyMounts :: Point2A -> [MountedObject] -> World -> World
+destroyMounts pa mos w = foldl' (flip $ destroyMount pa) w mos

-destroyMount :: MountedObject -> World -> World
-destroyMount mo = case mo of
--    MountedLS lsid -> destroyLS lsid
--    MountedProp prid -> cWorld . lWorld . props . at prid .~ Nothing
-    MountedLight{} -> id -- should make sound + flash
+destroyMount :: Point2A -> MountedObject -> World -> World
+destroyMount pa = \case
+    MountedLight x _ _ -> destroyLSFlashAt $ x & _xy %~ shiftPointBy pa
    MountedSPic{} -> id -- make debris?

 stopPushing :: Maybe Int -> World -> World
@@ -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 lsid w =
-    w
-        & cWorld . lWorld . lightSources . at lsid .~ Nothing
-        & destroyLSFlashAt p3
-        & soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3)
-  where
-    ls = w ^?! cWorld . lWorld . lightSources . ix lsid -- unsafe
-    p3 = _lsPos $ _lsParam ls
+--destroyLS :: Int -> World -> World
+--destroyLS lsid w =
+--    w
+--        & cWorld . lWorld . lightSources . at lsid .~ Nothing
+--        & destroyLSFlashAt p3
+--  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

 destroyLSFlashAt :: Point3 -> World -> World
 destroyLSFlashAt x =
-    cWorld . lWorld . worldEvents .:~ MakeTempLight 
-        (LSParam x 150 1) 20
+    (cWorld . lWorld . worldEvents .:~ MakeTempLightFade 0.05 (LSParam x 150 1) 20)
+        . soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 x)
@@ -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
@@ -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) 
-                (shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
-    themessage = [ "WARNING:" , "LARGE BIOMASS DETECTED" ]
+            & plSpot
+                .~ rprBoolShift
+                    (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 $
-            putDoubleDoorThen
+        $ \btplmnt -> Just
+            . putDoubleDoorThen
                defaultDoorWall
                (WdBlBtOn $ fromJust $ _plMID btplmnt)
                30
                (V2 0 h)
                (V2 x h)
                0.5
-                $ \dr1 dr2 -> 
-                        Just 
-                    $ sps0 $ PutWorldUpdate $ const $ const 
-                    $ (gwWorld . cWorld . lWorld . doors . ix (dr1 ^?! plMID . _Just)
-                        . drMounts .~ 
-                                [MountedSPic (noPic $ aShape (V2 25 0) (V3 25 50 50))
-                                , MountedSPic (noPic $ aShape (V2 25 0) (V3 25 (-50) 50))
-                                , MountedLight (V3 25 (-50) 50) 200 0.5
-                                , MountedLight (V3 25 50 50) 200 0.5
-                                ])
-                    
-                    . (gwWorld . cWorld . lWorld . doors . ix (dr2 ^?! plMID . _Just)
-                        . drMounts .~ 
-                                [MountedSPic (noPic $ aShape (V2 (-25) 0) (V3 (-25) 50 50))
-                             , MountedSPic (noPic $ aShape (V2 (-25) 0) (V3 (-25) (-50) 50))
-                                , 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
+            $ \dr1 dr2 ->
+                Just
+                    . sps0
+                    . PutWorldUpdate
+                    . const
+                    . const
+                    $ domount dr1 id . domount dr2 negate
+    domount drx g =
+        gwWorld . cWorld . lWorld . doors . ix (drx ^?! plMID . _Just)
+            . drMounts
+            .~ [ MountedSPic (noPic $ aBar 50 $ g <$> [V2 lsx 9, V2 lsx ly, lp])
+               , MountedLight (V3 (lx - 1) ly 50 & _xy %~ g) 200 0.5
+               ]
+    lsx = 30
+    lp@(V2 lx ly) = V2 100 (-20)

 slowDoorRoom :: RandomGen g => State g Room
 slowDoorRoom = do
@@ -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)
@@ -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