{-# LANGUAGE OverloadedStrings #-}
module Aura.Logo ( animateVersionMsg ) where
import Aura.Colour (yellow, dtot)
import Aura.Languages (translatorMsg)
import Aura.Pacman (verMsgPad)
import Aura.Settings
import Aura.Utils
import BasePrelude
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Text.Prettyprint.Doc
import System.IO (stdout, hFlush)
animateVersionMsg :: Settings -> T.Text -> [T.Text] -> IO ()
animateVersionMsg ss auraVersion verMsg = do
when (isTerminal ss) $ do
hideCursor
traverse_ (T.putStrLn . padString (fromIntegral verMsgPad)) verMsg
raiseCursorBy 7
drawPills 3
traverse_ T.putStrLn $ renderPacmanHead ss 0 Open
raiseCursorBy 4
takeABite ss 0
traverse_ pillEating pillsAndWidths
clearGrid
T.putStrLn auraLogo
T.putStrLn $ "AURA Version " <> auraVersion
T.putStrLn " by Colin Woodbury\n"
traverse_ T.putStrLn . translatorMsg . langOf $ ss
when (isTerminal ss) showCursor
where pillEating (p, w) = clearGrid *> drawPills p *> takeABite ss w
pillsAndWidths = [(2, 5), (1, 10), (0, 15)]
data MouthState = Open | Closed deriving (Eq)
auraLogo :: T.Text
auraLogo = " __ _ _ _ _ _ __ _ \n" <>
"/ _` | || | '_/ _` |\n" <>
"\\__,_|\\_,_|_| \\__,_|"
openMouth :: Settings -> [T.Text]
openMouth ss = map f
[ " .--."
, "/ _.-'"
, "\\ '-."
, " '--'" ]
where f | shared ss (Colour Never) = id
| otherwise = dtot . yellow . pretty
closedMouth :: Settings -> [T.Text]
closedMouth ss = map f
[ " .--."
, "/ _..\\"
, "\\ ''/"
, " '--'" ]
where f | shared ss (Colour Never) = id
| otherwise = dtot . yellow . pretty
pill :: [T.Text]
pill = [ ""
, ".-."
, "'-'"
, "" ]
takeABite :: Settings -> Int -> IO ()
takeABite ss pad = drawMouth Closed *> drawMouth Open
where drawMouth mouth = do
traverse_ T.putStrLn $ renderPacmanHead ss pad mouth
raiseCursorBy 4
hFlush stdout
threadDelay 125000
drawPills :: Int -> IO ()
drawPills numOfPills = traverse_ T.putStrLn pills
where pills = renderPills numOfPills
clearGrid :: IO ()
clearGrid = T.putStr blankLines *> raiseCursorBy 4
where blankLines = fold . replicate 4 . padString 23 $ "\n"
renderPill :: Int -> [T.Text]
renderPill pad = padString pad <$> pill
renderPills :: Int -> [T.Text]
renderPills numOfPills = take numOfPills pillPostitions >>= render
where pillPostitions = [17, 12, 7]
render pos = renderPill pos <> [ cursorUpLineCode 5 ]
renderPacmanHead :: Settings -> Int -> MouthState -> [T.Text]
renderPacmanHead ss pad Open = map (padString pad) $ openMouth ss
renderPacmanHead ss pad Closed = map (padString pad) $ closedMouth ss
padString :: Int -> T.Text -> T.Text
padString pad cs = T.justifyRight (pad + T.length cs) ' ' cs