Stop weapon fire after using up consumables

This commit is contained in:
2022-03-22 11:38:30 +00:00
parent 0d5182e8db
commit 873abea79f
5 changed files with 27 additions and 17 deletions
+1 -1
View File
@@ -169,7 +169,7 @@ testInventory = IM.fromList $ zip [0..]
[ makeTypeCraftNum 9 PIPE [ makeTypeCraftNum 9 PIPE
, incendiaryModule , incendiaryModule
, bounceModule , bounceModule
-- , medkit 50 , medkit 50 & itConsumption . itAmount .~ 3
-- , teleportModule -- , teleportModule
, makeTypeCraftNum 1 LIGHTER , makeTypeCraftNum 1 LIGHTER
, makeTypeCraftNum 15 TUBE , makeTypeCraftNum 15 TUBE
+12 -8
View File
@@ -10,7 +10,7 @@ import Control.Lens
import Data.Maybe import Data.Maybe
useItem :: Creature -> World -> World useItem :: Creature -> World -> World
useItem cr' w = f $ fromMaybe w $ do useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? creatures . ix (_crID cr') cr <- w ^? creatures . ix (_crID cr')
it <- cr ^? crInv . ix (_crInvSel cr) it <- cr ^? crInv . ix (_crInvSel cr)
return $ itemEffect cr it w return $ itemEffect cr it w
@@ -21,17 +21,18 @@ useItem cr' w = f $ fromMaybe w $ do
itemEffect :: Creature -> Item -> World -> World itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^? itUse of itemEffect cr it w = case it ^? itUse of
Just RightUse {_rUse = eff,_useMods = usemods} -> foldr ($) eff usemods it cr w Just RightUse {_rUse = eff,_useMods = usemods}
Just LeftUse {} -> lhammer setEquipLeftItem -> hammerTest $ foldr ($) eff usemods it cr
Just EquipUse{} -> lhammer setEquipment Just LeftUse {} -> setuhamdown $ lhammer setEquipLeftItem
Just EquipUse{} -> setuhamdown $ lhammer setEquipment
-- ConsumeUse will cause problems if the item is not selected -- ConsumeUse will cause problems if the item is not selected
Just (ConsumeUse eff) -> hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr) Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
Just NoUse -> w Just NoUse -> setuhamdown w
Nothing -> w Nothing -> setuhamdown w
where where
hammerTest f = case _youHammerPosition w of hammerTest f = case _youHammerPosition w of
HammerUp -> f w HammerUp -> f w
_ -> w _ -> w & youHammerPosition .~ HammerDown
lhammer f' = w & case _youHammerPosition w of lhammer f' = w & case _youHammerPosition w of
HammerUp -> creatures . ix (_crID cr) %~ f' HammerUp -> creatures . ix (_crID cr) %~ f'
_ -> id _ -> id
@@ -39,6 +40,9 @@ itemEffect cr it w = case it ^? itUse of
Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
_ -> cr' & crLeftInvSel ?~ _crInvSel cr' _ -> cr' & crLeftInvSel ?~ _crInvSel cr'
setEquipment = toggleEquipmentAt (_crInvSel cr) setEquipment = toggleEquipmentAt (_crInvSel cr)
setuhamdown = case _crID cr of
0 -> youHammerPosition .~ HammerDown
_ -> id
toggleEquipmentAt :: Int -> Creature -> Creature toggleEquipmentAt :: Int -> Creature -> Creature
toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f
+1 -1
View File
@@ -42,7 +42,7 @@ initialWorld = defaultWorld
testStringInit :: World -> [String] testStringInit :: World -> [String]
--testStringInit = map (concatMap $ \(_,ct,_,_) -> show ct) . invertListInvMult . yourInv --testStringInit = map (concatMap $ \(_,ct,_,_) -> show ct) . invertListInvMult . yourInv
testStringInit = const [] testStringInit w = [show $ _youHammerPosition w]
-- w = [show $ f $ _roomClipping w] -- w = [show $ f $ _roomClipping w]
-- where -- where
-- f (x:xs) = any (convexPolysOverlap x) xs || f xs -- f (x:xs) = any (convexPolysOverlap x) xs || f xs
+5 -1
View File
@@ -60,7 +60,9 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
(\mc -> buttons . ix btid . btTerminalParams .~ (\mc -> buttons . ix btid . btTerminalParams .~
TerminalParams TerminalParams
{ _termDisplayedLines = [] { _termDisplayedLines = []
, _termFutureLines = map simpleline starts , _termFutureLines =
map simpleline topflush
++ map simpleline starts
++ [testline' (_mcID mc)] ++ [testline' (_mcID mc)]
++ map simpleline afters ++ map simpleline afters
, _termMaxLines = 7 , _termMaxLines = 7
@@ -69,6 +71,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
) )
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
) )
allstrings = sucs : fails : afters ++ starts
topflush = [replicate i ' ' ++ "*" | i <- [0,3 .. maximum (map length allstrings)]]
simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)} simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)}
testline' mcid = TerminalLineDisplay 0 (testline mcid) testline' mcid = TerminalLineDisplay 0 (testline mcid)
testline mcid w = case w ^? machines . ix mcid . mcSensor . sensToggle of testline mcid w = case w ^? machines . ix mcid . mcSensor . sensToggle of
+8 -6
View File
@@ -74,14 +74,16 @@ lightSensByDoor outplid rm = rm
healthAnalyserByDoor :: Int -> Room -> Room healthAnalyserByDoor :: Int -> Room -> Room
healthAnalyserByDoor = analyserByDoor healthAnalyserByDoor = analyserByDoor
[ replicate 20 '-' [ bar
, "HEALTH INTEGRITY CHECK" , hic
, replicate 20 '-' , bar ]
]
"PASSED" "PASSED"
"REQUIRES HEALTH AT LEAST 1100" "REQUIRES HEALTH 1100"
(replicate 3 "") (bar : replicate 2 "")
(machineAddSound fridgeHumS $ testYourHealth 1100) (machineAddSound fridgeHumS $ testYourHealth 1100)
where
hic = "HEALTH INTEGRITY CHECK"
bar = replicate (length hic) '-'
analyserByDoor :: [String] -> String -> String -> [String] analyserByDoor :: [String] -> String -> String -> [String]
-> (Machine -> World -> World) -> Int -> Room -> Room -> (Machine -> World -> World) -> Int -> Room -> Room