diff --git a/src/Dodge/Data/WorldEffect.hs b/src/Dodge/Data/WorldEffect.hs index 4fb0a0d3d..6e4295ef5 100644 --- a/src/Dodge/Data/WorldEffect.hs +++ b/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) diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 6b4c7af94..4e09421e5 100644 --- a/src/Dodge/DrWdWd.hs +++ b/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 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 diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index e49f3f129..a14b2bf45 100644 --- a/src/Dodge/LightSource.hs +++ b/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 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) diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index 25c9d6dc7..ac17fd5c8 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/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 diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 46fa29d1d..69fe99699 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/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) - (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 diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index e90f9adcf..14aa053a0 100644 --- a/src/Dodge/Save.hs +++ b/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) diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 4e82ecf6d..14ada905b 100644 --- a/src/Dodge/WorldEffect.hs +++ b/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