summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-06-10 19:56:24 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-06-10 19:56:24 +0200
commit49d5fbcf0ac5322ba010230f0340b701d89d7fc2 (patch)
treea651511ebdae05c14b188982f695c19463fff7b1
parent0daa059aa8c6ece13d337e6f3dba30b89527530d (diff)
download2017-01-16_17:13:37-49d5fbcf0ac5322ba010230f0340b701d89d7fc2.tar
2017-01-16_17:13:37-49d5fbcf0ac5322ba010230f0340b701d89d7fc2.tar.gz
2017-01-16_17:13:37-49d5fbcf0ac5322ba010230f0340b701d89d7fc2.tar.bz2
2017-01-16_17:13:37-49d5fbcf0ac5322ba010230f0340b701d89d7fc2.tar.xz
2017-01-16_17:13:37-49d5fbcf0ac5322ba010230f0340b701d89d7fc2.zip
taking damage
-rw-r--r--src/Main.hs12
-rw-r--r--src/Sequence/Contact/Types.hs2
-rw-r--r--src/Sequence/Utils.hs29
3 files changed, 43 insertions, 0 deletions
diff --git a/src/Main.hs b/src/Main.hs
index d07cad5..e239bec 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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.Set (Set)
24import qualified Data.Set as Set
25
23import Data.Bimap (Bimap) 26import Data.Bimap (Bimap)
24import qualified Data.Bimap as Bimap 27import qualified Data.Bimap as Bimap
25 28
@@ -84,7 +87,10 @@ main = do
84 , cmd "spend" spendSeq "Spend some of the current focus´ AP" 87 , cmd "spend" spendSeq "Spend some of the current focus´ AP"
85 , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest" 88 , cmd "delay" delay "Spend AP until the current focus´ sequence is no higher than the next highest"
86 , cmd "note" addNote "Add a note to the current focus" 89 , cmd "note" addNote "Add a note to the current focus"
90 , cmd "hit" takeHit "Damage the focused entity"
91 , cmd "fatigue" takeFatigue "Inflict fatigue damage upon the focused entity"
87 ] 92 ]
93 , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '*']
88 } 94 }
89 void $ runShell description haskelineBackend (def :: GameState) 95 void $ runShell description haskelineBackend (def :: GameState)
90 96
@@ -244,3 +250,9 @@ delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId)
244 250
245addNote :: String -> Sh GameState () 251addNote :: String -> Sh GameState ()
246addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) 252addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :)
253
254takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState ()
255takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> gEntities . ix focusId . eStats . sDamage . ix zone += dmg
256
257takeFatigue :: Int -> Sh GameState ()
258takeFatigue dmg = withFocus $ \focusId -> gEntities . ix focusId . eStats . sFatigue += dmg
diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs
index dff886d..47687b7 100644
--- a/src/Sequence/Contact/Types.hs
+++ b/src/Sequence/Contact/Types.hs
@@ -36,6 +36,8 @@ hitzone = iso (Hitzone . CI.mk) (CI.original . _hitzone)
36instance IsString Hitzone where 36instance IsString Hitzone where
37 fromString = view hitzone 37 fromString = view hitzone
38 38
39makePrisms ''Hitzone
40
39makeLenses ''Armor 41makeLenses ''Armor
40 42
41instance Default Armor where 43instance Default Armor where
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index 517c3c2..bbd1477 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -11,6 +11,7 @@ module Sequence.Utils
11import Sequence.Types 11import Sequence.Types
12 12
13import Control.Monad.State.Strict 13import Control.Monad.State.Strict
14import Control.Monad.Trans.Maybe
14 15
15import Control.Applicative 16import Control.Applicative
16import Control.Monad 17import Control.Monad
@@ -25,6 +26,9 @@ import qualified Data.CaseInsensitive as CI
25import Data.Map.Strict (Map) 26import Data.Map.Strict (Map)
26import qualified Data.Map.Strict as Map 27import qualified Data.Map.Strict as Map
27 28
29import Data.Set (Set)
30import qualified Data.Set as Set
31
28import Data.Function 32import Data.Function
29import Data.Default 33import Data.Default
30import Data.Maybe 34import Data.Maybe
@@ -32,12 +36,14 @@ import Text.Read (readMaybe)
32 36
33import Data.List 37import Data.List
34import Data.Bool 38import Data.Bool
39import Data.Char
35 40
36import System.Console.Shell 41import System.Console.Shell
37import System.Console.Shell.ShellMonad 42import System.Console.Shell.ShellMonad
38import System.Console.Shell.Backend.Haskeline 43import System.Console.Shell.Backend.Haskeline
39 44
40import Sequence.Utils.Ask 45import Sequence.Utils.Ask
46import Sequence.Contact.Types
41 47
42class Argument a st | a -> st where 48class Argument a st | a -> st where
43 arg :: String -> Sh st (Maybe a) 49 arg :: String -> Sh st (Maybe a)
@@ -85,3 +91,26 @@ instance Completion Faction GameState where
85 91
86instance Argument Faction GameState where 92instance Argument Faction GameState where
87 arg = return . Just . flip (set faction') def 93 arg = return . Just . flip (set faction') def
94
95instance Completion (Set Hitzone) GameState where
96 completableLabel _ = "<hitzones>"
97 complete _ st (over each reverse . span (/= ',') . reverse -> (wPrefix, lPrefix))
98 | not $ null wPrefix
99 , all (== '*') wPrefix = return . pure . join $ hitzones
100 | otherwise = return . map (lPrefix ++) . filter ((isPrefixOf `on` CI.foldCase) wPrefix) $ hitzones
101 where
102 hitzones = sort . map (review hitzone) $ fromMaybe [] (Map.keys <$> preview (gFocus' . eStats . sHitzones) st)
103 join [] = ""
104 join [x] = x
105 join (x:xs) = x ++ "," ++ join xs
106
107instance Argument (Set Hitzone) GameState where
108 arg protoWs = runMaybeT $ do
109 let
110 trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
111 split = foldr (\c l@(w:ws) -> if c == ',' then "" : l else (c : w) : ws) [""]
112 ws = Set.fromList . map CI.mk . filter (not . null) . map trim . split $ protoWs
113 hasGlob = Set.member "*" ws
114 hitzones <- Set.map (view _Hitzone) . Map.keysSet <$> MaybeT (preuse $ gFocus' . eStats . sHitzones)
115 guard (hasGlob || hitzones `Set.isSubsetOf` ws)
116 return . Set.map (review _Hitzone) $ if hasGlob then hitzones else ws