Switch to more unicode-based output
This commit is contained in:
parent
86743c78a1
commit
2c292f29c0
1 changed files with 11 additions and 10 deletions
21
app/Main.hs
21
app/Main.hs
|
|
@ -99,7 +99,8 @@ askCardWithInfo time card left = do
|
||||||
let t = rjust ' ' 9 $ tierName $ tier card
|
let t = rjust ' ' 9 $ tierName $ tier card
|
||||||
l = rjust ' ' 5 $ show left
|
l = rjust ' ' 5 $ show left
|
||||||
lift $ outputStrLn ""
|
lift $ outputStrLn ""
|
||||||
lift $ outputStrLn $ "-----< tier: " ++ t ++ ", left: " ++ l ++ " >-----"
|
lift $ outputStrLn ""
|
||||||
|
lift $ outputStrLn $ "─────< tier: " ++ t ++ ", left: " ++ l ++ " >─────"
|
||||||
askCard time card
|
askCard time card
|
||||||
|
|
||||||
-- Ask the sides on a card and reset or update the card accordingly
|
-- Ask the sides on a card and reset or update the card accordingly
|
||||||
|
|
@ -115,12 +116,12 @@ askCard time card = do
|
||||||
askSide :: String -> MaybeT (InputT IO) Bool
|
askSide :: String -> MaybeT (InputT IO) Bool
|
||||||
askSide side = do
|
askSide side = do
|
||||||
lift $ displaySide side
|
lift $ displaySide side
|
||||||
promptYesNo "--> Did you know that side?"
|
promptYesNo "──> Did you know that side?"
|
||||||
|
|
||||||
showSide :: String -> MaybeT (InputT IO) ()
|
showSide :: String -> MaybeT (InputT IO) ()
|
||||||
showSide side = do
|
showSide side = do
|
||||||
lift $ displaySide side
|
lift $ displaySide side
|
||||||
promptContinue "--> Continue"
|
promptContinue "──> Continue"
|
||||||
|
|
||||||
displaySide :: String -> InputT IO ()
|
displaySide :: String -> InputT IO ()
|
||||||
displaySide side = outputStr side
|
displaySide side = outputStr side
|
||||||
|
|
@ -138,13 +139,13 @@ countTier e t = count (\card -> tier card == t) e
|
||||||
printBar :: Int -> Int -> String
|
printBar :: Int -> Int -> String
|
||||||
printBar maxInt int =
|
printBar maxInt int =
|
||||||
let l = (30 * int) `div` maxInt
|
let l = (30 * int) `div` maxInt
|
||||||
s = replicate l '#'
|
s = replicate l '█'
|
||||||
in rjust ' ' 30 s
|
in rjust ' ' 30 s
|
||||||
|
|
||||||
printLine :: Int -> String -> Int -> String
|
printLine :: Int -> String -> Int -> String
|
||||||
printLine maxAmount name amount =
|
printLine maxAmount name amount =
|
||||||
rjust ' ' 9 name ++ " | " ++
|
rjust ' ' 9 name ++ " │ " ++
|
||||||
printBar maxAmount amount ++ " | " ++ rjust ' ' 6 (show amount)
|
printBar maxAmount amount ++ " │ " ++ rjust ' ' 6 (show amount)
|
||||||
|
|
||||||
{-
|
{-
|
||||||
- User prompt.
|
- User prompt.
|
||||||
|
|
@ -158,14 +159,14 @@ learn elms = do
|
||||||
stats :: Elements -> Input ()
|
stats :: Elements -> Input ()
|
||||||
stats elms = do
|
stats elms = do
|
||||||
time <- lift $ getCurrentTime
|
time <- lift $ getCurrentTime
|
||||||
outputStrLn $ " tier | graph | amount"
|
outputStrLn $ " tier │ graph │ amount"
|
||||||
outputStrLn $ "----------|--------------------------------|-------"
|
outputStrLn $ "──────────┼────────────────────────────────┼───────"
|
||||||
let total = length $ toCards elms
|
let total = length $ toCards elms
|
||||||
due = length $ toDueCards time elms
|
due = length $ toDueCards time elms
|
||||||
maxAmount = maximum $ due : map (countTier elms) [minBound..maxBound]
|
maxAmount = maximum $ due : map (countTier elms) [minBound..maxBound]
|
||||||
mapM_ (outputStrLn . printTierLine maxAmount) [minBound..maxBound]
|
mapM_ (outputStrLn . printTierLine maxAmount) [minBound..maxBound]
|
||||||
outputStrLn $ "----------|--------------------------------|-------"
|
outputStrLn $ "──────────┼────────────────────────────────┼───────"
|
||||||
outputStrLn $ " total | | " ++ rjust ' ' 6 (show total)
|
outputStrLn $ " total │ │ " ++ rjust ' ' 6 (show total)
|
||||||
outputStrLn $ printLine maxAmount "learn" due
|
outputStrLn $ printLine maxAmount "learn" due
|
||||||
where
|
where
|
||||||
printTierLine m t = printLine m (tierName t) (countTier elms t)
|
printTierLine m t = printLine m (tierName t) (countTier elms t)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue