From 49d5fbcf0ac5322ba010230f0340b701d89d7fc2 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 10 Jun 2016 19:56:24 +0200
Subject: taking damage

---
 src/Main.hs                   | 12 ++++++++++++
 src/Sequence/Contact/Types.hs |  2 ++
 src/Sequence/Utils.hs         | 29 +++++++++++++++++++++++++++++
 3 files changed, 43 insertions(+)

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
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 
+import Data.Set (Set)
+import qualified Data.Set as Set
+
 import Data.Bimap (Bimap)
 import qualified Data.Bimap as Bimap
 
@@ -84,7 +87,10 @@ main = do
                                     , 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 "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"
                                     ]
+                  , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '*']
                   }
   void $ runShell description haskelineBackend (def :: GameState)
 
@@ -244,3 +250,9 @@ delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId)
 
 addNote :: String -> Sh GameState ()
 addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :)
+
+takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState ()
+takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> gEntities . ix focusId . eStats . sDamage . ix zone += dmg
+
+takeFatigue :: Int -> Sh GameState ()
+takeFatigue 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)
 instance IsString Hitzone where
   fromString = view hitzone
 
+makePrisms ''Hitzone
+
 makeLenses ''Armor
 
 instance 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
 import Sequence.Types
 
 import Control.Monad.State.Strict
+import Control.Monad.Trans.Maybe
 
 import Control.Applicative
 import Control.Monad
@@ -25,6 +26,9 @@ import qualified Data.CaseInsensitive as CI
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 
+import Data.Set (Set)
+import qualified Data.Set as Set
+
 import Data.Function
 import Data.Default
 import Data.Maybe
@@ -32,12 +36,14 @@ import Text.Read (readMaybe)
 
 import Data.List
 import Data.Bool
+import Data.Char
 
 import System.Console.Shell
 import System.Console.Shell.ShellMonad
 import System.Console.Shell.Backend.Haskeline
 
 import Sequence.Utils.Ask
+import Sequence.Contact.Types
 
 class Argument a st | a -> st where
   arg :: String -> Sh st (Maybe a)
@@ -85,3 +91,26 @@ instance Completion Faction GameState where
 
 instance Argument Faction GameState where
   arg = return . Just . flip (set faction') def
+
+instance Completion (Set Hitzone) GameState where
+  completableLabel _ = "<hitzones>"
+  complete _ st (over each reverse . span (/= ',') . reverse -> (wPrefix, lPrefix))
+    | not $ null wPrefix
+    , all (== '*') wPrefix = return . pure . join $ hitzones
+    | otherwise = return . map (lPrefix ++) . filter ((isPrefixOf `on` CI.foldCase) wPrefix) $ hitzones
+    where
+      hitzones = sort . map (review hitzone) $ fromMaybe [] (Map.keys <$> preview (gFocus' . eStats . sHitzones) st)
+      join [] = ""
+      join [x] = x
+      join (x:xs) = x ++ "," ++ join xs
+
+instance Argument (Set Hitzone) GameState where
+  arg protoWs = runMaybeT $ do
+    let
+      trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+      split = foldr (\c l@(w:ws) -> if c == ',' then "" : l else (c : w) : ws) [""]
+      ws = Set.fromList . map CI.mk . filter (not . null) . map trim . split $ protoWs
+      hasGlob = Set.member "*" ws
+    hitzones <- Set.map (view _Hitzone) . Map.keysSet <$> MaybeT (preuse $ gFocus' . eStats . sHitzones)
+    guard (hasGlob || hitzones `Set.isSubsetOf` ws)
+    return . Set.map (review _Hitzone) $ if hasGlob then hitzones else ws
-- 
cgit v1.2.3