diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-13 20:03:24 +0200 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-13 20:03:24 +0200 |
| commit | 0c5fe56414a323f49d7b086c0a64a216443a22bb (patch) | |
| tree | eb0fee8a463e09bc2dada338de5f42c5bbb3f552 | |
| parent | 1ca2b48b49d559158cda4feffa145bdfded2c1c2 (diff) | |
| download | 2017-01-16_17:13:37-0c5fe56414a323f49d7b086c0a64a216443a22bb.tar 2017-01-16_17:13:37-0c5fe56414a323f49d7b086c0a64a216443a22bb.tar.gz 2017-01-16_17:13:37-0c5fe56414a323f49d7b086c0a64a216443a22bb.tar.bz2 2017-01-16_17:13:37-0c5fe56414a323f49d7b086c0a64a216443a22bb.tar.xz 2017-01-16_17:13:37-0c5fe56414a323f49d7b086c0a64a216443a22bb.zip | |
action log
| -rw-r--r-- | src/Main.hs | 28 | ||||
| -rw-r--r-- | src/Sequence/Contact/Archetypes.hs | 2 | ||||
| -rw-r--r-- | src/Sequence/Types.hs | 7 |
3 files changed, 28 insertions, 9 deletions
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 | |||
| 23 | import Data.Set (Set) | 23 | import Data.Set (Set) |
| 24 | import qualified Data.Set as Set | 24 | import qualified Data.Set as Set |
| 25 | 25 | ||
| 26 | import Data.Sequence (Seq) | ||
| 27 | import qualified Data.Sequence as Seq | ||
| 28 | |||
| 26 | import Data.Bimap (Bimap) | 29 | import Data.Bimap (Bimap) |
| 27 | import qualified Data.Bimap as Bimap | 30 | import qualified Data.Bimap as Bimap |
| 28 | 31 | ||
| @@ -33,6 +36,8 @@ import Data.Maybe | |||
| 33 | import Data.Bool | 36 | import Data.Bool |
| 34 | import Data.Monoid (All(..)) | 37 | import Data.Monoid (All(..)) |
| 35 | 38 | ||
| 39 | import Data.Foldable (toList) | ||
| 40 | |||
| 36 | import Data.Function | 41 | import Data.Function |
| 37 | 42 | ||
| 38 | import Control.Monad.State.Strict | 43 | import Control.Monad.State.Strict |
| @@ -91,10 +96,11 @@ main = do | |||
| 91 | , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" | 96 | , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" |
| 92 | , cmd "combat'" factionSeqVal "Roll sequence values for all members of a faction and have them enter combat" | 97 | , cmd "combat'" factionSeqVal "Roll sequence values for all members of a faction and have them enter combat" |
| 93 | , cmd "spend" spendSeq "Spend some of the current focus´ AP" | 98 | , cmd "spend" spendSeq "Spend some of the current focus´ AP" |
| 94 | , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest" | 99 | , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest and focus that one" |
| 95 | , cmd "note" addNote "Add a note to the current focus" | 100 | , cmd "note" addNote "Add a note to the current focus" |
| 96 | , cmd "hit" takeHit "Damage the focused entity" | 101 | , cmd "hit" takeHit "Damage the focused entity" |
| 97 | , cmd "fatigue" takeFatigue "Inflict fatigue damage upon the focused entity" | 102 | , cmd "fatigue" takeFatigue "Inflict fatigue damage upon the focused entity" |
| 103 | , cmd "log" dumpLog "Print the combat log" | ||
| 98 | ] | 104 | ] |
| 99 | , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '*'] | 105 | , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '*'] |
| 100 | } | 106 | } |
| @@ -291,19 +297,21 @@ entitySeqVal' ident = void . runMaybeT $ do | |||
| 291 | & set seqEpsilon (entity ^. eStats . sSeqEpsilon) | 297 | & set seqEpsilon (entity ^. eStats . sSeqEpsilon) |
| 292 | gEntities . at ident .= Just (newEntity & set eSeqVal val) | 298 | gEntities . at ident .= Just (newEntity & set eSeqVal val) |
| 293 | 299 | ||
| 294 | spendSeq :: Int -> Sh GameState () | 300 | spendSeq :: Int -> String -> Sh GameState () |
| 295 | spendSeq n = withFocus $ \focusId -> do | 301 | spendSeq n logStr = withFocus $ \focusId -> do |
| 296 | gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just -= n | 302 | gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just -= n |
| 303 | gLog <>= pure (focusId, logStr) | ||
| 297 | 304 | ||
| 298 | delay :: Sh GameState () | 305 | delay :: Sh GameState () |
| 299 | delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId) | 306 | delay = withFocus $ fmap (\_ -> ()) . runMaybeT . delay' |
| 300 | where | 307 | where |
| 301 | delay' focusId = do | 308 | delay' focusId = do |
| 302 | tipId <- MaybeT $ preuse tip | 309 | tipId <- MaybeT . preuse $ priorityQueue . folding (fmap snd . listToMaybe . filter (\(_, i) -> i /= focusId)) |
| 303 | tipSeq <- MaybeT . preuse $ gEntities . ix tipId . eStats . sSequence . _Just . seqVal . _Just | 310 | tipSeq <- MaybeT . preuse $ gEntities . ix tipId . eStats . sSequence . _Just . seqVal . _Just |
| 304 | focusSeq <- MaybeT . preuse $ gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just | 311 | focusSeq <- MaybeT . preuse $ gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just |
| 305 | guard $ focusSeq > tipSeq | 312 | guard $ focusSeq >= tipSeq |
| 306 | lift . spendSeq $ focusSeq - tipSeq | 313 | tipName <- toName tipId |
| 314 | lift $ spendSeq (focusSeq - tipSeq) ("Wait for " ++ tipName) | ||
| 307 | 315 | ||
| 308 | addNote :: String -> Sh GameState () | 316 | addNote :: String -> Sh GameState () |
| 309 | addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) | 317 | addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) |
| @@ -359,3 +367,9 @@ takeFatigue :: Int -> Sh GameState () | |||
| 359 | takeFatigue dmg = withFocus $ \focusId -> do | 367 | takeFatigue dmg = withFocus $ \focusId -> do |
| 360 | gEntities . ix focusId . eStats . sFatigue += dmg | 368 | gEntities . ix focusId . eStats . sFatigue += dmg |
| 361 | doShock dmg sFatigueShock | 369 | doShock dmg sFatigueShock |
| 370 | |||
| 371 | dumpLog :: Sh GameState () | ||
| 372 | dumpLog = use gLog >>= mapMOf (each . _1) toName >>= shellPutStrLn . toTable | ||
| 373 | where | ||
| 374 | toTable :: Seq (String, String) -> String | ||
| 375 | 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) | |||
| 50 | cTable :: Ord v => [(Integer, Integer, v)] -> Table v | 50 | cTable :: Ord v => [(Integer, Integer, v)] -> Table v |
| 51 | cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100)) | 51 | cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100)) |
| 52 | 52 | ||
| 53 | death :: Hitzone -> FormulaM Stats (Maybe Stats) | 53 | death :: Hitzone -> Effect |
| 54 | death zone = Effect "Tod" . runMaybeT $ do | 54 | death zone = Effect "Tod" . runMaybeT $ do |
| 55 | maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift | 55 | maxVitality <- (MaybeT . preview $ ctx . sMaxVitality) >>= lift |
| 56 | currentDmg <- MaybeT . preview $ ctx . sDamage' zone | 56 | 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 @@ | |||
| 1 | {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, ViewPatterns, OverloadedStrings, TemplateHaskell, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} | 1 | {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, ViewPatterns, OverloadedStrings, TemplateHaskell, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} |
| 2 | 2 | ||
| 3 | module Sequence.Types | 3 | module Sequence.Types |
| 4 | ( GameState, gEntities, gEntityNames, gFocus, gNextId' | 4 | ( GameState, gEntities, gEntityNames, gFocus, gNextId', gLog |
| 5 | , Faction, faction, faction' | 5 | , Faction, faction, faction' |
| 6 | , Entity(..), eFaction, eSeqVal, eStats, eNotes | 6 | , Entity(..), eFaction, eSeqVal, eStats, eNotes |
| 7 | , EntityName(..), entityName | 7 | , EntityName(..), entityName |
| @@ -20,6 +20,9 @@ import qualified Data.CaseInsensitive as CI | |||
| 20 | import Data.Map.Strict (Map) | 20 | import Data.Map.Strict (Map) |
| 21 | import qualified Data.Map.Strict as Map | 21 | import qualified Data.Map.Strict as Map |
| 22 | 22 | ||
| 23 | import Data.Sequence (Seq) | ||
| 24 | import qualified Data.Sequence as Seq | ||
| 25 | |||
| 23 | import Data.Bimap (Bimap) | 26 | import Data.Bimap (Bimap) |
| 24 | import qualified Data.Bimap as Bimap | 27 | import qualified Data.Bimap as Bimap |
| 25 | 28 | ||
| @@ -102,6 +105,7 @@ data GameState = GameState | |||
| 102 | , _gEntityNames :: Bimap EntityIdentifier EntityName | 105 | , _gEntityNames :: Bimap EntityIdentifier EntityName |
| 103 | , _gFocus :: Maybe EntityIdentifier | 106 | , _gFocus :: Maybe EntityIdentifier |
| 104 | , _gNextId :: EntityIdentifier | 107 | , _gNextId :: EntityIdentifier |
| 108 | , _gLog :: Seq (EntityIdentifier, String) | ||
| 105 | } | 109 | } |
| 106 | makeLenses ''GameState | 110 | makeLenses ''GameState |
| 107 | 111 | ||
| @@ -111,6 +115,7 @@ instance Default GameState where | |||
| 111 | , _gEntityNames = Bimap.empty | 115 | , _gEntityNames = Bimap.empty |
| 112 | , _gFocus = Nothing | 116 | , _gFocus = Nothing |
| 113 | , _gNextId = toEnum 0 | 117 | , _gNextId = toEnum 0 |
| 118 | , _gLog = Seq.empty | ||
| 114 | } | 119 | } |
| 115 | 120 | ||
| 116 | inhabitedFactions :: Getter GameState [Faction] | 121 | inhabitedFactions :: Getter GameState [Faction] |
