From f434263fcce697f29c668a1c9ac2f05a1de1012c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 5 Jun 2016 02:11:43 +0200
Subject: more pretty

---
 src/Main.hs | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

(limited to 'src/Main.hs')

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 @@
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns, RecordWildCards #-}
 
 import Control.Monad
 
@@ -7,6 +7,7 @@ import Control.Lens
 import System.Console.Shell
 import System.Console.Shell.ShellMonad
 import System.Console.Shell.Backend.Haskeline
+import System.Console.ANSI (setSGRCode, SGR(..), ConsoleLayer(..), ConsoleIntensity(..), ColorIntensity(..), Color(..))
 
 import System.Environment.XDG.BaseDir
 import System.FilePath
@@ -126,8 +127,22 @@ 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)
 
+-- Dice rolls
 rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
-rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . show)
+rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
+  where
+    ppResult result = pad 3 (show $ result^.rWith) ++ ": " ++ setSGRCode (colour result) ++ name result ++ setSGRCode [] ++ " by " ++ pad 2 (show $ result^.rBy) ++ "pp"
+    colour CritSuccess{..} = [SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity]
+    colour Success{..} = [SetColor Foreground Dull Green]
+    colour Failure{..} = [SetColor Foreground Dull Red]
+    colour CritFailure{..} = [SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity]
+    name CritSuccess{..} = "Critical Success"
+    name Success{..} = "Success"
+    name Failure{..} = "Failure"
+    name CritFailure{..} = "Critical Failure"
+    pad n str
+      | length str >= n = str
+      | otherwise = ' ' : pad (n - 1) str
 
 enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult)
 enactTest' test = withFocus' $ \focus -> do
-- 
cgit v1.2.3