Half add explicit death event for machines
This commit is contained in:
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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 =
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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:"
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user