{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Module    : Termonad.Config.Colour
-- Description : Termonad Configuration Colour Options
-- Copyright   : (c) Dennis Gosnell, 2018
-- License     : BSD3
-- Stability   : experimental
-- Portability : POSIX
--
-- To use this config extension in your @~\/.config\/termonad\/termonad.hs@, first
-- import this module. Create a new 'ColourExtension' with the 'createColourExtension' function.
-- Then add the 'ColourExtension' to your 'TMConfig' with the 'addColourExtension' function.
--
-- See
-- <https://github.com/cdepillabout/termonad/blob/master/example-config/ExampleColourExtension.hs this code>
-- for a simple example.
--
-- When setting colors, you may find it convenient to use the
-- <http://hackage.haskell.org/package/print-console-colors print-console-colors>
-- package, which provides an executable called @print-console-colors@ that prints
-- all of the colors for your terminal.

module Termonad.Config.Colour
  ( -- * Colour Config
      ColourConfig(..)
    , defaultColourConfig
    , List8
    , List6
    , List24
    , Matrix
    , mkList8
    , unsafeMkList8
    , setAtList8
    , overAtList8
    , mkList6
    , unsafeMkList6
    , setAtList6
    , overAtList6
    , mkList24
    , unsafeMkList24
    , setAtList24
    , overAtList24
    , mkMatrix
    , unsafeMkMatrix
    , setAtMatrix
    , overAtMatrix
    -- ** Colour Config Lenses
    , lensCursorFgColour
    , lensCursorBgColour
    , lensForegroundColour
    , lensBackgroundColour
    , lensHighlightFgColour
    , lensHighlightBgColour
    , lensPalette
    -- * Colour Extension
    , ColourExtension(..)
    , createColourExtension
    , createDefColourExtension
    , addColourExtension
    , addColourConfig
    , colourHook
    , addColourHook
    -- * Palette
    , Palette(..)
    , defaultStandardColours
    , defaultLightColours
    , defaultColourCube
    , defaultGreyscale
    -- * Colour
    -- | Check out the "Data.Colour" module for more info about 'AlphaColour'.
    , AlphaColour
    , createColour
    , sRGB32
    , sRGB32show
    , opaque
    , transparent
    -- * Debugging and Internal Methods
    , showColourVec
    , showColourCube
    , paletteToList
    , coloursFromBits
    , cube
    , setAt
    , overAt
    -- * Doctest setup
    -- $setup
  ) where

import Termonad.Prelude hiding ((\\), index)

import Control.Lens ((%~), makeLensesFor)
import Data.Colour
  ( AlphaColour
  , Colour
  , affineCombo
  , alphaChannel
  , black
  , darken
  , opaque
  , over
  , transparent
  , withOpacity
  )
import Data.Colour.SRGB (RGB(RGB), toSRGB, toSRGB24, sRGB24)
import qualified Data.Foldable
import GI.Gdk
  ( RGBA
  , newZeroRGBA
  , setRGBAAlpha
  , setRGBABlue
  , setRGBAGreen
  , setRGBARed
  )
import GI.Vte
  ( Terminal
  , terminalSetColors
  , terminalSetColorCursor
#ifdef VTE_VERSION_GEQ_0_44
  , terminalSetColorCursorForeground
#endif
  , terminalSetColorBackground
  , terminalSetColorForeground
  , terminalSetColorHighlight
  , terminalSetColorHighlightForeground
  )
import Text.Printf (printf)
import Text.Show (showString)

import Termonad.Lenses (lensCreateTermHook, lensHooks)
import Termonad.Types
  ( Option(Unset)
  , TMConfig
  , TMState
  , whenSet
  )

-- $setup
-- >>> import Data.Colour.Names (green, red)
-- >>> import Data.Colour.SRGB (sRGB24show)

-------------------
-- Colour Config --
-------------------

-- | This newtype is for length 8 lists. Construct it with 'mkList8' or 'unsafeMkList8'
newtype List8 a = List8 { forall a. List8 a -> [a]
getList8 :: [a] }
  deriving (Int -> List8 a -> ShowS
forall a. Show a => Int -> List8 a -> ShowS
forall a. Show a => [List8 a] -> ShowS
forall a. Show a => List8 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List8 a] -> ShowS
$cshowList :: forall a. Show a => [List8 a] -> ShowS
show :: List8 a -> String
$cshow :: forall a. Show a => List8 a -> String
showsPrec :: Int -> List8 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> List8 a -> ShowS
Show, List8 a -> List8 a -> Bool
forall a. Eq a => List8 a -> List8 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List8 a -> List8 a -> Bool
$c/= :: forall a. Eq a => List8 a -> List8 a -> Bool
== :: List8 a -> List8 a -> Bool
$c== :: forall a. Eq a => List8 a -> List8 a -> Bool
Eq, forall a. Eq a => a -> List8 a -> Bool
forall a. Num a => List8 a -> a
forall a. Ord a => List8 a -> a
forall m. Monoid m => List8 m -> m
forall a. List8 a -> Bool
forall a. List8 a -> Int
forall a. List8 a -> [a]
forall a. (a -> a -> a) -> List8 a -> a
forall m a. Monoid m => (a -> m) -> List8 a -> m
forall b a. (b -> a -> b) -> b -> List8 a -> b
forall a b. (a -> b -> b) -> b -> List8 a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => List8 a -> a
$cproduct :: forall a. Num a => List8 a -> a
sum :: forall a. Num a => List8 a -> a
$csum :: forall a. Num a => List8 a -> a
minimum :: forall a. Ord a => List8 a -> a
$cminimum :: forall a. Ord a => List8 a -> a
maximum :: forall a. Ord a => List8 a -> a
$cmaximum :: forall a. Ord a => List8 a -> a
elem :: forall a. Eq a => a -> List8 a -> Bool
$celem :: forall a. Eq a => a -> List8 a -> Bool
length :: forall a. List8 a -> Int
$clength :: forall a. List8 a -> Int
null :: forall a. List8 a -> Bool
$cnull :: forall a. List8 a -> Bool
toList :: forall a. List8 a -> [a]
$ctoList :: forall a. List8 a -> [a]
foldl1 :: forall a. (a -> a -> a) -> List8 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List8 a -> a
foldr1 :: forall a. (a -> a -> a) -> List8 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List8 a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> List8 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List8 a -> b
foldl :: forall b a. (b -> a -> b) -> b -> List8 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List8 a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> List8 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List8 a -> b
foldr :: forall a b. (a -> b -> b) -> b -> List8 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List8 a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> List8 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List8 a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> List8 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List8 a -> m
fold :: forall m. Monoid m => List8 m -> m
$cfold :: forall m. Monoid m => List8 m -> m
Foldable, forall a b. a -> List8 b -> List8 a
forall a b. (a -> b) -> List8 a -> List8 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> List8 b -> List8 a
$c<$ :: forall a b. a -> List8 b -> List8 a
fmap :: forall a b. (a -> b) -> List8 a -> List8 b
$cfmap :: forall a b. (a -> b) -> List8 a -> List8 b
Functor)

-- | Typesafe smart constructor for length 8 lists.
mkList8 :: [a] -> Maybe (List8 a)
mkList8 :: forall a. [a] -> Maybe (List8 a)
mkList8 [a]
xs = if forall mono. MonoFoldable mono => mono -> Int
length [a]
xs forall a. Eq a => a -> a -> Bool
== Int
8 then forall a. a -> Maybe a
Just (forall a. [a] -> List8 a
List8 [a]
xs) else forall a. Maybe a
Nothing

-- | Unsafe smart constructor for length 8 lists.
unsafeMkList8 :: [a] -> List8 a
unsafeMkList8 :: forall a. [a] -> List8 a
unsafeMkList8 [a]
xs =
  case forall a. [a] -> Maybe (List8 a)
mkList8 [a]
xs of
    Just List8 a
xs' -> List8 a
xs'
    Maybe (List8 a)
Nothing  ->
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"unsafeMkList8: input list contains " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall mono. MonoFoldable mono => mono -> Int
length [a]
xs) forall a. Semigroup a => a -> a -> a
<>
        String
" elements.  Must contain exactly 8 elements."

-- | Set a given value in a list.
--
-- >>> setAt 2 "hello" ["a","b","c","d"]
-- ["a","b","hello","d"]
--
-- You can set the first and last values in the list as well:
--
-- >>> setAt 0 "hello" ["a","b","c","d"]
-- ["hello","b","c","d"]
-- >>> setAt 3 "hello" ["a","b","c","d"]
-- ["a","b","c","hello"]
--
-- If you try to set a value outside of the list, you'll get back the same
-- list:
--
-- >>> setAt (-10) "hello" ["a","b","c","d"]
-- ["a","b","c","d"]
-- >>> setAt 100 "hello" ["a","b","c","d"]
-- ["a","b","c","d"]
setAt :: forall a. Int -> a -> [a] -> [a]
setAt :: forall a. Int -> a -> [a] -> [a]
setAt Int
n a
newVal = forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n (forall a b. a -> b -> a
const a
newVal)

