From fb065aeac90ce0766a3f74b84c34547cd087da77 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 11 Jun 2016 01:34:07 +0200 Subject: trigger effects on taking damage --- src/Main.hs | 53 ++++++++++++++++++++++++++++++++-- src/Sequence/Contact/Archetypes.hs | 1 + src/Sequence/Contact/Types.hs | 1 + src/Sequence/Contact/Types/Internal.hs | 5 ++-- src/Sequence/Formula.hs | 4 +++ src/Sequence/Types.hs | 4 +-- src/Sequence/Utils.hs | 2 +- 7 files changed, 62 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index e239bec..de97603 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -252,7 +252,54 @@ addNote :: String -> Sh GameState () addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState () -takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> gEntities . ix focusId . eStats . sDamage . ix zone += dmg - +takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> do + let + lStats :: Traversal' GameState Stats + lStats = gEntities . ix focusId . eStats + lStats . sDamage . ix zone += dmg + name <- toName focusId + void . runMaybeT $ do + cripple <- MaybeT . preuse $ lStats . sCripple . ix zone + let evalF formula = do + stats <- MaybeT $ preuse lStats + (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula + lStats .= nStats + return x + cVar cLens = evalF =<< MaybeT (preuse $ lStats . (cripple ^. cLens)) + bar <- cVar seBar + val <- cVar seVal + reBar <- cVar seReBar + if cripple ^. seApplied + then guard $ dmg >= reBar + else guard $ val >= bar + (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ cripple ^. seEffect) + lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect) + lift $ shellPutStrLn effectName + lift . addNote $ "Effect: " ++ effectName + takeFatigue :: Int -> Sh GameState () -takeFatigue dmg = withFocus $ \focusId -> gEntities . ix focusId . eStats . sFatigue += dmg +takeFatigue dmg = withFocus $ \focusId -> do + let + lStats :: Traversal' GameState Stats + lStats = gEntities . ix focusId . eStats + gEntities . ix focusId . eStats . sFatigue += dmg + name <- toName focusId + void . runMaybeT $ do + fShock <- MaybeT . preuse $ lStats . sFatigueShock + let evalF formula = do + stats <- MaybeT $ preuse lStats + (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula + lStats .= nStats + return x + fVar cLens = evalF =<< MaybeT (preuse $ lStats . (fShock ^. cLens)) + bar <- fVar seBar + val <- fVar seVal + reBar <- fVar seReBar + if fShock ^. seApplied + then guard $ dmg >= reBar + else guard $ val >= bar + (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ fShock ^. seEffect) + lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect) + lift $ shellPutStrLn effectName + lift . addNote $ "Effect: " ++ effectName + diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs index 30aa2b6..1ad26bb 100644 --- a/src/Sequence/Contact/Archetypes.hs +++ b/src/Sequence/Contact/Archetypes.hs @@ -110,6 +110,7 @@ human = Humanoid , _sCripple = fromJust . flip Map.lookup [ ("Kopf", def & set seVal (sDamage' "Kopf" . to return) & set seBar (sMaxVitality . mapping (scaled 0.5)) + & set seReBar (sMaxVitality . mapping (scaled 0.2)) & set seEffect (cTable [ (1, 10, Effect "Tod" headshot) , (11, 25, effect "Blind") , (26, 35, effect "Blind, Rechts") diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs index 47687b7..9854d92 100644 --- a/src/Sequence/Contact/Types.hs +++ b/src/Sequence/Contact/Types.hs @@ -107,6 +107,7 @@ instance Default ShockEffect where def = ShockEffect { _seApplied = False , _seVal = ignored , _seBar = ignored + , _seReBar = ignored , _seEffect = def } diff --git a/src/Sequence/Contact/Types/Internal.hs b/src/Sequence/Contact/Types/Internal.hs index e4a2eef..0fe6266 100644 --- a/src/Sequence/Contact/Types/Internal.hs +++ b/src/Sequence/Contact/Types/Internal.hs @@ -55,8 +55,9 @@ data SeqVal = SeqVal data ShockEffect = ShockEffect { _seApplied :: Bool - , _seVal :: Getting (First (Formula Stats)) Stats (Formula Stats) - , _seBar :: Getting (First (Formula Stats)) Stats (Formula Stats) + , _seVal + , _seBar + , _seReBar :: Getting (First (Formula Stats)) Stats (Formula Stats) , _seEffect :: Table Effect } diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs index ca945f8..4f2e61b 100644 --- a/src/Sequence/Formula.hs +++ b/src/Sequence/Formula.hs @@ -28,6 +28,7 @@ import Data.Bool import Data.List import Data.Maybe import Data.Either +import Data.Tuple import Data.Set (Set) import qualified Data.Set as Set @@ -109,6 +110,9 @@ evalFormula = evalFormula' [] Left q@(Question{..}) -> askQuestion promptPref input q >>= flip (flip evalFormula' promptPref $ bool (pure . set (ctx' . answer) $ throwError q) mempty keepResult ++ finalChanges) formula Right result -> return (foldr ($) input finalChanges, result) +evalFormula' :: (MonadIO m, sInput :<: lInput, MonadState lInput m) => String -> FormulaM sInput a -> m a +evalFormula' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (evalFormula promptPref) formula =<< get + val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input val answer prompt keepResult = do gets (Set.member prompt) >>= bool (modify $ Set.insert prompt) (modify (Set.delete prompt) >> throwError Question{..}) diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs index 6594f78..59397d5 100644 --- a/src/Sequence/Types.hs +++ b/src/Sequence/Types.hs @@ -78,8 +78,8 @@ instance Default Entity where eSeqVal :: Lens' Entity (Maybe SeqVal) eSeqVal = eStats . sSequence -instance (Entity :<: a) => Stats :<: a where - ctx' = ctx' . eStats +instance Stats :<: Entity where + ctx' = eStats newtype EntityName = EntityName { _entityName :: CI String } deriving (Show, Eq, Ord) diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs index bbd1477..8b205ea 100644 --- a/src/Sequence/Utils.hs +++ b/src/Sequence/Utils.hs @@ -112,5 +112,5 @@ instance Argument (Set Hitzone) GameState where ws = Set.fromList . map CI.mk . filter (not . null) . map trim . split $ protoWs hasGlob = Set.member "*" ws hitzones <- Set.map (view _Hitzone) . Map.keysSet <$> MaybeT (preuse $ gFocus' . eStats . sHitzones) - guard (hasGlob || hitzones `Set.isSubsetOf` ws) + guard (hasGlob || ws `Set.isSubsetOf` hitzones) return . Set.map (review _Hitzone) $ if hasGlob then hitzones else ws -- cgit v1.2.3