{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Termonad.Config.Colour
(
ColourConfig(..)
, defaultColourConfig
, List8
, List6
, List24
, Matrix
, mkList8
, unsafeMkList8
, setAtList8
, overAtList8
, mkList6
, unsafeMkList6
, setAtList6
, overAtList6
, mkList24
, unsafeMkList24
, setAtList24
, overAtList24
, mkMatrix
, unsafeMkMatrix
, setAtMatrix
, overAtMatrix
, lensCursorFgColour
, lensCursorBgColour
, lensForegroundColour
, lensBackgroundColour
, lensHighlightFgColour
, lensHighlightBgColour
, lensPalette
, ColourExtension(..)
, createColourExtension
, createDefColourExtension
, addColourExtension
, addColourConfig
, colourHook
, addColourHook
, Palette(..)
, defaultStandardColours
, defaultLightColours
, defaultColourCube
, defaultGreyscale
, AlphaColour
, createColour
, sRGB32
, sRGB32show
, opaque
, transparent
, showColourVec
, showColourCube
, paletteToList
, coloursFromBits
, cube
, setAt
, overAt
) 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
)
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)
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
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."
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)
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
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)
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)
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)
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
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."
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)
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)
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)
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
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"
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)
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)
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
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
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"
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)
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)
data Palette c
= NoPalette
| BasicPalette !(List8 c)
| ExtendedPalette !(List8 c) !(List8 c)
| ColourCubePalette !(List8 c) !(List8 c) !(Matrix c)
| FullPalette !(List8 c) !(List8 c) !(Matrix c) !(List24 c)
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)
paletteToList :: Palette c -> [c]
paletteToList :: forall a. Palette a -> [a]
paletteToList = forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
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]]
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
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
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
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
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
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)
sRGB32
:: Word8
-> Word8
-> Word8
-> Word8
-> 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
createColour
:: Word8
-> Word8
-> Word8
-> 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
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
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
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'
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
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
data ColourConfig c = ColourConfig
{ forall c. ColourConfig c -> Option c
cursorFgColour :: !(Option c)
, forall c. ColourConfig c -> Option c
cursorBgColour :: !(Option c)
, forall c. ColourConfig c -> Option c
foregroundColour :: !(Option c)
, forall c. ColourConfig c -> Option c
backgroundColour :: !(Option c)
, forall c. ColourConfig c -> Option c
highlightFgColour :: !(Option c)
, forall c. ColourConfig c -> Option c
highlightBgColour :: !(Option c)
, forall c. ColourConfig c -> Palette c
palette :: !(Palette c)
} 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)
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
)
data ColourExtension = ColourExtension
{ ColourExtension -> MVar (ColourConfig (AlphaColour Double))
colourExtConf :: MVar (ColourConfig (AlphaColour Double))
, ColourExtension -> TMState -> Terminal -> IO ()
colourExtCreateTermHook :: TMState -> Terminal -> IO ()
}
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
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
}
createDefColourExtension :: IO ColourExtension
createDefColourExtension :: IO ColourExtension
createDefColourExtension = ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension ColourConfig (AlphaColour Double)
defaultColourConfig
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
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
addColourHook
:: (TMState -> Terminal -> IO ())
-> (TMState -> Terminal -> IO ())
-> 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