-- | Update a given value in a list.
--
-- >>> overAt 2 (\x -> x ++ x) ["a","b","c","d"]
-- ["a","b","cc","d"]
--
-- You can update the first and last values in the list as well:
--
-- >>> overAt 0 (\x -> "bye") ["a","b","c","d"]
-- ["bye","b","c","d"]
-- >>> overAt 3 (\x -> "") ["a","b","c","d"]
-- ["a","b","c",""]
--
-- If you try to set a value outside of the list, you'll get back the same
-- list:
--
-- >>> overAt (-10) (\_ -> "foobar") ["a","b","c","d"]
-- ["a","b","c","d"]
-- >>> overAt 100 (\_ -> "baz") ["a","b","c","d"]
-- ["a","b","c","d"]
overAt :: forall a. Int -> (a -> a) -> [a] -> [a]
overAt :: forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n a -> a
f = forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr (Int, a) -> [a] -> [a]
go [] forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Int
0..]
  where
    go :: (Int, a) -> [a] -> [a]
    go :: (Int, a) -> [a] -> [a]
go (Int
i, a
a) [a]
next
      | Int
i forall a. Eq a => a -> a -> Bool
== Int
n = a -> a
f a
a forall a. a -> [a] -> [a]
: [a]
next
      | Bool
otherwise = a
a forall a. a -> [a] -> [a]
: [a]
next

-- | Set a given value in a 'List8'.
--
-- Internally uses 'setAt'.  See documentation on 'setAt' for some examples.
setAtList8 :: Int -> a -> List8 a -> List8 a
setAtList8 :: forall a. Int -> a -> List8 a -> List8 a
setAtList8 Int
n a
a (List8 [a]
l) = forall a. [a] -> List8 a
List8 (forall a. Int -> a -> [a] -> [a]
setAt Int
n a
a [a]
l)

-- | Set a given value in a 'List8'.
--
-- Internally uses 'overAt'.  See documentation on 'overAt' for some examples.
overAtList8 :: Int -> (a -> a) -> List8 a -> List8 a
overAtList8 :: forall a. Int -> (a -> a) -> List8 a -> List8 a
overAtList8 Int
n a -> a
f (List8 [a]
l) = forall a. [a] -> List8 a
List8 (forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n a -> a
f [a]
l)

-- | This newtype is for length 6 lists. Construct it with 'mkList6' or 'unsafeMkList6'
newtype List6 a = List6 { forall a. List6 a -> [a]
getList6 :: [a] }
  deriving (Int -> List6 a -> ShowS
forall a. Show a => Int -> List6 a -> ShowS
forall a. Show a => [List6 a] -> ShowS
forall a. Show a => List6 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List6 a] -> ShowS
$cshowList :: forall a. Show a => [List6 a] -> ShowS
show :: List6 a -> String
$cshow :: forall a. Show a => List6 a -> String
showsPrec :: Int -> List6 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> List6 a -> ShowS
Show, List6 a -> List6 a -> Bool
forall a. Eq a => List6 a -> List6 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List6 a -> List6 a -> Bool
$c/= :: forall a. Eq a => List6 a -> List6 a -> Bool
== :: List6 a -> List6 a -> Bool
$c== :: forall a. Eq a => List6 a -> List6 a -> Bool
Eq, forall a. Eq a => a -> List6 a -> Bool
forall a. Num a => List6 a -> a
forall a. Ord a => List6 a -> a
forall m. Monoid m => List6 m -> m
forall a. List6 a -> Bool
forall a. List6 a -> Int
forall a. List6 a -> [a]
forall a. (a -> a -> a) -> List6 a -> a
forall m a. Monoid m => (a -> m) -> List6 a -> m
forall b a. (b -> a -> b) -> b -> List6 a -> b
forall a b. (a -> b -> b) -> b -> List6 a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => List6 a -> a
$cproduct :: forall a. Num a => List6 a -> a
sum :: forall a. Num a => List6 a -> a
$csum :: forall a. Num a => List6 a -> a
minimum :: forall a. Ord a => List6 a -> a
$cminimum :: forall a. Ord a => List6 a -> a
maximum :: forall a. Ord a => List6 a -> a
$cmaximum :: forall a. Ord a => List6 a -> a
elem :: forall a. Eq a => a -> List6 a -> Bool
$celem :: forall a. Eq a => a -> List6 a -> Bool
length :: forall a. List6 a -> Int
$clength :: forall a. List6 a -> Int
null :: forall a. List6 a -> Bool
$cnull :: forall a. List6 a -> Bool
toList :: forall a. List6 a -> [a]
$ctoList :: forall a. List6 a -> [a]
foldl1 :: forall a. (a -> a -> a) -> List6 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List6 a -> a
foldr1 :: forall a. (a -> a -> a) -> List6 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List6 a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> List6 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List6 a -> b
foldl :: forall b a. (b -> a -> b) -> b -> List6 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List6 a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> List6 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List6 a -> b
foldr :: forall a b. (a -> b -> b) -> b -> List6 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List6 a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> List6 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List6 a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> List6 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List6 a -> m
fold :: forall m. Monoid m => List6 m -> m
$cfold :: forall m. Monoid m => List6 m -> m
Foldable, forall a b. a -> List6 b -> List6 a
forall a b. (a -> b) -> List6 a -> List6 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> List6 b -> List6 a
$c<$ :: forall a b. a -> List6 b -> List6 a
fmap :: forall a b. (a -> b) -> List6 a -> List6 b
$cfmap :: forall a b. (a -> b) -> List6 a -> List6 b
Functor)

-- | Typesafe smart constructor for length 6 lists.
mkList6 :: [a] -> Maybe (List6 a)
mkList6 :: forall a. [a] -> Maybe (List6 a)
mkList6 [a]
xs = if forall mono. MonoFoldable mono => mono -> Int
length [a]
xs forall a. Eq a => a -> a -> Bool
== Int
6 then forall a. a -> Maybe a
Just (forall a. [a] -> List6 a
List6 [a]
xs) else forall a. Maybe a
Nothing

-- | Unsafe smart constructor for length 6 lists.
unsafeMkList6 :: [a] -> List6 a
unsafeMkList6 :: forall a. [a] -> List6 a
unsafeMkList6 [a]
xs =
  case forall a. [a] -> Maybe (List6 a)
mkList6 [a]
xs of
    Just List6 a
xs' -> List6 a
xs'
    Maybe (List6 a)
Nothing  ->
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"unsafeMkList6: input list contains " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall mono. MonoFoldable mono => mono -> Int
length [a]
xs) forall a. Semigroup a => a -> a -> a
<>
        String
" elements.  Must contain exactly 6 elements."

-- | Set a given value in a 'List6'.
--
-- Internally uses 'setAt'.  See documentation on 'setAt' for some examples.
setAtList6 :: Int -> a -> List6 a -> List6 a
setAtList6 :: forall a. Int -> a -> List6 a -> List6 a
setAtList6 Int
n a
a (List6 [a]
l) = forall a. [a] -> List6 a
List6 (forall a. Int -> a -> [a] -> [a]
setAt Int
n a
a [a]
l)

-- | Set a given value in a 'List6'.
--
-- Internally uses 'overAt'.  See documentation on 'overAt' for some examples.
overAtList6 :: Int -> (a -> a) -> List6 a -> List6 a
overAtList6 :: forall a. Int -> (a -> a) -> List6 a -> List6 a
overAtList6 Int
n a -> a
f (List6 [a]
l) = forall a. [a] -> List6 a
List6 (forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n a -> a
f [a]
l)

