summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-06-13 20:03:24 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-06-13 20:03:24 +0200
commit0c5fe56414a323f49d7b086c0a64a216443a22bb (patch)
treeeb0fee8a463e09bc2dada338de5f42c5bbb3f552 /src
parent1ca2b48b49d559158cda4feffa145bdfded2c1c2 (diff)
download2017-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
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs28
-rw-r--r--src/Sequence/Contact/Archetypes.hs2
-rw-r--r--src/Sequence/Types.hs7
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
23import Data.Set (Set) 23import Data.Set (Set)
24import qualified Data.Set as Set 24import qualified Data.Set as Set
25 25
26import Data.Sequence (Seq)
27import qualified Data.Sequence as Seq
28
26import Data.Bimap (Bimap) 29import Data.Bimap (Bimap)
27import qualified Data.Bimap as Bimap 30import qualified Data.Bimap as Bimap
28 31
@@ -33,6 +36,8 @@ import Data.Maybe
33import Data.Bool 36import Data.Bool
34import Data.Monoid (All(..)) 37import Data.Monoid (All(..))
35 38
39import Data.Foldable (toList)
40
36import Data.Function 41import Data.Function
37 42
38import Control.Monad.State.Strict 43import 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
294spendSeq :: Int -> Sh GameState () 300spendSeq :: Int -> String -> Sh GameState ()
295spendSeq n = withFocus $ \focusId -> do 301spendSeq 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
298delay :: Sh GameState () 305delay :: Sh GameState ()
299delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId) 306delay = 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
308addNote :: String -> Sh GameState () 316addNote :: String -> Sh GameState ()
309addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) 317addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :)
@@ -359,3 +367,9 @@ takeFatigue :: Int -> Sh GameState ()
359takeFatigue dmg = withFocus $ \focusId -> do 367takeFatigue 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
371dumpLog :: Sh GameState ()
372dumpLog = 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)
50cTable :: Ord v => [(Integer, Integer, v)] -> Table v 50cTable :: Ord v => [(Integer, Integer, v)] -> Table v
51cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100)) 51cTable = Map.fromList . map (\(from, to, value) -> (value, (abs (to - from) + 1) % 100))
52 52
53death :: Hitzone -> FormulaM Stats (Maybe Stats) 53death :: Hitzone -> Effect
54death zone = Effect "Tod" . runMaybeT $ do 54death 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
3module Sequence.Types 3module 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
20import Data.Map.Strict (Map) 20import Data.Map.Strict (Map)
21import qualified Data.Map.Strict as Map 21import qualified Data.Map.Strict as Map
22 22
23import Data.Sequence (Seq)
24import qualified Data.Sequence as Seq
25
23import Data.Bimap (Bimap) 26import Data.Bimap (Bimap)
24import qualified Data.Bimap as Bimap 27import 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 }
106makeLenses ''GameState 110makeLenses ''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
116inhabitedFactions :: Getter GameState [Faction] 121inhabitedFactions :: Getter GameState [Faction]