summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs53
1 files changed, 50 insertions, 3 deletions
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 ()
252addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) 252addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :)
253 253
254takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState () 254takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState ()
255takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> gEntities . ix focusId . eStats . sDamage . ix zone += dmg 255takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> do
256 256 let
257 lStats :: Traversal' GameState Stats
258 lStats = gEntities . ix focusId . eStats
259 lStats . sDamage . ix zone += dmg
260 name <- toName focusId
261 void . runMaybeT $ do
262 cripple <- MaybeT . preuse $ lStats . sCripple . ix zone
263 let evalF formula = do
264 stats <- MaybeT $ preuse lStats
265 (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula
266 lStats .= nStats
267 return x
268 cVar cLens = evalF =<< MaybeT (preuse $ lStats . (cripple ^. cLens))
269 bar <- cVar seBar
270 val <- cVar seVal
271 reBar <- cVar seReBar
272 if cripple ^. seApplied
273 then guard $ dmg >= reBar
274 else guard $ val >= bar
275 (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ cripple ^. seEffect)
276 lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
277 lift $ shellPutStrLn effectName
278 lift . addNote $ "Effect: " ++ effectName
279
257takeFatigue :: Int -> Sh GameState () 280takeFatigue :: Int -> Sh GameState ()
258takeFatigue dmg = withFocus $ \focusId -> gEntities . ix focusId . eStats . sFatigue += dmg 281takeFatigue dmg = withFocus $ \focusId -> do
282 let
283 lStats :: Traversal' GameState Stats
284 lStats = gEntities . ix focusId . eStats
285 gEntities . ix focusId . eStats . sFatigue += dmg
286 name <- toName focusId
287 void . runMaybeT $ do
288 fShock <- MaybeT . preuse $ lStats . sFatigueShock
289 let evalF formula = do
290 stats <- MaybeT $ preuse lStats
291 (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula
292 lStats .= nStats
293 return x
294 fVar cLens = evalF =<< MaybeT (preuse $ lStats . (fShock ^. cLens))
295 bar <- fVar seBar
296 val <- fVar seVal
297 reBar <- fVar seReBar
298 if fShock ^. seApplied
299 then guard $ dmg >= reBar
300 else guard $ val >= bar
301 (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ fShock ^. seEffect)
302 lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
303 lift $ shellPutStrLn effectName
304 lift . addNote $ "Effect: " ++ effectName
305