-- | This newtype is for length 24 lists. Construct it with 'mkList24' or 'unsafeMkList24'
newtype List24 a = List24 { forall a. List24 a -> [a]
getList24 :: [a] }
  deriving (Int -> List24 a -> ShowS
forall a. Show a => Int -> List24 a -> ShowS
forall a. Show a => [List24 a] -> ShowS
forall a. Show a => List24 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List24 a] -> ShowS
$cshowList :: forall a. Show a => [List24 a] -> ShowS
show :: List24 a -> String
$cshow :: forall a. Show a => List24 a -> String
showsPrec :: Int -> List24 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> List24 a -> ShowS
Show, List24 a -> List24 a -> Bool
forall a. Eq a => List24 a -> List24 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List24 a -> List24 a -> Bool
$c/= :: forall a. Eq a => List24 a -> List24 a -> Bool
== :: List24 a -> List24 a -> Bool
$c== :: forall a. Eq a => List24 a -> List24 a -> Bool
Eq, forall a. Eq a => a -> List24 a -> Bool
forall a. Num a => List24 a -> a
forall a. Ord a => List24 a -> a
forall m. Monoid m => List24 m -> m
forall a. List24 a -> Bool
forall a. List24 a -> Int
forall a. List24 a -> [a]
forall a. (a -> a -> a) -> List24 a -> a
forall m a. Monoid m => (a -> m) -> List24 a -> m
forall b a. (b -> a -> b) -> b -> List24 a -> b
forall a b. (a -> b -> b) -> b -> List24 a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => List24 a -> a
$cproduct :: forall a. Num a => List24 a -> a
sum :: forall a. Num a => List24 a -> a
$csum :: forall a. Num a => List24 a -> a
minimum :: forall a. Ord a => List24 a -> a
$cminimum :: forall a. Ord a => List24 a -> a
maximum :: forall a. Ord a => List24 a -> a
$cmaximum :: forall a. Ord a => List24 a -> a
elem :: forall a. Eq a => a -> List24 a -> Bool
$celem :: forall a. Eq a => a -> List24 a -> Bool
length :: forall a. List24 a -> Int
$clength :: forall a. List24 a -> Int
null :: forall a. List24 a -> Bool
$cnull :: forall a. List24 a -> Bool
toList :: forall a. List24 a -> [a]
$ctoList :: forall a. List24 a -> [a]
foldl1 :: forall a. (a -> a -> a) -> List24 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List24 a -> a
foldr1 :: forall a. (a -> a -> a) -> List24 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List24 a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> List24 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List24 a -> b
foldl :: forall b a. (b -> a -> b) -> b -> List24 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List24 a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> List24 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List24 a -> b
foldr :: forall a b. (a -> b -> b) -> b -> List24 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List24 a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> List24 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List24 a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> List24 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List24 a -> m
fold :: forall m. Monoid m => List24 m -> m
$cfold :: forall m. Monoid m => List24 m -> m
Foldable, forall a b. a -> List24 b -> List24 a
forall a b. (a -> b) -> List24 a -> List24 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> List24 b -> List24 a
$c<$ :: forall a b. a -> List24 b -> List24 a
fmap :: forall a b. (a -> b) -> List24 a -> List24 b
$cfmap :: forall a b. (a -> b) -> List24 a -> List24 b
Functor)

-- | Typesafe smart constructor for length 24 lists.
mkList24 :: [a] -> Maybe (List24 a)
mkList24 :: forall a. [a] -> Maybe (List24 a)
mkList24 [a]
xs = if forall mono. MonoFoldable mono => mono -> Int
length [a]
xs forall a. Eq a => a -> a -> Bool
== Int
24 then forall a. a -> Maybe a
Just (forall a. [a] -> List24 a
List24 [a]
xs) else forall a. Maybe a
Nothing

-- | Unsafe smart constructor for length 24 lists.
unsafeMkList24 :: [a] -> List24 a
unsafeMkList24 :: forall a. [a] -> List24 a
unsafeMkList24 [a]
xs =
  case forall a. [a] -> Maybe (List24 a)
mkList24 [a]
xs of
    Just List24 a
xs' -> List24 a
xs'
    Maybe (List24 a)
Nothing  -> forall a. HasCallStack => String -> a
error String
"List must contain 24 elements"

-- | Set a given value in a 'List24'.
--
-- Internally uses 'setAt'.  See documentation on 'setAt' for some examples.
setAtList24 :: Int -> a -> List24 a -> List24 a
setAtList24 :: forall a. Int -> a -> List24 a -> List24 a
setAtList24 Int
n a
a (List24 [a]
l) = forall a. [a] -> List24 a
List24 (forall a. Int -> a -> [a] -> [a]
setAt Int
n a
a [a]
l)

-- | Set a given value in a 'List24'.
--
-- Internally uses 'overAt'.  See documentation on 'overAt' for some examples.
overAtList24 :: Int -> (a -> a) -> List24 a -> List24 a
overAtList24 :: forall a. Int -> (a -> a) -> List24 a -> List24 a
overAtList24 Int
n a -> a
f (List24 [a]
l) = forall a. [a] -> List24 a
List24 (forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n a -> a
f [a]
l)

-- | This newtype is for 6x6x6 matrices.. Construct it with 'mkMatrix' or 'unsafeMkMatrix'
newtype Matrix a = Matrix (List6 (List6 (List6 a)))
  deriving (Int -> Matrix a -> ShowS
forall a. Show a => Int -> Matrix a -> ShowS
forall a. Show a => [Matrix a] -> ShowS
forall a. Show a => Matrix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Matrix a] -> ShowS
$cshowList :: forall a. Show a => [Matrix a] -> ShowS
show :: Matrix a -> String
$cshow :: forall a. Show a => Matrix a -> String
showsPrec :: Int -> Matrix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Matrix a -> ShowS
Show, Matrix a -> Matrix a -> Bool
forall a. Eq a => Matrix a -> Matrix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matrix a -> Matrix a -> Bool
$c/= :: forall a. Eq a => Matrix a -> Matrix a -> Bool
== :: Matrix a -> Matrix a -> Bool
$c== :: forall a. Eq a => Matrix a -> Matrix a -> Bool
Eq, forall a b. a -> Matrix b -> Matrix a
forall a b. (a -> b) -> Matrix a -> Matrix b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Matrix b -> Matrix a
$c<$ :: forall a b. a -> Matrix b -> Matrix a
fmap :: forall a b. (a -> b) -> Matrix a -> Matrix b
$cfmap :: forall a b. (a -> b) -> Matrix a -> Matrix b
Functor, forall a. Eq a => a -> Matrix a -> Bool
forall a. Num a => Matrix a -> a
forall a. Ord a => Matrix a -> a
forall m. Monoid m => Matrix m -> m
forall a. Matrix a -> Bool
forall a. Matrix a -> Int
forall a. Matrix a -> [a]
forall a. (a -> a -> a) -> Matrix a -> a
forall m a. Monoid m => (a -> m) -> Matrix a -> m
forall b a. (b -> a -> b) -> b -> Matrix a -> b
forall a b. (a -> b -> b) -> b -> Matrix a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Matrix a -> a
$cproduct :: forall a. Num a => Matrix a -> a
sum :: forall a. Num a => Matrix a -> a
$csum :: forall a. Num a => Matrix a -> a
minimum :: forall a. Ord a => Matrix a -> a
$cminimum :: forall a. Ord a => Matrix a -> a
maximum :: forall a. Ord a => Matrix a -> a
$cmaximum :: forall a. Ord a => Matrix a -> a
elem :: forall a. Eq a => a -> Matrix a -> Bool
$celem :: forall a. Eq a => a -> Matrix a -> Bool
length :: forall a. Matrix a -> Int
$clength :: forall a. Matrix a -> Int
null :: forall a. Matrix a -> Bool
$cnull :: forall a. Matrix a -> Bool
toList :: forall a. Matrix a -> [a]
$ctoList :: forall a. Matrix a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Matrix a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Matrix a -> a
foldr1 :: forall a. (a -> a -> a) -> Matrix a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Matrix a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Matrix a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Matrix a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Matrix a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Matrix a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Matrix a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Matrix a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Matrix a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Matrix a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Matrix a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Matrix a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Matrix a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Matrix a -> m
fold :: forall m. Monoid m => Matrix m -> m
$cfold :: forall m. Monoid m => Matrix m -> m
Foldable)

getMatrix :: Matrix a -> [[[a]]]
getMatrix :: forall a. Matrix a -> [[[a]]]
getMatrix (Matrix (List6 [List6 (List6 a)]
m)) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. List6 a -> [a]
getList6 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. List6 a -> [a]
getList6) [List6 (List6 a)]
m

-- | Unsafe smart constructor for 6x6x6 Matrices.
mkMatrix :: [[[a]]] -> Maybe (Matrix a)
mkMatrix :: forall a. [[[a]]] -> Maybe (Matrix a)
mkMatrix [[[a]]]
xs =
  if forall mono. MonoFoldable mono => mono -> Int
length [[[a]]]
xs forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all (\Element [[[a]]]
x -> forall mono. MonoFoldable mono => mono -> Int
length Element [[[a]]]
x forall a. Eq a => a -> a -> Bool
== Int
6) [[[a]]]
xs
                    Bool -> Bool -> Bool
&& forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all (forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all (\Element [[a]]
x -> forall mono. MonoFoldable mono => mono -> Int
length Element [[a]]
x forall a. Eq a => a -> a -> Bool
== Int
6)) [[[a]]]
xs
  then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. List6 (List6 (List6 a)) -> Matrix a
Matrix forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List6 a
List6 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> List6 a
List6 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> List6 a
List6) [[[a]]]
xs)
  else forall a. Maybe a
Nothing

-- | Unsafe smart constructor for 6x6x6 Matrices.
unsafeMkMatrix :: [[[a]]] -> Matrix a
unsafeMkMatrix :: forall a. [[[a]]] -> Matrix a
unsafeMkMatrix [[[a]]]
xs =
  case forall a. [[[a]]] -> Maybe (Matrix a)
mkMatrix [[[a]]]
xs of
    Just Matrix a
xs' -> Matrix a
xs'
    Maybe (Matrix a)
Nothing ->
      forall a. HasCallStack => String -> a
error
        String
"unsafeMkMatrix: input list must be exactly 6x6x6"

