More faction utilities

1 files changed, 49 insertions, 4 deletions

diff --git a/src/Main.hs b/src/Main.hs
index f4a863f..8d74def 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ViewPatterns, RecordWildCards #-}
+{-# LANGUAGE ViewPatterns, RecordWildCards, OverloadedStrings, FlexibleContexts #-}
 
 import Control.Monad
 
@@ -43,6 +43,12 @@ import Text.Layout.Table
 
 import Text.Read (readMaybe)
 
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as Lazy (Text)
+import qualified Data.Text.Lazy as Lazy.Text
+import Data.Text.Template
+
 main :: IO ()
 main = do
   historyFile <- getUserCacheFile "sequence" "history"
@@ -65,7 +71,10 @@ main = do
                                     , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
                                     , cmd "name" nameEntity "Name the current entity overriding previous name assignments"
                                     , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it"
-                                    , cmd "roll" rollTest "Roll a test using the stats of the currently focused entity"
+                                    , cmd "spawn'" spawnFaction "Create a new faction and spawn multiple copies of an archetype in it"
+                                    , cmd "test" rollTest "Roll a test using the stats of the currently focused entity"
+                                    , 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"
                                     ]
                   }
   void $ runShell description haskelineBackend (def :: GameState)
@@ -81,11 +90,11 @@ stateOutline st
     faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities)
     factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions
     rowGs = do
-      rowGroup'@((seqVal', _):_) <- protoRows
+      rowGroup'@((review seqVal' -> seqVal, _):_) <- protoRows
       let
         rowGroup = map snd rowGroup'
         factionColumn i = [evalState ?? st $ toName x | x <- rowGroup, factionIndex x == i ]
-      return . colsAllG top $ [show (seqVal' ^. seqVal)] : map factionColumn [0..(length factions - 1)]
+      return . colsAllG top $ [seqVal] : map factionColumn [0..(length factions - 1)]
 
 -- Query state
 listFactions, listEntities :: Sh GameState ()
@@ -127,6 +136,27 @@ nameEntity :: String -> Sh GameState ()
 nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
 nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
 
+spawnFaction :: Completable Faction -> Integer -> Completable Entity -> String -> Sh GameState ()
+spawnFaction cFaction num cEntity nameTemplate
+  | ('#':_) <- nameTemplate = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
+  | otherwise = do
+      let nameTemplate' = templateSafe $ Text.pack nameTemplate
+      case nameTemplate' of
+        Left _ -> shellPutErrLn "Invalid template – ‘$n’ gets replaced by [1..<n>], ‘$faction’ gets replaced by name of faction, and ‘$i’ gets replaced by a numerical identifier – quote ‘$’ as ‘$$’"
+        Right nameTemplate -> withArg (\faction -> withArg (\entity -> mapM_ (spawnFaction' faction entity nameTemplate) [1..num]) cEntity) cFaction
+  where
+    spawnFaction' faction entity nameTemplate num = do
+      identifier <- use gNextId'
+      let name = Lazy.Text.unpack <$> renderA nameTemplate (context num)
+          context num "i" = Just . Text.pack $ review entityId' identifier
+          context num "n" = Just . Text.pack $ show num
+          context num "faction" = Just . Text.pack $ faction ^. faction'
+          context num _ = Nothing
+      modify $ insertEntity entity
+      maybe (return ()) (nameEntity identifier) name
+      gEntities %= Map.adjust (set eFaction faction) identifier
+    nameEntity identifier name = modifying gEntityNames $ Bimap.insert identifier (name ^. entityName)
+
 -- Dice rolls
 rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
 rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
@@ -150,3 +180,18 @@ enactTest' test = withFocus' $ \focus -> do
   gFocus' .= newFocus
   return result
       
+entitySeqVal :: Sh GameState ()
+entitySeqVal = withFocus entitySeqVal'
+
+factionSeqVal :: Completable Faction -> Sh GameState ()
+factionSeqVal = withArg $ \qFaction -> use gEntities >>= mapM_ (entitySeqVal') . Map.keys . Map.filter ((==) qFaction . view eFaction)
+
+entitySeqVal' :: EntityIdentifier -> Sh GameState ()
+entitySeqVal' ident = do
+  entity <- preuse (gEntities . ix ident)
+  let sVal = preview (eStats . sSeqVal) =<< entity
+  case (,) <$> entity <*> sVal of
+    Nothing -> return ()
+    Just (entity, sVal) -> do
+      (newEntity, view (seqVal . re _Just) -> val) <- evalFormula entity sVal
+      gEntities . at ident .= Just (newEntity & set eSeqVal val)