From 16f6c8689ae4e09e98413928e0f4a7b0774e8f02 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 6 Jun 2016 17:48:24 +0200 Subject: More faction utilities --- sequence.cabal | 2 ++ sequence.nix | 7 ++++--- src/Main.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++---- src/Sequence/Types.hs | 20 ++++++++++++------- 4 files changed, 68 insertions(+), 14 deletions(-) diff --git a/sequence.cabal b/sequence.cabal index b721848..2def576 100644 --- a/sequence.cabal +++ b/sequence.cabal @@ -37,5 +37,7 @@ executable sequence , transformers , transformers-base , ansi-terminal + , text + , template hs-source-dirs: src default-language: Haskell2010 \ No newline at end of file diff --git a/sequence.nix b/sequence.nix index 5e8a130..ae75127 100644 --- a/sequence.nix +++ b/sequence.nix @@ -1,7 +1,8 @@ { mkDerivation, ansi-terminal, base, bimap, case-insensitive , containers, data-default, directory, filepath, game-probability , lens, mtl, readline, Shellac, Shellac-haskeline, stdenv -, table-layout, transformers, transformers-base, xdg-basedir +, table-layout, template, text, transformers, transformers-base +, xdg-basedir }: mkDerivation { pname = "sequence"; @@ -12,8 +13,8 @@ mkDerivation { executableHaskellDepends = [ ansi-terminal base bimap case-insensitive containers data-default directory filepath game-probability lens mtl readline Shellac - Shellac-haskeline table-layout transformers transformers-base - xdg-basedir + Shellac-haskeline table-layout template text transformers + transformers-base xdg-basedir ]; license = stdenv.lib.licenses.mit; } 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 (‘#’)" 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 (‘#’)" + | otherwise = do + let nameTemplate' = templateSafe $ Text.pack nameTemplate + case nameTemplate' of + Left _ -> shellPutErrLn "Invalid template – ‘$n’ gets replaced by [1..], ‘$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) diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs index 3d95b9a..02389a1 100644 --- a/src/Sequence/Types.hs +++ b/src/Sequence/Types.hs @@ -3,7 +3,7 @@ module Sequence.Types ( GameState, gEntities, gEntityNames, gFocus, gNextId' , Faction, faction, faction' - , SeqVal(..), seqVal + , SeqVal(..), seqVal, seqVal' , Entity(..), eFaction, eSeqVal, eStats , EntityName(..), entityName , EntityIdentifier(..), entityId, entityId' @@ -61,8 +61,13 @@ faction' = lens (CI.original . fromMaybe unaligned . view faction) (\s a -> s { newtype SeqVal = SeqVal { _seqVal :: Int } deriving (Show, Ord, Eq, Num, Integral, Enum, Real) -makeLenses ''SeqVal - + +seqVal :: Integral a => Iso' a SeqVal +seqVal = iso (SeqVal . fromIntegral) (fromIntegral . _seqVal) + +seqVal' :: Prism' String SeqVal +seqVal' = _Show . seqVal + data Entity = Entity { _eSeqVal :: Maybe SeqVal @@ -90,11 +95,12 @@ entityName = iso (EntityName . CI.mk) (CI.original . _entityName) newtype EntityIdentifier = EntityIdentifier { _entityId :: Integer } deriving (Show, Eq, Ord, Enum) -entityId :: Iso' Integer EntityIdentifier -entityId = iso EntityIdentifier _entityId +entityId :: Integral a => Iso' a EntityIdentifier +entityId = iso (EntityIdentifier . fromIntegral) (fromIntegral . _entityId) entityId' :: Prism' String EntityIdentifier -entityId' = prism' (show . _entityId) (fmap EntityIdentifier . readMaybe) +entityId' = _Show . entityId + data GameState = GameState { _gEntities :: Map EntityIdentifier Entity @@ -118,7 +124,7 @@ inhabitedFactions = to $ nub . sort . Map.elems . fmap (view eFaction) . view gE priorityQueue :: Getter GameState [(SeqVal, EntityIdentifier)] priorityQueue = to priorityQueue' where - priorityQueue' (Map.toAscList . view gEntities -> entities) = sortBy (comparing $ Down . snd) . concat . map filter . map (over _1 $ view eSeqVal) . map swap $ entities + priorityQueue' (Map.toAscList . view gEntities -> entities) = sortBy (comparing $ Down . fst) . concat . map filter . map (over _1 $ view eSeqVal) . map swap $ entities filter (Nothing, _) = mempty filter (Just val, id) = pure (val, id) -- cgit v1.2.3