From 0c5fe56414a323f49d7b086c0a64a216443a22bb Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 13 Jun 2016 20:03:24 +0200 Subject: action log --- src/Main.hs | 28 +++++++++++++++++++++------- src/Sequence/Contact/Archetypes.hs | 2 +- src/Sequence/Types.hs | 7 ++++++- 3 files changed, 28 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index e93d725..3e6b750 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -23,6 +23,9 @@ import qualified Data.Map.Strict as Map import Data.Set (Set) import qualified Data.Set as Set +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq + import Data.Bimap (Bimap) import qualified Data.Bimap as Bimap @@ -33,6 +36,8 @@ import Data.Maybe import Data.Bool import Data.Monoid (All(..)) +import Data.Foldable (toList) + import Data.Function import Control.Monad.State.Strict @@ -91,10 +96,11 @@ main = do , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" , cmd "combat'" factionSeqVal "Roll sequence values for all members of a faction and have them enter combat" , cmd "spend" spendSeq "Spend some of the current focus´ AP" - , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest" + , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest and focus that one" , cmd "note" addNote "Add a note to the current focus" , cmd "hit" takeHit "Damage the focused entity" , cmd "fatigue" takeFatigue "Inflict fatigue damage upon the focused entity" + , cmd "log" dumpLog "Print the combat log" ] , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '*'] } @@ -291,19 +297,21 @@ entitySeqVal' ident = void . runMaybeT $ do & set seqEpsilon (entity ^. eStats . sSeqEpsilon) gEntities . at ident .= Just (newEntity & set eSeqVal val) -spendSeq :: Int -> Sh GameState () -spendSeq n = withFocus $ \focusId -> do +spendSeq :: Int -> String -> Sh GameState () +spendSeq n logStr = withFocus $ \focusId -> do gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just -= n + gLog <>= pure (focusId, logStr) delay :: Sh GameState () -delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId) +delay = withFocus $ fmap (\_ -> ()) . runMaybeT . delay' where delay' focusId = do - tipId <- MaybeT $ preuse tip + tipId <- MaybeT . preuse $ priorityQueue . folding (fmap snd . listToMaybe . filter (\(_, i) -> i /= focusId)) tipSeq <- MaybeT . preuse $ gEntities . ix tipId . eStats . sSequence . _Just . seqVal . _Just focusSeq <- MaybeT . preuse $ gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just - guard $ focusSeq > tipSeq - lift . spendSeq $ focusSeq - tipSeq + guard $ focusSeq >= tipSeq + tipName <- toName tipId + lift $ spendSeq (focusSeq - tipSeq) ("Wait for " ++ tipName) addNote :: String -> Sh GameState () addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) @@ -359,3 +367,9 @@ takeFatigue :: Int -> Sh GameState () takeFatigue dmg = withFocus $ \focusId -> do gEntities . ix focusId . eStats . sFatigue += dmg doShock dmg sFatigueShock + +dumpLog :: Sh GameState () +dumpLog = use gLog >>= mapMOf (each . _1) toName >>= shellPutStrLn . toTable + where + toTable :: Seq (String, String) -> String + toTable (map (rowG . toListOf both) . toList -> table) = layoutTableToString table (Just (["Entity", "String"], [def, def])) [def, def] unicodeBoldHeaderS diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs index 626104b..1bf2b7e 100644 --- a/src/Sequence/Contact/Archetypes.hs +++ b/src/Sequence/Contact/Archetypes.hs @@ -50,7 +50,7 @@ archetypes = [ ("Mensch", human) cTable :: Ord v => [(Integer, Integer, v)] -> Table v cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100)) -death :: Hitzone -> FormulaM Stats (Maybe Stats) +death :: Hitzone -> Effect death zone = Effect "Tod" . runMaybeT $ do maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift currentDmg <- MaybeT . preview $ ctx . sDamage' zone diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs index 4aa55d3..b5f6b4b 100644 --- a/src/Sequence/Types.hs +++ b/src/Sequence/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, ViewPatterns, OverloadedStrings, TemplateHaskell, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} module Sequence.Types - ( GameState, gEntities, gEntityNames, gFocus, gNextId' + ( GameState, gEntities, gEntityNames, gFocus, gNextId', gLog , Faction, faction, faction' , Entity(..), eFaction, eSeqVal, eStats, eNotes , EntityName(..), entityName @@ -20,6 +20,9 @@ import qualified Data.CaseInsensitive as CI import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq + import Data.Bimap (Bimap) import qualified Data.Bimap as Bimap @@ -102,6 +105,7 @@ data GameState = GameState , _gEntityNames :: Bimap EntityIdentifier EntityName , _gFocus :: Maybe EntityIdentifier , _gNextId :: EntityIdentifier + , _gLog :: Seq (EntityIdentifier, String) } makeLenses ''GameState @@ -111,6 +115,7 @@ instance Default GameState where , _gEntityNames = Bimap.empty , _gFocus = Nothing , _gNextId = toEnum 0 + , _gLog = Seq.empty } inhabitedFactions :: Getter GameState [Faction] -- cgit v1.2.3