summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs19
1 files changed, 17 insertions, 2 deletions
diff --git a/src/Main.hs b/src/Main.hs
index c6eee62..06cc6ed 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,4 @@
1{-# LANGUAGE ViewPatterns #-} 1{-# LANGUAGE ViewPatterns, RecordWildCards #-}
2 2
3import Control.Monad 3import Control.Monad
4 4
@@ -7,6 +7,7 @@ import Control.Lens
7import System.Console.Shell 7import System.Console.Shell
8import System.Console.Shell.ShellMonad 8import System.Console.Shell.ShellMonad
9import System.Console.Shell.Backend.Haskeline 9import System.Console.Shell.Backend.Haskeline
10import System.Console.ANSI (setSGRCode, SGR(..), ConsoleLayer(..), ConsoleIntensity(..), ColorIntensity(..), Color(..))
10 11
11import System.Environment.XDG.BaseDir 12import System.Environment.XDG.BaseDir
12import System.FilePath 13import System.FilePath
@@ -126,8 +127,22 @@ nameEntity :: String -> Sh GameState ()
126nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" 127nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
127nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName) 128nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
128 129
130-- Dice rolls
129rollTest :: Completable (FormulaM Stats Test) -> Sh GameState () 131rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
130rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . show) 132rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
133 where
134 ppResult result = pad 3 (show $ result^.rWith) ++ ": " ++ setSGRCode (colour result) ++ name result ++ setSGRCode [] ++ " by " ++ pad 2 (show $ result^.rBy) ++ "pp"
135 colour CritSuccess{..} = [SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity]
136 colour Success{..} = [SetColor Foreground Dull Green]
137 colour Failure{..} = [SetColor Foreground Dull Red]
138 colour CritFailure{..} = [SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity]
139 name CritSuccess{..} = "Critical Success"
140 name Success{..} = "Success"
141 name Failure{..} = "Failure"
142 name CritFailure{..} = "Critical Failure"
143 pad n str
144 | length str >= n = str
145 | otherwise = ' ' : pad (n - 1) str
131 146
132enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult) 147enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult)
133enactTest' test = withFocus' $ \focus -> do 148enactTest' test = withFocus' $ \focus -> do