{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.Palette
Description : View current palette and to see all terminal colors
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

Lines for the @/palette@ command. This view shows all the colors of
the current palette as well as the colors available in the terminal.

-}

module Client.View.Palette
  ( paletteViewLines
  ) where

import           Client.Image.Palette
import           Client.Image.MircFormatting
import           Client.Image.PackedImage
import           Control.Lens
import           Data.List
import           Data.List.Split (chunksOf)
import           Graphics.Vty.Attributes
import qualified Data.Vector as Vector
import           Numeric (showHex)

columns :: [Image'] -> Image'
columns :: [Image'] -> Image'
columns = [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 (Attr -> Char -> Image'
char Attr
defAttr Char
' ')

indent :: Image' -> Image'
indent :: Image' -> Image'
indent Image'
x = Image'
"   " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
x

-- | Generate lines used for @/palette@. These lines show
-- all the colors used in the current palette as well as
-- the colors available for use in palettes.
paletteViewLines :: Palette -> [Image']
paletteViewLines :: Palette -> [Image']
paletteViewLines Palette
pal = [Image'] -> [Image']
forall a. [a] -> [a]
reverse ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$

  [ Image'
"Current client palette:"
  , Image'
""
  , [Image'] -> Image'
columns (Palette -> [Image']
paletteEntries Palette
pal)
  , Image'
""
  , Image'
"Current client palette nick highlight colors:"
  , Image'
""
  ] [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  Palette -> [Image']
nickHighlights Palette
pal [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  [ Image'
""
  , Image'
"Chat formatting modes:"
  , Image'
""
  , Image'
"   C-b  C-_       C-]    C-v     C-^           C-q       C-o"
  , Palette -> Text -> Image'
parseIrcText Palette
pal Text
"   \^Bbold\^B \^_underline\^_ \^]italic\^] \^Vreverse\^V \^^strikethrough\^^ \^Qmonospace\^Q reset"
  , Image'
""
  , Image'
"Chat formatting colors: C-c[foreground[,background]]"
  , Image'
""
  ] [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  [Image']
colorTable [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  [ Image'
""
  , Image'
"Available terminal palette colors (hex)"
  , Image'
""
  ] [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  [Image']
terminalColorTable

terminalColorTable :: [Image']
terminalColorTable :: [Image']
terminalColorTable =
  [Image']
isoColors [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  Image'
"" Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Int -> [Image']
colorBox Int
0x10 [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  Image'
"" Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Int -> [Image']
colorBox Int
0x7c [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
  Image'
"" Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Image' -> Image'
indent ((Int -> Image') -> [Int] -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
c -> (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadHex Int
c (Word8 -> Color
Color240 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
16)))) [Int
0xe8 .. Int
0xf3])
     Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Image' -> Image'
indent ((Int -> Image') -> [Int] -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
c -> (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadHex Int
c (Word8 -> Color
Color240 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
16)))) [Int
0xf4 .. Int
0xff])
     Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: []

colorBox :: Int -> [Image']
colorBox :: Int -> [Image']
colorBox Int
start =
  [ Image' -> Image'
indent (Image' -> Image') -> Image' -> Image'
forall a b. (a -> b) -> a -> b
$ [Image'] -> Image'
columns
      [ [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat
          [ (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadHex Int
k (Word8 -> Color
Color240 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16)))
          | Int
k <- [Int
j, Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
6 .. Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30 ] ]
      | Int
j <- [Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x24, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x48 ]
      ]
  | Int
i <- [ Int
start .. Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5 ]
  ]

isLight :: Color -> Bool
isLight :: Color -> Bool
isLight (ISOColor Word8
c) = Word8
c Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
7, Word8
10, Word8
11, Word8
14, Word8
15]
isLight (Color240 Word8
c) =
  case Word8 -> Maybe (Int, Int, Int)
color240CodeToRGB Word8
c of
    Just (Int
r, Int
g, Int
b) -> (Int
r Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
g Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
200
    Maybe (Int, Int, Int)
Nothing        -> Bool
True
isLight (RGBColor Word8
r Word8
g Word8
b) = (Word8
r Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
`max` Word8
g Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
`max` Word8
b) Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
200


isoColors :: [Image']
isoColors :: [Image']
isoColors =
  [ Image' -> Image'
indent ((Int -> Image') -> [Int] -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
c -> (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadHex Int
c (Word8 -> Color
ISOColor (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c))) [Int
0 .. Int
7])
  , Image' -> Image'
indent ((Int -> Image') -> [Int] -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
c -> (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadHex Int
c (Word8 -> Color
ISOColor (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c))) [Int
8 .. Int
15])
  ]

colorTable :: [Image']
colorTable :: [Image']
colorTable
  = ([Image'] -> Image') -> [[Image']] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Image' -> Image'
indent (Image' -> Image') -> ([Image'] -> Image') -> [Image'] -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat)
  ([[Image']] -> [Image']) -> [[Image']] -> [Image']
forall a b. (a -> b) -> a -> b
$ Int -> [Image'] -> [[Image']]
forall e. Int -> [e] -> [[e]]
chunksOf Int
8 [ (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadDec Int
i (Vector Color
mircColors Vector Color -> Int -> Color
forall a. Vector a -> Int -> a
Vector.! Int
i) | Int
i <- [Int
0 .. Int
15] ]
  [[Image']] -> [[Image']] -> [[Image']]
forall a. [a] -> [a] -> [a]
++ [[]]
  [[Image']] -> [[Image']] -> [[Image']]
forall a. [a] -> [a] -> [a]
++ Int -> [Image'] -> [[Image']]
forall e. Int -> [e] -> [[e]]
chunksOf Int
12 [ (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showPadDec Int
i (Vector Color
mircColors Vector Color -> Int -> Color
forall a. Vector a -> Int -> a
Vector.! Int
i) | Int
i <- [Int
16 .. Int
98] ]

colorBlock :: (Int -> String) -> Int -> Color -> Image'
colorBlock :: (Int -> String) -> Int -> Color -> Image'
colorBlock Int -> String
showNum Int
i Color
c =
  Attr -> String -> Image'
string (Attr -> Color -> Attr
withForeColor (Attr -> Color -> Attr
withBackColor Attr
defAttr Color
c) (if Color -> Bool
isLight Color
c then Color
black else Color
white)) (Int -> String
showNum Int
i)

showPadDec :: Int -> String
showPadDec :: Int -> String
showPadDec Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10    = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
i String
" "
  | Bool
otherwise = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
:       Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
i String
" "

showPadHex :: Int -> String
showPadHex :: Int -> String
showPadHex Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16    = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Int
i String
" "
  | Bool
otherwise = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
:       Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Int
i String
" "

paletteEntries :: Palette -> [Image']
paletteEntries :: Palette -> [Image']
paletteEntries Palette
pal =
  [ Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens Palette Palette Attr Attr
l Palette
pal) Text
name
  | (Text
name, Lens Lens Palette Palette Attr Attr
l) <- [(Text, ReifiedLens' Palette Attr)]
paletteMap
  ]

nickHighlights :: Palette -> [Image']
nickHighlights :: Palette -> [Image']
nickHighlights Palette
pal =
  [ Image' -> Image'
indent ([Image'] -> Image'
columns [Image']
line)
  | [Image']
line <- Int -> [Image'] -> [[Image']]
forall e. Int -> [e] -> [[e]]
chunksOf Int
8
            [ Attr -> String -> Image'
string Attr
attr String
"nicks"
            | Attr
attr <- LensLike' (Const [Attr]) Palette (Vector Attr)
-> (Vector Attr -> [Attr]) -> Palette -> [Attr]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Attr]) Palette (Vector Attr)
Lens' Palette (Vector Attr)
palNicks Vector Attr -> [Attr]
forall a. Vector a -> [a]
Vector.toList Palette
pal ]
  ]