{-# 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
  = ([Image'] -> Image') -> [[Image']] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map ([Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat ([Image'] -> Image')
-> ([Image'] -> [Image']) -> [Image'] -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse Image'
sep)
  ([[Image']] -> [Image']) -> [[Image']] -> [Image']
forall a b. (a -> b) -> a -> b
$ Int -> [Image'] -> [[Image']]
forall e. Int -> [e] -> [[e]]
chunksOf Int
entriesPerLine
  ([Image'] -> [[Image']]) -> [Image'] -> [[Image']]
forall a b. (a -> b) -> a -> b
$ (Text -> Image') -> [Text] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Text -> Image'
text' Attr
defAttr)
  ([Text] -> [Image']) -> [Text] -> [Image']
forall a b. (a -> b) -> a -> b
$ ClientState -> (Text -> Text) -> [Text] -> [Text]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st Text -> Text
LText.fromStrict
  ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
drawEntry)
  ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
Text.chunksOf Int
3 Text
digraphs
  where
    entriesPerLine :: Int
entriesPerLine = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 -- just in case?
                   (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sepWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` (Int
entryWidth Int -> Int -> Int
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
entryWidth Int -> Int -> Int
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
xChar -> String -> String
forall a. a -> [a] -> [a]
:Char
yChar -> String -> String
forall 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char
' ', Char
dottedCircle, Char
z1]
       | Bool
otherwise       = [Char
' ', Char
z1]