-- | Set a given value in a 'Matrix'.
--
-- Internally uses 'setAt'.  See documentation on 'setAt' for some examples.
setAtMatrix :: Int -> Int -> Int -> a -> Matrix a -> Matrix a
setAtMatrix :: forall a. Int -> Int -> Int -> a -> Matrix a -> Matrix a
setAtMatrix Int
x Int
y Int
z a
a = forall a. Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
overAtMatrix Int
x Int
y Int
z (forall a b. a -> b -> a
const a
a)

-- | Set a given value in a 'Matrix'.
--
-- Internally uses 'overAt'.  See documentation on 'overAt' for some examples.
overAtMatrix :: Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
overAtMatrix :: forall a. Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
overAtMatrix Int
x Int
y Int
z a -> a
f (Matrix List6 (List6 (List6 a))
l6) =
  forall a. List6 (List6 (List6 a)) -> Matrix a
Matrix (forall a. Int -> (a -> a) -> List6 a -> List6 a
overAtList6 Int
x (forall a. Int -> (a -> a) -> List6 a -> List6 a
overAtList6 Int
y (forall a. Int -> (a -> a) -> List6 a -> List6 a
overAtList6 Int
z a -> a
f)) List6 (List6 (List6 a))
l6)

-- | This is the color palette to use for the terminal. Each data constructor
-- lets you set progressively more colors.  These colors are used by the
-- terminal to render
-- <https://en.wikipedia.org/wiki/ANSI_escape_code#Colors ANSI escape color codes>.
--
-- There are 256 total terminal colors. 'BasicPalette' lets you set the first 8,
-- 'ExtendedPalette' lets you set the first 16, 'ColourCubePalette' lets you set
-- the first 232, and 'FullPalette' lets you set all 256.
--
-- The first 8 colors codes are the standard colors. The next 8 are the
-- extended (light) colors. The next 216 are a full color cube. The last 24 are a
-- grey scale.
--
-- The following image gives an idea of what each individual color looks like:
  --
-- <<https://raw.githubusercontent.com/cdepillabout/termonad/master/img/terminal-colors.png>>
--
-- This picture does not exactly match up with Termonad's default colors, but it gives an
-- idea of what each block of colors represents.
--
-- You can use 'defaultStandardColours', 'defaultLightColours',
-- 'defaultColourCube', and 'defaultGreyscale' as a starting point to
-- customize the colors. The only time you'd need to use a constructor other
-- than 'NoPalette' is when you want to customize the default colors.
-- That is to say, using 'FullPalette' with all the defaults should give you the
-- same result as using 'NoPalette'.
data Palette c
  = NoPalette
  -- ^ Don't set any colors and just use the default from VTE.  This is a black
  -- background with light grey text.
  | BasicPalette !(List8 c)
  -- ^ Set the colors from the standard colors.
  | ExtendedPalette !(List8 c) !(List8 c)
  -- ^ Set the colors from the extended (light) colors (as well as standard colors).
  | ColourCubePalette !(List8 c) !(List8 c) !(Matrix c)
  -- ^ Set the colors from the color cube (as well as the standard colors and
  -- extended colors).
  | FullPalette !(List8 c) !(List8 c) !(Matrix c) !(List24 c)
  -- ^ Set the colors from the grey scale (as well as the standard colors,
  -- extended colors, and color cube).
  deriving (Palette c -> Palette c -> Bool
forall c. Eq c => Palette c -> Palette c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Palette c -> Palette c -> Bool
$c/= :: forall c. Eq c => Palette c -> Palette c -> Bool
== :: Palette c -> Palette c -> Bool
$c== :: forall c. Eq c => Palette c -> Palette c -> Bool
Eq, Int -> Palette c -> ShowS
forall c. Show c => Int -> Palette c -> ShowS
forall c. Show c => [Palette c] -> ShowS
forall c. Show c => Palette c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Palette c] -> ShowS
$cshowList :: forall c. Show c => [Palette c] -> ShowS
show :: Palette c -> String
$cshow :: forall c. Show c => Palette c -> String
showsPrec :: Int -> Palette c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> Palette c -> ShowS
Show, forall a b. a -> Palette b -> Palette a
forall a b. (a -> b) -> Palette a -> Palette b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Palette b -> Palette a
$c<$ :: forall a b. a -> Palette b -> Palette a
fmap :: forall a b. (a -> b) -> Palette a -> Palette b
$cfmap :: forall a b. (a -> b) -> Palette a -> Palette b
Functor, forall a. Eq a => a -> Palette a -> Bool
forall a. Num a => Palette a -> a
forall a. Ord a => Palette a -> a
forall m. Monoid m => Palette m -> m
forall a. Palette a -> Bool
forall a. Palette a -> Int
forall a. Palette a -> [a]
forall a. (a -> a -> a) -> Palette a -> a
forall m a. Monoid m => (a -> m) -> Palette a -> m
forall b a. (b -> a -> b) -> b -> Palette a -> b
forall a b. (a -> b -> b) -> b -> Palette a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Palette a -> a
$cproduct :: forall a. Num a => Palette a -> a
sum :: forall a. Num a => Palette a -> a
$csum :: forall a. Num a => Palette a -> a
minimum :: forall a. Ord a => Palette a -> a
$cminimum :: forall a. Ord a => Palette a -> a
maximum :: forall a. Ord a => Palette a -> a
$cmaximum :: forall a. Ord a => Palette a -> a
elem :: forall a. Eq a => a -> Palette a -> Bool
$celem :: forall a. Eq a => a -> Palette a -> Bool
length :: forall a. Palette a -> Int
$clength :: forall a. Palette a -> Int
null :: forall a. Palette a -> Bool
$cnull :: forall a. Palette a -> Bool
toList :: forall a. Palette a -> [a]
$ctoList :: forall a. Palette a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Palette a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Palette a -> a
foldr1 :: forall a. (a -> a -> a) -> Palette a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Palette a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Palette a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Palette a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Palette a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Palette a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Palette a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Palette a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Palette a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Palette a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Palette a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Palette a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Palette a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Palette a -> m
fold :: forall m. Monoid m => Palette m -> m
$cfold :: forall m. Monoid m => Palette m -> m
Foldable)

-- | Convert a 'Palette' to a list of colors.  This is helpful for debugging.
paletteToList :: Palette c -> [c]
paletteToList :: forall a. Palette a -> [a]
paletteToList = forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList

-- | Create a vector of colors based on input bits.
--
-- This is used to derive 'defaultStandardColours' and 'defaultLightColours'.
--
-- >>> coloursFromBits 192 0 == defaultStandardColours
-- True
--
-- >>> coloursFromBits 192 63 == defaultLightColours
-- True
--
-- In general, as an end-user, you shouldn't need to use this.
coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits :: forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits Word8
scale Word8
offset = forall a. (Int -> a) -> List8 a
genList Int -> AlphaColour b
createElem
  where
    createElem :: Int -> AlphaColour b
    createElem :: Int -> AlphaColour b
createElem Int
i =
      let red :: Word8
red = Int -> Int -> Word8
cmp Int
0 Int
i
          green :: Word8
green = Int -> Int -> Word8
cmp Int
1 Int
i
          blue :: Word8
blue = Int -> Int -> Word8
cmp Int
2 Int
i
          color :: AlphaColour b
color = forall a. Num a => Colour a -> AlphaColour a
opaque forall a b. (a -> b) -> a -> b
$ forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
red Word8
green Word8
blue
      in AlphaColour b
color

    cmp :: Int -> Int -> Word8
    cmp :: Int -> Int -> Word8
cmp Int
i = (Word8
offset forall a. Num a => a -> a -> a
+) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Word8
scale forall a. Num a => a -> a -> a
*) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Int -> Int
bit Int
i

    bit :: Int -> Int -> Int
    bit :: Int -> Int -> Int
bit Int
m Int
i = Int
i forall a. Integral a => a -> a -> a
`div` (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
m) forall a. Integral a => a -> a -> a
`mod` Int
2

    genList :: (Int -> a) -> List8 a
    genList :: forall a. (Int -> a) -> List8 a
genList Int -> a
f = forall a. [a] -> List8 a
unsafeMkList8 [ Int -> a
f Int
x | Int
x <- [Int
0..Int
7]]

-- | A 'Vec' of standard colors.  Default value for 'BasicPalette'.
--
-- >>> showColourVec defaultStandardColours
-- ["#000000ff","#c00000ff","#00c000ff","#c0c000ff","#0000c0ff","#c000c0ff","#00c0c0ff","#c0c0c0ff"]
defaultStandardColours :: (Ord b, Floating b) => List8 (AlphaColour b)
defaultStandardColours :: forall b. (Ord b, Floating b) => List8 (AlphaColour b)
defaultStandardColours = forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits Word8
192 Word8
0

-- | A 'Vec' of extended (light) colors.  Default value for 'ExtendedPalette'.
--
-- >>> showColourVec defaultLightColours
-- ["#3f3f3fff","#ff3f3fff","#3fff3fff","#ffff3fff","#3f3fffff","#ff3fffff","#3fffffff","#ffffffff"]
defaultLightColours :: (Ord b, Floating b) => List8 (AlphaColour b)
defaultLightColours :: forall b. (Ord b, Floating b) => List8 (AlphaColour b)
defaultLightColours = forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits Word8
192 Word8
63

