module Aura.Logo ( animateVersionMsg ) where
import Aura.Colour (dtot, yellow)
import Aura.IO
import Aura.Languages (translatorMsg)
import Aura.Pacman (verMsgPad)
import Aura.Settings
import Aura.Shell
import Data.Text.Prettyprint.Doc
import RIO
import qualified RIO.Text as T
animateVersionMsg :: Settings -> Text -> [Text] -> IO ()
animateVersionMsg :: Settings -> Text -> [Text] -> IO ()
animateVersionMsg Settings
ss Text
auraVersion [Text]
verMsg = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> Bool
isTerminal Settings
ss) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
hideCursor
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
padString Int
verMsgPad) [Text]
verMsg
Int -> IO ()
raiseCursorBy Int
7
Int -> IO ()
drawPills Int
3
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> Int -> MouthState -> [Text]
renderPacmanHead Settings
ss Int
0 MouthState
Open
Int -> IO ()
raiseCursorBy Int
4
Settings -> Int -> IO ()
takeABite Settings
ss Int
0
((Int, Int) -> IO ()) -> [(Int, Int)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Int, Int) -> IO ()
pillEating [(Int, Int)]
pillsAndWidths
IO ()
clearGrid
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
auraLogo
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"AURA Version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
auraVersion
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
" by Colin Woodbury\n"
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn ([Text] -> IO ()) -> (Settings -> [Text]) -> Settings -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> [Text]
translatorMsg (Language -> [Text])
-> (Settings -> Language) -> Settings -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Language
langOf (Settings -> IO ()) -> Settings -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings
ss
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> Bool
isTerminal Settings
ss) IO ()
showCursor
where pillEating :: (Int, Int) -> IO ()
pillEating (Int
p, Int
w) = IO ()
clearGrid IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> IO ()
drawPills Int
p IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Settings -> Int -> IO ()
takeABite Settings
ss Int
w
pillsAndWidths :: [(Int, Int)]
pillsAndWidths = [(Int
2, Int
5), (Int
1, Int
10), (Int
0, Int
15)]
data MouthState = Open | Closed deriving (MouthState -> MouthState -> Bool
(MouthState -> MouthState -> Bool)
-> (MouthState -> MouthState -> Bool) -> Eq MouthState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouthState -> MouthState -> Bool
$c/= :: MouthState -> MouthState -> Bool
== :: MouthState -> MouthState -> Bool
$c== :: MouthState -> MouthState -> Bool
Eq)
auraLogo :: Text
auraLogo :: Text
auraLogo = Text
" __ _ _ _ _ _ __ _ \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"/ _` | || | '_/ _` |\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\\__,_|\\_,_|_| \\__,_|"
openMouth :: Settings -> [Text]
openMouth :: Settings -> [Text]
openMouth Settings
ss = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
f
[ Text
" .--."
, Text
"/ _.-'"
, Text
"\\ '-."
, Text
" '--'" ]
where f :: Text -> Text
f | Settings -> CommonSwitch -> Bool
shared Settings
ss (ColourMode -> CommonSwitch
Colour ColourMode
Never) = Text -> Text
forall a. a -> a
id
| Bool
otherwise = Doc AnsiStyle -> Text
dtot (Doc AnsiStyle -> Text) -> (Text -> Doc AnsiStyle) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
yellow (Doc AnsiStyle -> Doc AnsiStyle)
-> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty
closedMouth :: Settings -> [Text]
closedMouth :: Settings -> [Text]
closedMouth Settings
ss = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
f
[ Text
" .--."
, Text
"/ _..\\"
, Text
"\\ ''/"
, Text
" '--'" ]
where f :: Text -> Text
f | Settings -> CommonSwitch -> Bool
shared Settings
ss (ColourMode -> CommonSwitch
Colour ColourMode
Never) = Text -> Text
forall a. a -> a
id
| Bool
otherwise = Doc AnsiStyle -> Text
dtot (Doc AnsiStyle -> Text) -> (Text -> Doc AnsiStyle) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
yellow (Doc AnsiStyle -> Doc AnsiStyle)
-> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty
pill :: [Text]
pill :: [Text]
pill = [ Text
""
, Text
".-."
, Text
"'-'"
, Text
"" ]
takeABite :: Settings -> Int -> IO ()
takeABite :: Settings -> Int -> IO ()
takeABite Settings
ss Int
pad = MouthState -> IO ()
drawMouth MouthState
Closed IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MouthState -> IO ()
drawMouth MouthState
Open
where
drawMouth :: MouthState -> IO ()
drawMouth :: MouthState -> IO ()
drawMouth MouthState
mouth = do
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> Int -> MouthState -> [Text]
renderPacmanHead Settings
ss Int
pad MouthState
mouth
Int -> IO ()
raiseCursorBy Int
4
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
125000
drawPills :: Int -> IO ()
drawPills :: Int -> IO ()
drawPills Int
numOfPills = (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn [Text]
pills
where pills :: [Text]
pills = Int -> [Text]
renderPills Int
numOfPills
clearGrid :: IO ()
clearGrid :: IO ()
clearGrid = Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
blankLines IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> IO ()
raiseCursorBy Int
4
where blankLines :: Text
blankLines = [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
4 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
padString Int
23 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"\n"
renderPill :: Int -> [Text]
renderPill :: Int -> [Text]
renderPill Int
pad = Int -> Text -> Text
padString Int
pad (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
pill
renderPills :: Int -> [Text]
renderPills :: Int -> [Text]
renderPills Int
numOfPills = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
numOfPills [Int]
pillPostitions [Int] -> (Int -> [Text]) -> [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Text]
render
where pillPostitions :: [Int]
pillPostitions = [Int
17, Int
12, Int
7]
render :: Int -> [Text]
render Int
pos = Int -> [Text]
renderPill Int
pos [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
cursorUpLineCode Int
5 ]
renderPacmanHead :: Settings -> Int -> MouthState -> [Text]
renderPacmanHead :: Settings -> Int -> MouthState -> [Text]
renderPacmanHead Settings
ss Int
pad MouthState
Open = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
padString Int
pad) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Settings -> [Text]
openMouth Settings
ss
renderPacmanHead Settings
ss Int
pad MouthState
Closed = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
padString Int
pad) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Settings -> [Text]
closedMouth Settings
ss
padString :: Int -> Text -> Text
padString :: Int -> Text -> Text
padString Int
pad Text
cs = Int -> Char -> Text -> Text
T.justifyRight (Int
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
cs) Char
' ' Text
cs