-- |
-- Module    : Aura.Logo
-- Copyright : (c) Colin Woodbury, 2012 - 2021
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Print an animated AURA version message.

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           Prettyprinter
import           RIO
import qualified RIO.Text as T

---

-- | Show an animated version message, but only when the output target
-- is a terminal.
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  -- Version message
    Int -> IO ()
raiseCursorBy Int
7  -- Initial reraising of the cursor.
    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  -- Initial rendering of head.
    Int -> IO ()
raiseCursorBy Int
4
    Settings -> Int -> IO ()
takeABite Settings
ss Int
0  -- Initial bite animation.
    ((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)

-- Taken from: figlet -f small "aura"
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