Palette.hs

{-# 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 = mconcat . intersperse (char defAttr ' ')

indent :: Image' -> Image'
indent x = "   " <> 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 pal = reverse $

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

terminalColorTable :: [Image']
terminalColorTable =
  isoColors :
  "" : colorBox 0x10 ++
  "" : colorBox 0x7c ++
  "" : indent (foldMap (\c -> colorBlock showPadHex c (Color240 (fromIntegral (c-16)))) [0xe8 .. 0xf3])
     : indent (foldMap (\c -> colorBlock showPadHex c (Color240 (fromIntegral (c-16)))) [0xf4 .. 0xff])
     : []

colorBox :: Int -> [Image']
colorBox start =
  [ indent $ columns
      [ mconcat
          [ colorBlock showPadHex k (Color240 (fromIntegral (k - 16)))
          | k <- [j, j+6 .. j + 30 ] ]
      | j <- [i, i + 0x24, i + 0x48 ]
      ]
  | i <- [ start .. start + 5 ]
  ]

isLight :: Color -> Bool
isLight (ISOColor c) = c `elem` [7, 10, 11, 14, 15]
isLight (Color240 c) =
  case color240CodeToRGB c of
    Just (r, g, b) -> (r `max` g `max` b) > 200
    Nothing        -> True


isoColors :: Image'
isoColors = indent (foldMap (\c -> colorBlock showPadHex c (ISOColor (fromIntegral c))) [0 .. 15])

colorTable :: [Image']
colorTable
  = map (indent . mconcat)
  $ chunksOf 8 [ colorBlock showPadDec i (mircColors Vector.! i) | i <- [0 .. 15] ]
  ++ [[]]
  ++ chunksOf 12 [ colorBlock showPadDec i (mircColors Vector.! i) | i <- [16 .. 98] ]

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

showPadDec :: Int -> String
showPadDec i
  | i < 10    = ' ' : '0' : shows i " "
  | otherwise = ' ' :       shows i " "

showPadHex :: Int -> String
showPadHex i
  | i < 16    = ' ' : '0' : showHex i " "
  | otherwise = ' ' :       showHex i " "

paletteEntries :: Palette -> [Image']
paletteEntries pal =
  [ text' (view l pal) name
  | (name, Lens l) <- paletteMap
  ]

nickHighlights :: Palette -> [Image']
nickHighlights pal =
  [ indent (columns line)
  | line <- chunksOf 8
            [ string attr "nicks"
            | attr <- views palNicks Vector.toList pal ]
  ]