{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.Digraphs
Description : Character mnemonics
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides a view of the built-in digraph list.

-}
module Client.View.Digraphs (digraphLines) where

import           Client.Image.Message (cleanChar)
import           Client.Image.PackedImage
import           Client.State
import           Data.List
import           Data.List.Split
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import           Data.Text (Text)
import           Digraphs
import           Graphics.Vty.Attributes
import           Graphics.Vty.Image (wcwidth, wcswidth)

-- | Render the lines of a table showing all of the available digraph entries
digraphLines ::
  Int         {- ^ draw width   -} ->
  ClientState {- ^ client state -} ->
  [Image']    {- ^ output lines -}
digraphLines :: Int -> ClientState -> [Image']
digraphLines Int
w ClientState
st
  = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Image'
sep)
  forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
entriesPerLine
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Text -> Image'
text' Attr
defAttr)
  forall a b. (a -> b) -> a -> b
$ forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st Text -> Text
LText.fromStrict
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
drawEntry)
  forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
Text.chunksOf Int
3 Text
digraphs
  where
    entriesPerLine :: Int
entriesPerLine = forall a. Ord a => a -> a -> a
max Int
1 -- just in case?
                   forall a b. (a -> b) -> a -> b
$ (Int
w forall a. Num a => a -> a -> a
+ Int
sepWidth) forall a. Integral a => a -> a -> a
`quot` (Int
entryWidth forall a. Num a => a -> a -> a
+ Int
sepWidth)

entryWidth :: Int
entryWidth :: Int
entryWidth = Int
5 -- "Ka カ"

sepWidth :: Int
sepWidth :: Int
sepWidth = Image' -> Int
imageWidth Image'
sep

sep :: Image'
sep :: Image'
sep = Attr -> Text -> Image'
text' Attr
defAttr Text
"   "

drawEntry :: Text {- ^ 3-character entry -} -> String
drawEntry :: Text -> String
drawEntry Text
entry = String
output forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
entryWidth forall a. Num a => a -> a -> a
- String -> Int
wcswidth String
output) Char
' '
  where
    [Char
x,Char
y,Char
z] = Text -> String
Text.unpack Text
entry
    output :: String
output = Char
xforall a. a -> [a] -> [a]
:Char
yforall a. a -> [a] -> [a]
:String
z2
    dottedCircle :: Char
dottedCircle = Char
'\x25cc'
    z1 :: Char
z1 = Char -> Char
cleanChar Char
z
    z2 :: String
z2 | Char -> Int
wcwidth Char
z1 forall a. Eq a => a -> a -> Bool
== Int
0 = [Char
' ', Char
dottedCircle, Char
z1]
       | Bool
otherwise       = [Char
' ', Char
z1]