-- | Convert an 'AlphaColour' to a 'Colour'.
--
-- >>> sRGB24show $ pureColour (opaque green)
-- "#008000"
-- >>> sRGB24show $ pureColour (sRGB32 0x30 0x40 0x50 0x80)
-- "#304050"
--
-- We assume that black is the pure color for a fully transparent
-- 'AlphaColour'.
--
-- >>> sRGB24show $ pureColour transparent
-- "#000000"
--
-- This function has been taken from:
-- https://wiki.haskell.org/Colour#Getting_semi-transparent_coordinates
pureColour :: AlphaColour Double -> Colour Double
pureColour :: AlphaColour Double -> Colour Double
pureColour AlphaColour Double
alaphaColour
  | Double
a forall a. Ord a => a -> a -> Bool
> Double
0 = forall (f :: * -> *) a. (ColourOps f, Num a) => a -> f a -> f a
darken (forall a. Fractional a => a -> a
recip Double
a) (AlphaColour Double
alaphaColour forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` forall a. Num a => Colour a
black)
  | Bool
otherwise = forall a. Num a => Colour a
black
  where
    a :: Double
    a :: Double
a = forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
alaphaColour

-- | 'round's and then clamps the input between 0 and 'maxBound'.
--
-- Rounds the input:
--
-- >>> quantize (100.2 :: Double) :: Word8
-- 100
--
-- Clamps to 'minBound' if input is too low:
--
-- >>> quantize (-3 :: Double) :: Word8
-- 0
--
-- Clamps to 'maxBound' if input is too high:
-- >>> quantize (1000 :: Double) :: Word8
-- 255
--
-- Function used to quantize the alpha channel in the same way as the 'RGB'
-- components. It has been copied from "Data.Colour.Internal".
quantize :: forall a b. (RealFrac a, Integral b, Bounded b) => a -> b
quantize :: forall a b. (RealFrac a, Integral b, Bounded b) => a -> b
quantize a
x
  | a
x forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral b
l = b
l
  | forall a b. (Integral a, Num b) => a -> b
fromIntegral b
h forall a. Ord a => a -> a -> Bool
<= a
x = b
h
  | Bool
otherwise           = forall a b. (RealFrac a, Integral b) => a -> b
round a
x
  where
    l :: b
    l :: b
l = forall a. Bounded a => a
minBound

    h :: b
    h :: b
h = forall a. Bounded a => a
maxBound

-- | Show an 'AlphaColour' in hex.
--
-- >>> sRGB32show (opaque red)
-- "#ff0000ff"
--
-- Similar to 'Data.Colour.SRGB.sRGB24show'.
sRGB32show :: AlphaColour Double -> String
sRGB32show :: AlphaColour Double -> String
sRGB32show AlphaColour Double
c = forall r. PrintfType r => String -> r
printf String
"#%02x%02x%02x%02x" Word8
r Word8
g Word8
b Word8
a
  where
    r, g, b :: Word8
    RGB Word8
r Word8
g Word8
b = forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 forall a b. (a -> b) -> a -> b
$ AlphaColour Double -> Colour Double
pureColour AlphaColour Double
c

    -- This about the same code as in Data.Colour.SRGB.toSRGBBounded
    a :: Word8
    a :: Word8
a = forall a b. (RealFrac a, Integral b, Bounded b) => a -> b
quantize (Double
255 forall a. Num a => a -> a -> a
* forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
c)

-- | Create an 'AlphaColour' from a four 'Word8's.
--
-- >>> sRGB32show $ sRGB32 64 96 128 255
-- "#406080ff"
-- >>> sRGB32show $ sRGB32 0x08 0x10 0x20 0x01
-- "#08102001"
--
-- Note that if you specify the alpha as 0 (which means completely
-- translucent), all the color channels will be set to 0 as well.
--
-- >>> sRGB32show $ sRGB32 100 150 200 0
-- "#00000000"
--
-- Similar to 'sRGB24' but also includes an alpha channel.  Most users will
-- probably want to use 'createColour' instead.
sRGB32
  :: Word8 -- ^ red channel
  -> Word8 -- ^ green channel
  -> Word8 -- ^ blue channel
  -> Word8 -- ^ alpha channel
  -> AlphaColour Double
sRGB32 :: Word8 -> Word8 -> Word8 -> Word8 -> AlphaColour Double
sRGB32 Word8
r Word8
g Word8
b Word8
255 = forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity (forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
r Word8
g Word8
b) Double
1
sRGB32 Word8
r Word8
g Word8
b Word8
a =
  let aDouble :: Double
aDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a forall a. Fractional a => a -> a -> a
/ Double
255
  in forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity (forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
r Word8
g Word8
b) Double
aDouble

-- | Create an 'AlphaColour' that is fully 'opaque'.
--
-- >>> sRGB32show $ createColour 64 96 128
-- "#406080ff"
-- >>> sRGB32show $ createColour 0 0 0
-- "#000000ff"
--
-- Similar to 'sRGB24' but for 'AlphaColour'.
createColour
  :: Word8 -- ^ red channel
  -> Word8 -- ^ green channel
  -> Word8 -- ^ blue channel
  -> AlphaColour Double
createColour :: Word8 -> Word8 -> Word8 -> AlphaColour Double
createColour Word8
r Word8
g Word8
b = Word8 -> Word8 -> Word8 -> Word8 -> AlphaColour Double
sRGB32 Word8
r Word8
g Word8
b Word8
255

-- | A helper function for showing all the colors in 'Vec' of colors.
showColourVec :: List8 (AlphaColour Double) -> [String]
showColourVec :: List8 (AlphaColour Double) -> [String]
showColourVec (List8 [AlphaColour Double]
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlphaColour Double -> String
sRGB32show [AlphaColour Double]
xs

genMatrix :: (Int -> Int -> Int -> a) -> [a]
genMatrix :: forall a. (Int -> Int -> Int -> a) -> [a]
genMatrix Int -> Int -> Int -> a
f = [ Int -> Int -> Int -> a
f Int
x Int
y Int
z | Int
x <- [Int
0..Int
5], Int
y <- [Int
0..Int
5], Int
z <- [Int
0..Int
5] ]

build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build :: forall a. ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build (a -> [a] -> [a]) -> [a] -> [a]
g = (a -> [a] -> [a]) -> [a] -> [a]
g (:) []

chunksOf :: Int -> [e] -> [[e]]
chunksOf :: forall e. Int -> [e] -> [[e]]
chunksOf Int
i [e]
ls = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall seq. IsSequence seq => Index seq -> seq -> seq
take Int
i) (forall a. ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build (forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter [e]
ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter :: forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter [] [e] -> a -> a
_ a
n = a
n
  splitter [e]
l [e] -> a -> a
c a
n  = [e]
l [e] -> a -> a
`c` forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter (forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
i [e]
l) [e] -> a -> a
c a
n

-- | Specify a colour cube with one colour vector for its displacement and three
-- colour vectors for its edges. Produces a uniform 6x6x6 grid bounded by
-- and orthognal to the faces.
cube ::
     forall b. Fractional b
  => AlphaColour b
  -> AlphaColour b
  -> AlphaColour b
  -> AlphaColour b
  -> Matrix (AlphaColour b)
cube :: forall b.
Fractional b =>
AlphaColour b
-> AlphaColour b
-> AlphaColour b
-> AlphaColour b
-> Matrix (AlphaColour b)
cube AlphaColour b
d AlphaColour b
i AlphaColour b
j AlphaColour b
k =
  let xs :: [AlphaColour b]
xs = forall a. (Int -> Int -> Int -> a) -> [a]
genMatrix forall a b. (a -> b) -> a -> b
$ \Int
x Int
y Int
z ->
        forall (f :: * -> *) a.
(AffineSpace f, Num a) =>
[(a, f a)] -> f a -> f a
affineCombo [(b
1, AlphaColour b
d), (Int -> b
coef Int
x, AlphaColour b
i), (Int -> b
coef Int
y, AlphaColour b
j), (Int -> b
coef Int
z, AlphaColour b
k)] forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. Num a => Colour a
black
  in forall a. [[[a]]] -> Matrix a
unsafeMkMatrix forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
6 forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
6 [AlphaColour b]
xs
  where
    coef :: Int -> b
    coef :: Int -> b
coef Int
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Fractional a => a -> a -> a
/ b
5
-- | A matrix of a 6 x 6 x 6 color cube. Default value for 'ColourCubePalette'.
--
-- >>> putStrLn $ pack $ showColourCube defaultColourCube
-- [ [ #000000ff, #00005fff, #000087ff, #0000afff, #0000d7ff, #0000ffff
--   , #005f00ff, #005f5fff, #005f87ff, #005fafff, #005fd7ff, #005fffff
--   , #008700ff, #00875fff, #008787ff, #0087afff, #0087d7ff, #0087ffff
--   , #00af00ff, #00af5fff, #00af87ff, #00afafff, #00afd7ff, #00afffff
--   , #00d700ff, #00d75fff, #00d787ff, #00d7afff, #00d7d7ff, #00d7ffff
--   , #00ff00ff, #00ff5fff, #00ff87ff, #00ffafff, #00ffd7ff, #00ffffff
--   ]
-- , [ #5f0000ff, #5f005fff, #5f0087ff, #5f00afff, #5f00d7ff, #5f00ffff
--   , #5f5f00ff, #5f5f5fff, #5f5f87ff, #5f5fafff, #5f5fd7ff, #5f5fffff
--   , #5f8700ff, #5f875fff, #5f8787ff, #5f87afff, #5f87d7ff, #5f87ffff
--   , #5faf00ff, #5faf5fff, #5faf87ff, #5fafafff, #5fafd7ff, #5fafffff
--   , #5fd700ff, #5fd75fff, #5fd787ff, #5fd7afff, #5fd7d7ff, #5fd7ffff
--   , #5fff00ff, #5fff5fff, #5fff87ff, #5fffafff, #5fffd7ff, #5fffffff
--   ]
-- , [ #870000ff, #87005fff, #870087ff, #8700afff, #8700d7ff, #8700ffff
--   , #875f00ff, #875f5fff, #875f87ff, #875fafff, #875fd7ff, #875fffff
--   , #878700ff, #87875fff, #878787ff, #8787afff, #8787d7ff, #8787ffff
--   , #87af00ff, #87af5fff, #87af87ff, #87afafff, #87afd7ff, #87afffff
--   , #87d700ff, #87d75fff, #87d787ff, #87d7afff, #87d7d7ff, #87d7ffff
--   , #87ff00ff, #87ff5fff, #87ff87ff, #87ffafff, #87ffd7ff, #87ffffff
--   ]
-- , [ #af0000ff, #af005fff, #af0087ff, #af00afff, #af00d7ff, #af00ffff
--   , #af5f00ff, #af5f5fff, #af5f87ff, #af5fafff, #af5fd7ff, #af5fffff
--   , #af8700ff, #af875fff, #af8787ff, #af87afff, #af87d7ff, #af87ffff
--   , #afaf00ff, #afaf5fff, #afaf87ff, #afafafff, #afafd7ff, #afafffff
--   , #afd700ff, #afd75fff, #afd787ff, #afd7afff, #afd7d7ff, #afd7ffff
--   , #afff00ff, #afff5fff, #afff87ff, #afffafff, #afffd7ff, #afffffff
--   ]
-- , [ #d70000ff, #d7005fff, #d70087ff, #d700afff, #d700d7ff, #d700ffff
--   , #d75f00ff, #d75f5fff, #d75f87ff, #d75fafff, #d75fd7ff, #d75fffff
--   , #d78700ff, #d7875fff, #d78787ff, #d787afff, #d787d7ff, #d787ffff
--   , #d7af00ff, #d7af5fff, #d7af87ff, #d7afafff, #d7afd7ff, #d7afffff
--   , #d7d700ff, #d7d75fff, #d7d787ff, #d7d7afff, #d7d7d7ff, #d7d7ffff
--   , #d7ff00ff, #d7ff5fff, #d7ff87ff, #d7ffafff, #d7ffd7ff, #d7ffffff
--   ]
-- , [ #ff0000ff, #ff005fff, #ff0087ff, #ff00afff, #ff00d7ff, #ff00ffff
--   , #ff5f00ff, #ff5f5fff, #ff5f87ff, #ff5fafff, #ff5fd7ff, #ff5fffff
--   , #ff8700ff, #ff875fff, #ff8787ff, #ff87afff, #ff87d7ff, #ff87ffff
--   , #ffaf00ff, #ffaf5fff, #ffaf87ff, #ffafafff, #ffafd7ff, #ffafffff
--   , #ffd700ff, #ffd75fff, #ffd787ff, #ffd7afff, #ffd7d7ff, #ffd7ffff
--   , #ffff00ff, #ffff5fff, #ffff87ff, #ffffafff, #ffffd7ff, #ffffffff
--   ]
-- ]
defaultColourCube :: (Ord b, Floating b) => Matrix (AlphaColour b)
defaultColourCube :: forall b. (Ord b, Floating b) => Matrix (AlphaColour b)
defaultColourCube =
  let xs :: [AlphaColour b]
xs = forall a. (Int -> Int -> Int -> a) -> [a]
genMatrix forall a b. (a -> b) -> a -> b
$ \Int
x Int
y Int
z -> forall a. Num a => Colour a -> AlphaColour a
opaque forall a b. (a -> b) -> a -> b
$ forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Int -> Word8
cmp Int
x) (Int -> Word8
cmp Int
y) (Int -> Word8
cmp Int
z)
  in forall a. [[[a]]] -> Matrix a
unsafeMkMatrix forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
6 forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
6 [AlphaColour b]
xs
  where
    cmp :: Int -> Word8
    cmp :: Int -> Word8
cmp Int
i = let i' :: Word8
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i in forall a. Num a => a -> a
signum Word8
i' forall a. Num a => a -> a -> a
* Word8
55 forall a. Num a => a -> a -> a
+ Word8
40 forall a. Num a => a -> a -> a
* Word8
i'

-- | Helper function for showing all the colors in a color cube. This is used
-- for debugging.
showColourCube :: Matrix (AlphaColour Double) -> String
showColourCube :: Matrix (AlphaColour Double) -> String
showColourCube Matrix (AlphaColour Double)
matrix =
  let itemList :: [AlphaColour Double]
itemList = (forall a. Monoid a => [a] -> a
mconcat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => [a] -> a
mconcat) forall a b. (a -> b) -> a -> b
$ forall a. Matrix a -> [[[a]]]
getMatrix Matrix (AlphaColour Double)
matrix
  in [AlphaColour Double] -> ShowS
showSColourCube [AlphaColour Double]
itemList String
""
  where
    showSColourCube :: [AlphaColour Double] -> String -> String
    showSColourCube :: [AlphaColour Double] -> ShowS
showSColourCube [AlphaColour Double]
itemList =
      String -> ShowS
showString String
"[ " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> [AlphaColour Double] -> ShowS
showSquare Int
0 [AlphaColour Double]
itemList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> [AlphaColour Double] -> ShowS
showSquare Int
1 [AlphaColour Double]
itemList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> [AlphaColour Double] -> ShowS
showSquare Int
2 [AlphaColour Double]
itemList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> [AlphaColour Double] -> ShowS
showSquare Int
3 [AlphaColour Double]
itemList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> [AlphaColour Double] -> ShowS
showSquare Int
4 [AlphaColour Double]
itemList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> [AlphaColour Double] -> ShowS
showSquare Int
5 [AlphaColour Double]
itemList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
"]"

    showSquare :: Int -> [AlphaColour Double] -> String -> String
    showSquare :: Int -> [AlphaColour Double] -> ShowS
showSquare Int
i [AlphaColour Double]
colours =
      String -> ShowS
showString String
"[ " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
0 [AlphaColour Double]
colours forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
1 [AlphaColour Double]
colours forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
2 [AlphaColour Double]
colours forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
3 [AlphaColour Double]
colours forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
4 [AlphaColour Double]
colours forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
5 [AlphaColour Double]
colours forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
"]\n"

    showRow :: Int -> Int -> [AlphaColour Double] -> String -> String
    showRow :: Int -> Int -> [AlphaColour Double] -> ShowS
showRow Int
i Int
j [AlphaColour Double]
colours =
      AlphaColour Double -> ShowS
showCol (forall mono. MonoFoldable mono => mono -> Element mono
headEx forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i forall a. Num a => a -> a -> a
* Int
36 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
* Int
6 forall a. Num a => a -> a -> a
+ Int
0) [AlphaColour Double]
colours) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      AlphaColour Double -> ShowS
showCol (forall mono. MonoFoldable mono => mono -> Element mono
headEx forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i forall a. Num a => a -> a -> a
* Int
36 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
* Int
6 forall a. Num a => a -> a -> a
+ Int
1) [AlphaColour Double]
colours) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      AlphaColour Double -> ShowS
showCol (forall mono. MonoFoldable mono => mono -> Element mono
headEx forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i forall a. Num a => a -> a -> a
* Int
36 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
* Int
6 forall a. Num a => a -> a -> a
+ Int
2) [AlphaColour Double]
colours) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      AlphaColour Double -> ShowS
showCol (forall mono. MonoFoldable mono => mono -> Element mono
headEx forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i forall a. Num a => a -> a -> a
* Int
36 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
* Int
6 forall a. Num a => a -> a -> a
+ Int
3) [AlphaColour Double]
colours) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      AlphaColour Double -> ShowS
showCol (forall mono. MonoFoldable mono => mono -> Element mono
headEx forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i forall a. Num a => a -> a -> a
* Int
36 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
* Int
6 forall a. Num a => a -> a -> a
+ Int
4) [AlphaColour Double]
colours) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
", " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      AlphaColour Double -> ShowS
showCol (forall mono. MonoFoldable mono => mono -> Element mono
headEx forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i forall a. Num a => a -> a -> a
* Int
36 forall a. Num a => a -> a -> a
+ Int
j forall a. Num a => a -> a -> a
* Int
6 forall a. Num a => a -> a -> a
+ Int
5) [AlphaColour Double]
colours) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      String -> ShowS
showString String
"\n  "

    showCol :: AlphaColour Double -> String -> String
    showCol :: AlphaColour Double -> ShowS
showCol AlphaColour Double
col String
str = AlphaColour Double -> String
sRGB32show AlphaColour Double
col forall a. Semigroup a => a -> a -> a
<> String
str

-- | A List of a grey scale.  Default value for 'FullPalette'.
--
-- >>> fmap sRGB32show defaultGreyscale
-- List24 {getList24 = ["#080808ff","#121212ff","#1c1c1cff","#262626ff","#303030ff","#3a3a3aff","#444444ff","#4e4e4eff","#585858ff","#626262ff","#6c6c6cff","#767676ff","#808080ff","#8a8a8aff","#949494ff","#9e9e9eff","#a8a8a8ff","#b2b2b2ff","#bcbcbcff","#c6c6c6ff","#d0d0d0ff","#dadadaff","#e4e4e4ff","#eeeeeeff"]}
defaultGreyscale :: (Ord b, Floating b) => List24 (AlphaColour b)
defaultGreyscale :: forall b. (Ord b, Floating b) => List24 (AlphaColour b)
defaultGreyscale = forall a. [a] -> List24 a
unsafeMkList24 forall a b. (a -> b) -> a -> b
$ do
  Word8
n <- [Word8
0..Word8
23]
  let l :: Word8
l = Word8
8 forall a. Num a => a -> a -> a
+ Word8
10 forall a. Num a => a -> a -> a
* Word8
n
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a b. (a -> b) -> a -> b
$ forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
l Word8
l Word8
l

-- | The configuration for the colors used by Termonad.
--
-- 'foregroundColour' and 'backgroundColour' allow you to set the color of the
-- foreground text and background of the terminal.
--
-- 'highlightFgColour' and 'highlightBgColour' allow you to set the color of
-- the foreground and background of the highlighted text.
--
-- 'palette' allows you to set the full color palette used by the terminal.
-- See 'Palette' for more information.
--
-- If you don't set 'foregroundColour', 'backgroundColour', 'highlightFgColour',
-- 'highlightBgColour', or 'palette', the defaults from VTE are used.
--
-- If you want to use a terminal with a white (or light) background and a black
-- foreground, it may be a good idea to change some of the colors in the
-- 'Palette' as well.
--
-- VTE works as follows: if you don't explicitly set a background or foreground color,
-- it takes the 0th colour from the 'palette' to be the background color, and the 7th
-- colour from the 'palette' to be the foreground color.  If you notice oddities with
-- colouring in certain applications, it may be helpful to make sure that these
-- 'palette' colours match up with the 'backgroundColour' and 'foregroundColour' you
-- have set.)
--
-- 'cursorFgColour' and 'cursorBgColour' allow you to set the foreground color
-- of the text under the cursor, as well as the color of the cursor itself.
--
-- Termonad will behave differently depending on the combination
-- 'cursorFgColour' and 'cursorBgColour' being 'Set' vs. 'Unset'.
-- Here is the summary of the different possibilities:
--
-- * 'cursorFgColour' is 'Set' and 'cursorBgColour' is 'Set'
--
--     The foreground and background colors of the cursor are as you have set.
--
-- * 'cursorFgColour' is 'Set' and 'cursorBgColour' is 'Unset'
--
--     The cursor background color turns completely black so that it is not
--     visible.  The foreground color of the cursor is the color that you have
--     'Set'.  This ends up being mostly unusable, so you are recommended to
--     always 'Set' 'cursorBgColour' when you have 'Set' 'cursorFgColour'.
--
-- * 'cursorFgColour' is 'Unset' and 'cursorBgColour' is 'Set'
--
--     The cursor background color becomes the color you 'Set', while the cursor
--     foreground color doesn't change from the letter it is over.  For instance,
--     imagine there is a letter on the screen with a black background and a
--     green foreground.  If you bring the cursor overtop of it, the cursor
--     background will be the color you have 'Set', while the cursor foreground
--     will be green.
--
--     This is completely usable, but is slightly annoying if you place the cursor
--     over a letter with the same foreground color as the cursor's background
--     color, because the letter will not be readable. For instance, imagine you
--     have set your cursor background color to red, and somewhere on the screen
--     there is a letter with a black background and a red foreground. If you move
--     your cursor over the letter, the background of the cursor will be red (as
--     you have set), and the cursor foreground will be red (to match the original
--     foreground color of the letter). This will make it so you can't
--     actually read the letter, because the foreground and background are both
--     red.
--
-- * 'cursorFgColour' is 'Unset' and 'cursorBgColour' is 'Unset'
--
--     This combination makes the cursor inverse of whatever text it is over.
--     If your cursor is over red text with a black background, the cursor
--     background will be red and the cursor foreground will be black.
--
--     This is the default.
--
-- 'cursorFgColour' is not supported in @vte-2.91@ versions older than 0.44.
-- (This is somewhat confusing. Note that @vte-2.91@ is the name of the system
-- library, and @0.44@ is its version number.)
--
-- See 'defaultColourConfig' for the defaults for 'ColourConfig' used in Termonad.
data ColourConfig c = ColourConfig
  { forall c. ColourConfig c -> Option c
cursorFgColour :: !(Option c)
    -- ^ Foreground color of the cursor.  This is the color of the text that
    -- the cursor is over.  This is not supported on older versions of VTE.
  , forall c. ColourConfig c -> Option c
cursorBgColour :: !(Option c)
    -- ^ Background color of the cursor.  This is the color of the cursor
    -- itself.
  , forall c. ColourConfig c -> Option c
foregroundColour :: !(Option c)
    -- ^ Color of the default foreground text in the terminal.
  , forall c. ColourConfig c -> Option c
backgroundColour :: !(Option c)
    -- ^ Background color for the terminal
  , forall c. ColourConfig c -> Option c
highlightFgColour :: !(Option c)
    -- ^ Foreground color for the highlighted text.
  , forall c. ColourConfig c -> Option c
highlightBgColour :: !(Option c)
    -- ^ Background color for the highlighted text.
  , forall c. ColourConfig c -> Palette c
palette :: !(Palette c)
    -- ^ Color palette for the terminal.  See 'Palette'.
  } deriving (ColourConfig c -> ColourConfig c -> Bool
forall c. Eq c => ColourConfig c -> ColourConfig c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColourConfig c -> ColourConfig c -> Bool
$c/= :: forall c. Eq c => ColourConfig c -> ColourConfig c -> Bool
== :: ColourConfig c -> ColourConfig c -> Bool
$c== :: forall c. Eq c => ColourConfig c -> ColourConfig c -> Bool
Eq, Int -> ColourConfig c -> ShowS
forall c. Show c => Int -> ColourConfig c -> ShowS
forall c. Show c => [ColourConfig c] -> ShowS
forall c. Show c => ColourConfig c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColourConfig c] -> ShowS
$cshowList :: forall c. Show c => [ColourConfig c] -> ShowS
show :: ColourConfig c -> String
$cshow :: forall c. Show c => ColourConfig c -> String
showsPrec :: Int -> ColourConfig c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> ColourConfig c -> ShowS
Show, forall a b. a -> ColourConfig b -> ColourConfig a
forall a b. (a -> b) -> ColourConfig a -> ColourConfig b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ColourConfig b -> ColourConfig a
$c<$ :: forall a b. a -> ColourConfig b -> ColourConfig a
fmap :: forall a b. (a -> b) -> ColourConfig a -> ColourConfig b
$cfmap :: forall a b. (a -> b) -> ColourConfig a -> ColourConfig b
Functor)

-- | Default setting for a 'ColourConfig'.  The cursor colors, font foreground
-- color, background color, highlighted text color, and color palette are all
-- left at the defaults set by VTE.
--
-- >>> defaultColourConfig
-- ColourConfig {cursorFgColour = Unset, cursorBgColour = Unset, foregroundColour = Unset, backgroundColour = Unset, highlightFgColour = Unset, highlightBgColour = Unset, palette = NoPalette}
defaultColourConfig :: ColourConfig (AlphaColour Double)
defaultColourConfig :: ColourConfig (AlphaColour Double)
defaultColourConfig = ColourConfig
  { cursorFgColour :: Option (AlphaColour Double)
cursorFgColour = forall a. Option a
Unset
  , cursorBgColour :: Option (AlphaColour Double)
cursorBgColour = forall a. Option a
Unset
  , foregroundColour :: Option (AlphaColour Double)
foregroundColour = forall a. Option a
Unset
  , backgroundColour :: Option (AlphaColour Double)
backgroundColour = forall a. Option a
Unset
  , highlightFgColour :: Option (AlphaColour Double)
highlightFgColour = forall a. Option a
Unset
  , highlightBgColour :: Option (AlphaColour Double)
highlightBgColour = forall a. Option a
Unset
  , palette :: Palette (AlphaColour Double)
palette = forall c. Palette c
NoPalette
  }

$(makeLensesFor
    [ ("cursorFgColour", "lensCursorFgColour")
    , ("cursorBgColour", "lensCursorBgColour")
    , ("foregroundColour", "lensForegroundColour")
    , ("backgroundColour", "lensBackgroundColour")
    , ("highlightFgColour", "lensHighlightFgColour")
    , ("highlightBgColour", "lensHighlightBgColour")
    , ("palette", "lensPalette")
    ]
    ''ColourConfig
 )

------------------------------
-- ConfigExtension Instance --
------------------------------

-- | Extension that allows setting colors for terminals in Termonad.
data ColourExtension = ColourExtension
  { ColourExtension -> MVar (ColourConfig (AlphaColour Double))
colourExtConf :: MVar (ColourConfig (AlphaColour Double))
    -- ^ 'MVar' holding the current 'ColourConfig'.  This could potentially be
    -- passed to other extensions or user code.  This would allow changing the
    -- colors for new terminals in realtime.
  , ColourExtension -> TMState -> Terminal -> IO ()
colourExtCreateTermHook :: TMState -> Terminal -> IO ()
    -- ^ The 'createTermHook' used by the 'ColourExtension'.  This sets the
    -- colors for a new terminal based on the 'ColourConfig' in 'colourExtConf'.
  }

-- | The default 'createTermHook' for 'colourExtCreateTermHook'.  Set the colors
-- for a terminal based on the given 'ColourConfig'.
colourHook :: MVar (ColourConfig (AlphaColour Double)) -> TMState -> Terminal -> IO ()
colourHook :: MVar (ColourConfig (AlphaColour Double))
-> TMState -> Terminal -> IO ()
colourHook MVar (ColourConfig (AlphaColour Double))
mvarColourConf TMState
_ Terminal
vteTerm = do
  ColourConfig (AlphaColour Double)
colourConf <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar (ColourConfig (AlphaColour Double))
mvarColourConf
  let paletteColourList :: [AlphaColour Double]
paletteColourList = forall a. Palette a -> [a]
paletteToList forall a b. (a -> b) -> a -> b
$ forall c. ColourConfig c -> Palette c
palette ColourConfig (AlphaColour Double)
colourConf
  [RGBA]
rgbaPaletteColourList <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse AlphaColour Double -> IO RGBA
colourToRgba [AlphaColour Double]
paletteColourList
  forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe RGBA -> Maybe RGBA -> Maybe [RGBA] -> m ()
terminalSetColors Terminal
vteTerm forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just [RGBA]
rgbaPaletteColourList)
  forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (forall c. ColourConfig c -> Option c
backgroundColour ColourConfig (AlphaColour Double)
colourConf) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> RGBA -> m ()
terminalSetColorBackground Terminal
vteTerm forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba
  forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (forall c. ColourConfig c -> Option c
foregroundColour ColourConfig (AlphaColour Double)
colourConf) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> RGBA -> m ()
terminalSetColorForeground Terminal
vteTerm forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba
  forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (forall c. ColourConfig c -> Option c
cursorBgColour ColourConfig (AlphaColour Double)
colourConf) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe RGBA -> m ()
terminalSetColorCursor Terminal
vteTerm forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba
#ifdef VTE_VERSION_GEQ_0_44
  whenSet (cursorFgColour colourConf) $
    terminalSetColorCursorForeground vteTerm . Just <=< colourToRgba
#endif
  forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (forall c. ColourConfig c -> Option c
highlightFgColour ColourConfig (AlphaColour Double)
colourConf) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe RGBA -> m ()
terminalSetColorHighlightForeground Terminal
vteTerm forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba
  forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (forall c. ColourConfig c -> Option c
highlightBgColour ColourConfig (AlphaColour Double)
colourConf) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe RGBA -> m ()
terminalSetColorHighlight Terminal
vteTerm forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba

colourToRgba :: AlphaColour Double -> IO RGBA
colourToRgba :: AlphaColour Double -> IO RGBA
colourToRgba AlphaColour Double
colour = do
  let RGB Double
red Double
green Double
blue = forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB forall a b. (a -> b) -> a -> b
$ AlphaColour Double -> Colour Double
pureColour AlphaColour Double
colour
      alpha :: Double
alpha = forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
colour
  RGBA
rgba <- forall (m :: * -> *). MonadIO m => m RGBA
newZeroRGBA
  forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBARed RGBA
rgba Double
red
  forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBAGreen RGBA
rgba Double
green
  forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBABlue RGBA
rgba Double
blue
  forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBAAlpha RGBA
rgba Double
alpha
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RGBA
rgba

-- | Create a 'ColourExtension' based on a given 'ColourConfig'.
--
-- Most users will want to use this.
createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension ColourConfig (AlphaColour Double)
conf = do
  MVar (ColourConfig (AlphaColour Double))
mvarConf <- forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar ColourConfig (AlphaColour Double)
conf
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    ColourExtension
      { colourExtConf :: MVar (ColourConfig (AlphaColour Double))
colourExtConf = MVar (ColourConfig (AlphaColour Double))
mvarConf
      , colourExtCreateTermHook :: TMState -> Terminal -> IO ()
colourExtCreateTermHook = MVar (ColourConfig (AlphaColour Double))
-> TMState -> Terminal -> IO ()
colourHook MVar (ColourConfig (AlphaColour Double))
mvarConf
      }

-- | Create a 'ColourExtension' based on 'defaultColourConfig'.
--
-- Note that this is not needed if you just want to use the default colors for
-- Termonad.  However, if you want to pass around the 'MVar' 'ColourConfig' for
-- extensions to use, then you may need this function.
createDefColourExtension :: IO ColourExtension
createDefColourExtension :: IO ColourExtension
createDefColourExtension = ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension ColourConfig (AlphaColour Double)
defaultColourConfig

-- | Add a given 'ColourConfig' to a 'TMConfig'.  This adds 'colourHook' to the
-- 'createTermHook' in 'TMConfig'.
addColourConfig :: TMConfig -> ColourConfig (AlphaColour Double) -> IO TMConfig
addColourConfig :: TMConfig -> ColourConfig (AlphaColour Double) -> IO TMConfig
addColourConfig TMConfig
tmConf ColourConfig (AlphaColour Double)
colConf = do
  ColourExtension MVar (ColourConfig (AlphaColour Double))
_ TMState -> Terminal -> IO ()
newHook <- ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension ColourConfig (AlphaColour Double)
colConf
  let newTMConf :: TMConfig
newTMConf = TMConfig
tmConf forall a b. a -> (a -> b) -> b
& Lens' TMConfig ConfigHooks
lensHooks forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Iso' ConfigHooks (TMState -> Terminal -> IO ())
lensCreateTermHook forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TMState -> Terminal -> IO ())
-> (TMState -> Terminal -> IO ()) -> TMState -> Terminal -> IO ()
addColourHook TMState -> Terminal -> IO ()
newHook
  forall (f :: * -> *) a. Applicative f => a -> f a
pure TMConfig
newTMConf

-- | This is similar to 'addColourConfig', but can be used on a
-- 'ColourExtension' created with 'createColourExtension'.
addColourExtension :: TMConfig -> ColourExtension -> TMConfig
addColourExtension :: TMConfig -> ColourExtension -> TMConfig
addColourExtension TMConfig
tmConf (ColourExtension MVar (ColourConfig (AlphaColour Double))
_ TMState -> Terminal -> IO ()
newHook) =
  TMConfig
tmConf forall a b. a -> (a -> b) -> b
& Lens' TMConfig ConfigHooks
lensHooks forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Iso' ConfigHooks (TMState -> Terminal -> IO ())
lensCreateTermHook forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TMState -> Terminal -> IO ())
-> (TMState -> Terminal -> IO ()) -> TMState -> Terminal -> IO ()
addColourHook TMState -> Terminal -> IO ()
newHook

-- | This function shows how to combine 'createTermHook's.
--
-- This first runs the old hook, followed by the new hook.
--
-- This is used internally by 'addColourConfig' and 'addColourExtension'.
addColourHook
  :: (TMState -> Terminal -> IO ()) -- ^ New hook
  -> (TMState -> Terminal -> IO ()) -- ^ Old hook
  -> TMState
  -> Terminal
  -> IO ()
addColourHook :: (TMState -> Terminal -> IO ())
-> (TMState -> Terminal -> IO ()) -> TMState -> Terminal -> IO ()
addColourHook TMState -> Terminal -> IO ()
newHook TMState -> Terminal -> IO ()
oldHook TMState
tmState Terminal
term = do
  TMState -> Terminal -> IO ()
oldHook TMState
tmState Terminal
term
  TMState -> Terminal -> IO ()
newHook TMState
tmState Terminal
term