Half add explicit death event for machines

This commit is contained in:
2022-06-05 10:37:40 +01:00
parent 7398791194
commit fcc6d3952c
9 changed files with 26 additions and 10 deletions
+1
View File
@@ -957,6 +957,7 @@ data Machine = Machine
{ _mcID :: Int { _mcID :: Int
, _mcWallIDs :: IS.IntSet , _mcWallIDs :: IS.IntSet
, _mcUpdate :: Machine -> World -> World , _mcUpdate :: Machine -> World -> World
, _mcDeath :: Machine -> World -> World
, _mcDraw :: Machine -> SPic , _mcDraw :: Machine -> SPic
, _mcPos :: Point2 , _mcPos :: Point2
, _mcDir :: Float , _mcDir :: Float
+1
View File
@@ -208,6 +208,7 @@ defaultMachine = Machine
{ _mcID = 0 { _mcID = 0
, _mcWallIDs = mempty , _mcWallIDs = mempty
, _mcUpdate = defaultMachineUpdate , _mcUpdate = defaultMachineUpdate
, _mcDeath = \_ -> id
, _mcDraw = const mempty , _mcDraw = const mempty
, _mcPos = V2 0 0 , _mcPos = V2 0 0
, _mcDir = 0 , _mcDir = 0
+1
View File
@@ -42,6 +42,7 @@ import System.Random
initialAnoTree :: Tree [Annotation] initialAnoTree :: Tree [Annotation]
initialAnoTree = padSucWithDoors $ treeFromPost initialAnoTree = padSucWithDoors $ treeFromPost
[[AnoApplyInt 0 startRoom] [[AnoApplyInt 0 startRoom]
, [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms]
, [SpecificRoom $ warningRooms 7] , [SpecificRoom $ warningRooms 7]
, [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400 , [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400
& rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
+4
View File
@@ -32,6 +32,10 @@ lockRoomKeyItems =
,(const $ lasTunnelRunPast 400, takeOne [FLATSHIELD,FORCEFIELDGUN]) ,(const $ lasTunnelRunPast 400, takeOne [FLATSHIELD,FORCEFIELDGUN])
,(keyCardRoomRunPast 0, return (KEYCARD 0)) ,(keyCardRoomRunPast 0, return (KEYCARD 0))
] ]
keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ]
keyCardRunPastRand =
[(keyCardRoomRunPast 0, return (KEYCARD 0))
]
itemRooms :: RandomGen g => [(CombineType, State g (LabSubCompTree Room))] itemRooms :: RandomGen g => [(CombineType, State g (LabSubCompTree Room))]
itemRooms = itemRooms =
+7 -6
View File
@@ -5,6 +5,7 @@ module Dodge.Placement.Instance.Terminal
, simpleTermMessage , simpleTermMessage
, genTermMessage , genTermMessage
, topFlushStrings , topFlushStrings
, terminalColor
) where ) where
import Dodge.Data import Dodge.Data
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
@@ -35,14 +36,14 @@ putTerminal' col mcf = ps0PushPS (PutButton termButton)
}) })
$ const Nothing $ const Nothing
putTerminal :: (World -> TerminalParams) -> Placement putTerminal :: Color -> (World -> TerminalParams) -> Placement
putTerminal f = ps0PushPSw PutNothing $ \_ _ -> Just $ putTerminal col f = ps0PushPSw PutNothing $ \_ _ -> Just $
ps0PushPS (PutButton $ termButton & btTerminalParams .~ f) ps0PushPS (PutButton $ termButton & btTerminalParams .~ f)
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine $ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . terminalShape terminalColor { _mcDraw = noPic . terminalShape col
, _mcHP = 100 , _mcHP = 100
, _mcUpdate = machineAddSound fridgeHumS , _mcUpdate = machineAddSound fridgeHumS (\_ -> id)
$ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) , _mcDeath = \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
. makeExplosionAt (_mcPos mc) . makeExplosionAt (_mcPos mc)
}) })
$ const Nothing $ const Nothing
+1 -1
View File
@@ -96,7 +96,7 @@ addButtonSlowDoor x h rm = do
& rmPmnts .++~ [butDoor , theterminal] & rmPmnts .++~ [butDoor , theterminal]
& rmBound .:~ openDoorBound & rmBound .:~ openDoorBound
where where
theterminal = putTerminal (simpleTermMessage themessage) theterminal = putTerminal terminalColor (simpleTermMessage themessage)
& plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10))) & plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
themessage = themessage =
["WARNING:" ["WARNING:"
+1 -1
View File
@@ -83,7 +83,7 @@ sensInsideDoor senseType outplid rm = rm
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
, putTerminal (const $ defaultTermParams & addInputLine [damageCodeCommand,quitCommand] , putTerminal terminalColor (const $ defaultTermParams & addInputLine [damageCodeCommand,quitCommand]
[helpCommand,commandsCommand] [helpCommand,commandsCommand]
) )
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
+1 -1
View File
@@ -52,7 +52,7 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
where where
outplace = extTrigLitPos outplace = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(Just . set plSpot (rprShift moveToSideFirstOutLink) . putTerminal . termMessages) (Just . set plSpot (rprShift moveToSideFirstOutLink) . putTerminal terminalColor . termMessages)
termMessages trid _ = defaultTermParams & addInputLine termMessages trid _ = defaultTermParams & addInputLine
[unlockCommand trid,quitCommand] [unlockCommand trid,quitCommand]
[helpCommand,infoCommand theinfo,commandsCommand] [helpCommand,infoCommand theinfo,commandsCommand]
+9 -1
View File
@@ -8,6 +8,7 @@ import Dodge.Menu
import Dodge.Block import Dodge.Block
import Dodge.Distortion import Dodge.Distortion
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.Wall.Delete
--import Dodge.Menu --import Dodge.Menu
import Dodge.Base import Dodge.Base
import Dodge.Zone import Dodge.Zone
@@ -71,7 +72,7 @@ functionalUpdate cfig w = checkEndGame
. updateGusts . updateGusts
. zoneClouds . zoneClouds
. updateMIM magnets _mgUpdate . updateMIM magnets _mgUpdate
. updateIMl _machines _mcUpdate . updateIMl _machines mcChooseUpdate
. updateIMl _creatures _crUpdate . updateIMl _creatures _crUpdate
-- creatures should be updated early so that crOldPos is set before any position change -- creatures should be updated early so that crOldPos is set before any position change
. over creatures (fmap setOldPos) . over creatures (fmap setOldPos)
@@ -89,6 +90,13 @@ functionalUpdate cfig w = checkEndGame
where where
(x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
mcChooseUpdate :: Machine -> Machine -> World -> World
mcChooseUpdate mc mc'
| _mcHP mc > 0 = _mcUpdate mc mc'
| otherwise = (machines %~ IM.delete (_mcID mc))
. deleteWallIDs (_mcWallIDs mc)
. _mcDeath mc mc'
setOldPos :: Creature -> Creature setOldPos :: Creature -> Creature
setOldPos cr = cr setOldPos cr = cr
& crOldPos .~ _crPos cr & crOldPos .~ _crPos cr