{-# 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
, 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
)
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 { List8 a -> [a]
getList8 :: [a] }
deriving (Int -> List8 a -> ShowS
[List8 a] -> ShowS
List8 a -> String
(Int -> List8 a -> ShowS)
-> (List8 a -> String) -> ([List8 a] -> ShowS) -> Show (List8 a)
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
(List8 a -> List8 a -> Bool)
-> (List8 a -> List8 a -> Bool) -> Eq (List8 a)
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, List8 a -> Bool
(a -> m) -> List8 a -> m
(a -> b -> b) -> b -> List8 a -> b
(forall m. Monoid m => List8 m -> m)
-> (forall m a. Monoid m => (a -> m) -> List8 a -> m)
-> (forall m a. Monoid m => (a -> m) -> List8 a -> m)
-> (forall a b. (a -> b -> b) -> b -> List8 a -> b)
-> (forall a b. (a -> b -> b) -> b -> List8 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List8 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List8 a -> b)
-> (forall a. (a -> a -> a) -> List8 a -> a)
-> (forall a. (a -> a -> a) -> List8 a -> a)
-> (forall a. List8 a -> [a])
-> (forall a. List8 a -> Bool)
-> (forall a. List8 a -> Int)
-> (forall a. Eq a => a -> List8 a -> Bool)
-> (forall a. Ord a => List8 a -> a)
-> (forall a. Ord a => List8 a -> a)
-> (forall a. Num a => List8 a -> a)
-> (forall a. Num a => List8 a -> a)
-> Foldable List8
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 :: List8 a -> a
$cproduct :: forall a. Num a => List8 a -> a
sum :: List8 a -> a
$csum :: forall a. Num a => List8 a -> a
minimum :: List8 a -> a
$cminimum :: forall a. Ord a => List8 a -> a
maximum :: List8 a -> a
$cmaximum :: forall a. Ord a => List8 a -> a
elem :: a -> List8 a -> Bool
$celem :: forall a. Eq a => a -> List8 a -> Bool
length :: List8 a -> Int
$clength :: forall a. List8 a -> Int
null :: List8 a -> Bool
$cnull :: forall a. List8 a -> Bool
toList :: List8 a -> [a]
$ctoList :: forall a. List8 a -> [a]
foldl1 :: (a -> a -> a) -> List8 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List8 a -> a
foldr1 :: (a -> a -> a) -> List8 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List8 a -> a
foldl' :: (b -> a -> b) -> b -> List8 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List8 a -> b
foldl :: (b -> a -> b) -> b -> List8 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List8 a -> b
foldr' :: (a -> b -> b) -> b -> List8 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List8 a -> b
foldr :: (a -> b -> b) -> b -> List8 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List8 a -> b
foldMap' :: (a -> m) -> List8 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List8 a -> m
foldMap :: (a -> m) -> List8 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List8 a -> m
fold :: List8 m -> m
$cfold :: forall m. Monoid m => List8 m -> m
Foldable, a -> List8 b -> List8 a
(a -> b) -> List8 a -> List8 b
(forall a b. (a -> b) -> List8 a -> List8 b)
-> (forall a b. a -> List8 b -> List8 a) -> Functor List8
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
<$ :: a -> List8 b -> List8 a
$c<$ :: forall a b. a -> List8 b -> List8 a
fmap :: (a -> b) -> List8 a -> List8 b
$cfmap :: forall a b. (a -> b) -> List8 a -> List8 b
Functor)
mkList8 :: [a] -> Maybe (List8 a)
mkList8 :: [a] -> Maybe (List8 a)
mkList8 xs :: [a]
xs = if [a] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 8 then List8 a -> Maybe (List8 a)
forall a. a -> Maybe a
Just ([a] -> List8 a
forall a. [a] -> List8 a
List8 [a]
xs) else Maybe (List8 a)
forall a. Maybe a
Nothing
unsafeMkList8 :: [a] -> List8 a
unsafeMkList8 :: [a] -> List8 a
unsafeMkList8 xs :: [a]
xs =
case [a] -> Maybe (List8 a)
forall a. [a] -> Maybe (List8 a)
mkList8 [a]
xs of
Just xs' :: List8 a
xs' -> List8 a
xs'
Nothing ->
String -> List8 a
forall a. HasCallStack => String -> a
error (String -> List8 a) -> String -> List8 a
forall a b. (a -> b) -> a -> b
$
"unsafeMkList8: input list contains " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [a]
xs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
" elements. Must contain exactly 8 elements."
setAt :: forall a. Int -> a -> [a] -> [a]
setAt :: Int -> a -> [a] -> [a]
setAt n :: Int
n newVal :: a
newVal = Int -> (a -> a) -> [a] -> [a]
forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n (\_ -> a
newVal)
overAt :: forall a. Int -> (a -> a) -> [a] -> [a]
overAt :: Int -> (a -> a) -> [a] -> [a]
overAt n :: Int
n f :: a -> a
f = (Element [(Int, a)] -> [a] -> [a]) -> [a] -> [(Int, a)] -> [a]
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr (Int, a) -> [a] -> [a]
Element [(Int, a)] -> [a] -> [a]
go [] ([(Int, a)] -> [a]) -> ([a] -> [(Int, 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
. [Int] -> [a] -> [(Int, a)]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [0..]
where
go :: (Int, a) -> [a] -> [a]
go :: (Int, a) -> [a] -> [a]
go (i :: Int
i, a :: a
a) next :: [a]
next
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = a -> a
f a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
next
| Bool
otherwise = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
next
setAtList8 :: Int -> a -> List8 a -> List8 a
setAtList8 :: Int -> a -> List8 a -> List8 a
setAtList8 n :: Int
n a :: a
a (List8 l :: [a]
l) = [a] -> List8 a
forall a. [a] -> List8 a
List8 (Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
setAt Int
n a
a [a]
l)
overAtList8 :: Int -> (a -> a) -> List8 a -> List8 a
overAtList8 :: Int -> (a -> a) -> List8 a -> List8 a
overAtList8 n :: Int
n f :: a -> a
f (List8 l :: [a]
l) = [a] -> List8 a
forall a. [a] -> List8 a
List8 (Int -> (a -> a) -> [a] -> [a]
forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n a -> a
f [a]
l)
newtype List6 a = List6 { List6 a -> [a]
getList6 :: [a] }
deriving (Int -> List6 a -> ShowS
[List6 a] -> ShowS
List6 a -> String
(Int -> List6 a -> ShowS)
-> (List6 a -> String) -> ([List6 a] -> ShowS) -> Show (List6 a)
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
(List6 a -> List6 a -> Bool)
-> (List6 a -> List6 a -> Bool) -> Eq (List6 a)
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, List6 a -> Bool
(a -> m) -> List6 a -> m
(a -> b -> b) -> b -> List6 a -> b
(forall m. Monoid m => List6 m -> m)
-> (forall m a. Monoid m => (a -> m) -> List6 a -> m)
-> (forall m a. Monoid m => (a -> m) -> List6 a -> m)
-> (forall a b. (a -> b -> b) -> b -> List6 a -> b)
-> (forall a b. (a -> b -> b) -> b -> List6 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List6 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List6 a -> b)
-> (forall a. (a -> a -> a) -> List6 a -> a)
-> (forall a. (a -> a -> a) -> List6 a -> a)
-> (forall a. List6 a -> [a])
-> (forall a. List6 a -> Bool)
-> (forall a. List6 a -> Int)
-> (forall a. Eq a => a -> List6 a -> Bool)
-> (forall a. Ord a => List6 a -> a)
-> (forall a. Ord a => List6 a -> a)
-> (forall a. Num a => List6 a -> a)
-> (forall a. Num a => List6 a -> a)
-> Foldable List6
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 :: List6 a -> a
$cproduct :: forall a. Num a => List6 a -> a
sum :: List6 a -> a
$csum :: forall a. Num a => List6 a -> a
minimum :: List6 a -> a
$cminimum :: forall a. Ord a => List6 a -> a
maximum :: List6 a -> a
$cmaximum :: forall a. Ord a => List6 a -> a
elem :: a -> List6 a -> Bool
$celem :: forall a. Eq a => a -> List6 a -> Bool
length :: List6 a -> Int
$clength :: forall a. List6 a -> Int
null :: List6 a -> Bool
$cnull :: forall a. List6 a -> Bool
toList :: List6 a -> [a]
$ctoList :: forall a. List6 a -> [a]
foldl1 :: (a -> a -> a) -> List6 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List6 a -> a
foldr1 :: (a -> a -> a) -> List6 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List6 a -> a
foldl' :: (b -> a -> b) -> b -> List6 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List6 a -> b
foldl :: (b -> a -> b) -> b -> List6 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List6 a -> b
foldr' :: (a -> b -> b) -> b -> List6 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List6 a -> b
foldr :: (a -> b -> b) -> b -> List6 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List6 a -> b
foldMap' :: (a -> m) -> List6 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List6 a -> m
foldMap :: (a -> m) -> List6 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List6 a -> m
fold :: List6 m -> m
$cfold :: forall m. Monoid m => List6 m -> m
Foldable, a -> List6 b -> List6 a
(a -> b) -> List6 a -> List6 b
(forall a b. (a -> b) -> List6 a -> List6 b)
-> (forall a b. a -> List6 b -> List6 a) -> Functor List6
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
<$ :: a -> List6 b -> List6 a
$c<$ :: forall a b. a -> List6 b -> List6 a
fmap :: (a -> b) -> List6 a -> List6 b
$cfmap :: forall a b. (a -> b) -> List6 a -> List6 b
Functor)
mkList6 :: [a] -> Maybe (List6 a)
mkList6 :: [a] -> Maybe (List6 a)
mkList6 xs :: [a]
xs = if [a] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 6 then List6 a -> Maybe (List6 a)
forall a. a -> Maybe a
Just ([a] -> List6 a
forall a. [a] -> List6 a
List6 [a]
xs) else Maybe (List6 a)
forall a. Maybe a
Nothing
unsafeMkList6 :: [a] -> List6 a
unsafeMkList6 :: [a] -> List6 a
unsafeMkList6 xs :: [a]
xs =
case [a] -> Maybe (List6 a)
forall a. [a] -> Maybe (List6 a)
mkList6 [a]
xs of
Just xs' :: List6 a
xs' -> List6 a
xs'
Nothing ->
String -> List6 a
forall a. HasCallStack => String -> a
error (String -> List6 a) -> String -> List6 a
forall a b. (a -> b) -> a -> b
$
"unsafeMkList6: input list contains " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [a]
xs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
" elements. Must contain exactly 6 elements."
setAtList6 :: Int -> a -> List6 a -> List6 a
setAtList6 :: Int -> a -> List6 a -> List6 a
setAtList6 n :: Int
n a :: a
a (List6 l :: [a]
l) = [a] -> List6 a
forall a. [a] -> List6 a
List6 (Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
setAt Int
n a
a [a]
l)
overAtList6 :: Int -> (a -> a) -> List6 a -> List6 a
overAtList6 :: Int -> (a -> a) -> List6 a -> List6 a
overAtList6 n :: Int
n f :: a -> a
f (List6 l :: [a]
l) = [a] -> List6 a
forall a. [a] -> List6 a
List6 (Int -> (a -> a) -> [a] -> [a]
forall a. Int -> (a -> a) -> [a] -> [a]
overAt Int
n a -> a
f [a]
l)
newtype List24 a = List24 { List24 a -> [a]
getList24 :: [a] }
deriving (Int -> List24 a -> ShowS
[List24 a] -> ShowS
List24 a -> String
(Int -> List24 a -> ShowS)
-> (List24 a -> String) -> ([List24 a] -> ShowS) -> Show (List24 a)
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
(List24 a -> List24 a -> Bool)
-> (List24 a -> List24 a -> Bool) -> Eq (List24 a)
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, List24 a -> Bool
(a -> m) -> List24 a -> m
(a -> b -> b) -> b -> List24 a -> b
(forall m. Monoid m => List24 m -> m)
-> (forall m a. Monoid m => (a -> m) -> List24 a -> m)
-> (forall m a. Monoid m => (a -> m) -> List24 a -> m)
-> (forall a b. (a -> b -> b) -> b -> List24 a -> b)
-> (forall a b. (a -> b -> b) -> b -> List24 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List24 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List24 a -> b)
-> (forall a. (a -> a -> a) -> List24 a -> a)
-> (forall a. (a -> a -> a) -> List24 a -> a)
-> (forall a. List24 a -> [a])
-> (forall a. List24 a -> Bool)
-> (forall a. List24 a -> Int)
-> (forall a. Eq a => a -> List24 a -> Bool)
-> (forall a. Ord a => List24 a -> a)
-> (forall a. Ord a => List24 a -> a)
-> (forall a. Num a => List24 a -> a)
-> (forall a. Num a => List24 a -> a)
-> Foldable List24
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 :: List24 a -> a
$cproduct :: forall a. Num a => List24 a -> a
sum :: List24 a -> a
$csum :: forall a. Num a => List24 a -> a
minimum :: List24 a -> a
$cminimum :: forall a. Ord a => List24 a -> a
maximum :: List24 a -> a
$cmaximum :: forall a. Ord a => List24 a -> a
elem :: a -> List24 a -> Bool
$celem :: forall a. Eq a => a -> List24 a -> Bool
length :: List24 a -> Int
$clength :: forall a. List24 a -> Int
null :: List24 a -> Bool
$cnull :: forall a. List24 a -> Bool
toList :: List24 a -> [a]
$ctoList :: forall a. List24 a -> [a]
foldl1 :: (a -> a -> a) -> List24 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List24 a -> a
foldr1 :: (a -> a -> a) -> List24 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List24 a -> a
foldl' :: (b -> a -> b) -> b -> List24 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List24 a -> b
foldl :: (b -> a -> b) -> b -> List24 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List24 a -> b
foldr' :: (a -> b -> b) -> b -> List24 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List24 a -> b
foldr :: (a -> b -> b) -> b -> List24 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List24 a -> b
foldMap' :: (a -> m) -> List24 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List24 a -> m
foldMap :: (a -> m) -> List24 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List24 a -> m
fold :: List24 m -> m
$cfold :: forall m. Monoid m => List24 m -> m
Foldable, a -> List24 b -> List24 a
(a -> b) -> List24 a -> List24 b
(forall a b. (a -> b) -> List24 a -> List24 b)
-> (forall a b. a -> List24 b -> List24 a) -> Functor List24
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
<$ :: a -> List24 b -> List24 a
$c<$ :: forall a b. a -> List24 b -> List24 a
fmap :: (a -> b) -> List24 a -> List24 b
$cfmap :: forall a b. (a -> b) -> List24 a -> List24 b
Functor)
mkList24 :: [a] -> Maybe (List24 a)
mkList24 :: [a] -> Maybe (List24 a)
mkList24 xs :: [a]
xs = if [a] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 24 then List24 a -> Maybe (List24 a)
forall a. a -> Maybe a
Just ([a] -> List24 a
forall a. [a] -> List24 a
List24 [a]
xs) else Maybe (List24 a)
forall a. Maybe a
Nothing
unsafeMkList24 :: [a] -> List24 a
unsafeMkList24 :: [a] -> List24 a
unsafeMkList24 xs :: [a]
xs =
case [a] -> Maybe (List24 a)
forall a. [a] -> Maybe (List24 a)
mkList24 [a]
xs of
Just xs' :: List24 a
xs' -> List24 a
xs'
Nothing -> String -> List24 a
forall a. HasCallStack => String -> a
error "List must contain 24 elements"
setAtList24 :: Int -> a -> List24 a -> List24 a
setAtList24 :: Int -> a -> List24 a -> List24 a
setAtList24 n :: Int
n a :: a
a (List24 l :: [a]
l) = [a] -> List24 a
forall a. [a] -> List24 a
List24 (Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
setAt Int
n a
a [a]
l)
overAtList24 :: Int -> (a -> a) -> List24 a -> List24 a
overAtList24 :: Int -> (a -> a) -> List24 a -> List24 a
overAtList24 n :: Int
n f :: a -> a
f (List24 l :: [a]
l) = [a] -> List24 a
forall a. [a] -> List24 a
List24 (Int -> (a -> a) -> [a] -> [a]
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
[Matrix a] -> ShowS
Matrix a -> String
(Int -> Matrix a -> ShowS)
-> (Matrix a -> String) -> ([Matrix a] -> ShowS) -> Show (Matrix a)
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
(Matrix a -> Matrix a -> Bool)
-> (Matrix a -> Matrix a -> Bool) -> Eq (Matrix a)
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, a -> Matrix b -> Matrix a
(a -> b) -> Matrix a -> Matrix b
(forall a b. (a -> b) -> Matrix a -> Matrix b)
-> (forall a b. a -> Matrix b -> Matrix a) -> Functor Matrix
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
<$ :: a -> Matrix b -> Matrix a
$c<$ :: forall a b. a -> Matrix b -> Matrix a
fmap :: (a -> b) -> Matrix a -> Matrix b
$cfmap :: forall a b. (a -> b) -> Matrix a -> Matrix b
Functor, Matrix a -> Bool
(a -> m) -> Matrix a -> m
(a -> b -> b) -> b -> Matrix a -> b
(forall m. Monoid m => Matrix m -> m)
-> (forall m a. Monoid m => (a -> m) -> Matrix a -> m)
-> (forall m a. Monoid m => (a -> m) -> Matrix a -> m)
-> (forall a b. (a -> b -> b) -> b -> Matrix a -> b)
-> (forall a b. (a -> b -> b) -> b -> Matrix a -> b)
-> (forall b a. (b -> a -> b) -> b -> Matrix a -> b)
-> (forall b a. (b -> a -> b) -> b -> Matrix a -> b)
-> (forall a. (a -> a -> a) -> Matrix a -> a)
-> (forall a. (a -> a -> a) -> Matrix a -> a)
-> (forall a. Matrix a -> [a])
-> (forall a. Matrix a -> Bool)
-> (forall a. Matrix a -> Int)
-> (forall a. Eq a => a -> Matrix a -> Bool)
-> (forall a. Ord a => Matrix a -> a)
-> (forall a. Ord a => Matrix a -> a)
-> (forall a. Num a => Matrix a -> a)
-> (forall a. Num a => Matrix a -> a)
-> Foldable Matrix
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 :: Matrix a -> a
$cproduct :: forall a. Num a => Matrix a -> a
sum :: Matrix a -> a
$csum :: forall a. Num a => Matrix a -> a
minimum :: Matrix a -> a
$cminimum :: forall a. Ord a => Matrix a -> a
maximum :: Matrix a -> a
$cmaximum :: forall a. Ord a => Matrix a -> a
elem :: a -> Matrix a -> Bool
$celem :: forall a. Eq a => a -> Matrix a -> Bool
length :: Matrix a -> Int
$clength :: forall a. Matrix a -> Int
null :: Matrix a -> Bool
$cnull :: forall a. Matrix a -> Bool
toList :: Matrix a -> [a]
$ctoList :: forall a. Matrix a -> [a]
foldl1 :: (a -> a -> a) -> Matrix a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Matrix a -> a
foldr1 :: (a -> a -> a) -> Matrix a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Matrix a -> a
foldl' :: (b -> a -> b) -> b -> Matrix a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Matrix a -> b
foldl :: (b -> a -> b) -> b -> Matrix a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Matrix a -> b
foldr' :: (a -> b -> b) -> b -> Matrix a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Matrix a -> b
foldr :: (a -> b -> b) -> b -> Matrix a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Matrix a -> b
foldMap' :: (a -> m) -> Matrix a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Matrix a -> m
foldMap :: (a -> m) -> Matrix a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Matrix a -> m
fold :: Matrix m -> m
$cfold :: forall m. Monoid m => Matrix m -> m
Foldable)
getMatrix :: Matrix a -> [[[a]]]
getMatrix :: Matrix a -> [[[a]]]
getMatrix (Matrix (List6 m :: [List6 (List6 a)]
m)) = (List6 [a] -> [[a]]) -> [List6 [a]] -> [[[a]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List6 [a] -> [[a]]
forall a. List6 a -> [a]
getList6 ([List6 [a]] -> [[[a]]]) -> [List6 [a]] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ ((List6 (List6 a) -> List6 [a]) -> [List6 (List6 a)] -> [List6 [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((List6 (List6 a) -> List6 [a])
-> [List6 (List6 a)] -> [List6 [a]])
-> ((List6 a -> [a]) -> List6 (List6 a) -> List6 [a])
-> (List6 a -> [a])
-> [List6 (List6 a)]
-> [List6 [a]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (List6 a -> [a]) -> List6 (List6 a) -> List6 [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) List6 a -> [a]
forall a. List6 a -> [a]
getList6 [List6 (List6 a)]
m
mkMatrix :: [[[a]]] -> Maybe (Matrix a)
mkMatrix :: [[[a]]] -> Maybe (Matrix a)
mkMatrix xs :: [[[a]]]
xs =
if [[[a]]] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [[[a]]]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 6 Bool -> Bool -> Bool
&& (Element [[[a]]] -> Bool) -> [[[a]]] -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all (\x :: Element [[[a]]]
x -> [[a]] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [[a]]
Element [[[a]]]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 6) [[[a]]]
xs
Bool -> Bool -> Bool
&& (Element [[[a]]] -> Bool) -> [[[a]]] -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all ((Element [[a]] -> Bool) -> [[a]] -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all (\x :: Element [[a]]
x -> [a] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [a]
Element [[a]]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 6)) [[[a]]]
xs
then Matrix a -> Maybe (Matrix a)
forall a. a -> Maybe a
Just (Matrix a -> Maybe (Matrix a)) -> Matrix a -> Maybe (Matrix a)
forall a b. (a -> b) -> a -> b
$ List6 (List6 (List6 a)) -> Matrix a
forall a. List6 (List6 (List6 a)) -> Matrix a
Matrix (List6 (List6 (List6 a)) -> Matrix a)
-> List6 (List6 (List6 a)) -> Matrix a
forall a b. (a -> b) -> a -> b
$ [List6 (List6 a)] -> List6 (List6 (List6 a))
forall a. [a] -> List6 a
List6 (([List6 a] -> List6 (List6 a)) -> [[List6 a]] -> [List6 (List6 a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [List6 a] -> List6 (List6 a)
forall a. [a] -> List6 a
List6 ((([[a]] -> [List6 a]) -> [[[a]]] -> [[List6 a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[a]] -> [List6 a]) -> [[[a]]] -> [[List6 a]])
-> (([a] -> List6 a) -> [[a]] -> [List6 a])
-> ([a] -> List6 a)
-> [[[a]]]
-> [[List6 a]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a] -> List6 a) -> [[a]] -> [List6 a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) [a] -> List6 a
forall a. [a] -> List6 a
List6 [[[a]]]
xs))
else Maybe (Matrix a)
forall a. Maybe a
Nothing
unsafeMkMatrix :: [[[a]]] -> Matrix a
unsafeMkMatrix :: [[[a]]] -> Matrix a
unsafeMkMatrix xs :: [[[a]]]
xs =
case [[[a]]] -> Maybe (Matrix a)
forall a. [[[a]]] -> Maybe (Matrix a)
mkMatrix [[[a]]]
xs of
Just xs' :: Matrix a
xs' -> Matrix a
xs'
Nothing ->
String -> Matrix a
forall a. HasCallStack => String -> a
error (String -> Matrix a) -> String -> Matrix a
forall a b. (a -> b) -> a -> b
$
"unsafeMkMatrix: input list must be exactly 6x6x6"
setAtMatrix :: Int -> Int -> Int -> a -> Matrix a -> Matrix a
setAtMatrix :: Int -> Int -> Int -> a -> Matrix a -> Matrix a
setAtMatrix x :: Int
x y :: Int
y z :: Int
z a :: a
a m :: Matrix a
m = Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
forall a. Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
overAtMatrix Int
x Int
y Int
z (\_ -> a
a) Matrix a
m
overAtMatrix :: Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
overAtMatrix :: Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a
overAtMatrix x :: Int
x y :: Int
y z :: Int
z f :: a -> a
f (Matrix l6 :: List6 (List6 (List6 a))
l6) =
List6 (List6 (List6 a)) -> Matrix a
forall a. List6 (List6 (List6 a)) -> Matrix a
Matrix (Int
-> (List6 (List6 a) -> List6 (List6 a))
-> List6 (List6 (List6 a))
-> List6 (List6 (List6 a))
forall a. Int -> (a -> a) -> List6 a -> List6 a
overAtList6 Int
x (Int -> (List6 a -> List6 a) -> List6 (List6 a) -> List6 (List6 a)
forall a. Int -> (a -> a) -> List6 a -> List6 a
overAtList6 Int
y (Int -> (a -> a) -> List6 a -> List6 a
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
(Palette c -> Palette c -> Bool)
-> (Palette c -> Palette c -> Bool) -> Eq (Palette c)
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
[Palette c] -> ShowS
Palette c -> String
(Int -> Palette c -> ShowS)
-> (Palette c -> String)
-> ([Palette c] -> ShowS)
-> Show (Palette c)
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, a -> Palette b -> Palette a
(a -> b) -> Palette a -> Palette b
(forall a b. (a -> b) -> Palette a -> Palette b)
-> (forall a b. a -> Palette b -> Palette a) -> Functor Palette
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
<$ :: a -> Palette b -> Palette a
$c<$ :: forall a b. a -> Palette b -> Palette a
fmap :: (a -> b) -> Palette a -> Palette b
$cfmap :: forall a b. (a -> b) -> Palette a -> Palette b
Functor, Palette a -> Bool
(a -> m) -> Palette a -> m
(a -> b -> b) -> b -> Palette a -> b
(forall m. Monoid m => Palette m -> m)
-> (forall m a. Monoid m => (a -> m) -> Palette a -> m)
-> (forall m a. Monoid m => (a -> m) -> Palette a -> m)
-> (forall a b. (a -> b -> b) -> b -> Palette a -> b)
-> (forall a b. (a -> b -> b) -> b -> Palette a -> b)
-> (forall b a. (b -> a -> b) -> b -> Palette a -> b)
-> (forall b a. (b -> a -> b) -> b -> Palette a -> b)
-> (forall a. (a -> a -> a) -> Palette a -> a)
-> (forall a. (a -> a -> a) -> Palette a -> a)
-> (forall a. Palette a -> [a])
-> (forall a. Palette a -> Bool)
-> (forall a. Palette a -> Int)
-> (forall a. Eq a => a -> Palette a -> Bool)
-> (forall a. Ord a => Palette a -> a)
-> (forall a. Ord a => Palette a -> a)
-> (forall a. Num a => Palette a -> a)
-> (forall a. Num a => Palette a -> a)
-> Foldable Palette
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 :: Palette a -> a
$cproduct :: forall a. Num a => Palette a -> a
sum :: Palette a -> a
$csum :: forall a. Num a => Palette a -> a
minimum :: Palette a -> a
$cminimum :: forall a. Ord a => Palette a -> a
maximum :: Palette a -> a
$cmaximum :: forall a. Ord a => Palette a -> a
elem :: a -> Palette a -> Bool
$celem :: forall a. Eq a => a -> Palette a -> Bool
length :: Palette a -> Int
$clength :: forall a. Palette a -> Int
null :: Palette a -> Bool
$cnull :: forall a. Palette a -> Bool
toList :: Palette a -> [a]
$ctoList :: forall a. Palette a -> [a]
foldl1 :: (a -> a -> a) -> Palette a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Palette a -> a
foldr1 :: (a -> a -> a) -> Palette a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Palette a -> a
foldl' :: (b -> a -> b) -> b -> Palette a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Palette a -> b
foldl :: (b -> a -> b) -> b -> Palette a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Palette a -> b
foldr' :: (a -> b -> b) -> b -> Palette a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Palette a -> b
foldr :: (a -> b -> b) -> b -> Palette a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Palette a -> b
foldMap' :: (a -> m) -> Palette a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Palette a -> m
foldMap :: (a -> m) -> Palette a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Palette a -> m
fold :: Palette m -> m
$cfold :: forall m. Monoid m => Palette m -> m
Foldable)
paletteToList :: Palette c -> [c]
paletteToList :: Palette c -> [c]
paletteToList = Palette c -> [c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits :: Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits scale :: Word8
scale offset :: Word8
offset = (Int -> AlphaColour b) -> List8 (AlphaColour b)
forall a. (Int -> a) -> List8 a
genList Int -> AlphaColour b
createElem
where
createElem :: Int -> AlphaColour b
createElem :: Int -> AlphaColour b
createElem i :: Int
i =
let red :: Word8
red = Int -> Int -> Word8
cmp 0 Int
i
green :: Word8
green = Int -> Int -> Word8
cmp 1 Int
i
blue :: Word8
blue = Int -> Int -> Word8
cmp 2 Int
i
color :: AlphaColour b
color = Colour b -> AlphaColour b
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour b -> AlphaColour b) -> Colour b -> AlphaColour b
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Colour 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 i :: Int
i = (Word8
offset Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> (Int -> Word8) -> Int -> Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Word8
scale Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*) (Word8 -> Word8) -> (Int -> Word8) -> Int -> Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Int -> Int) -> Int -> Word8
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 m :: Int
m i :: Int
i = Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
m) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 2
genList :: (Int -> a) -> List8 a
genList :: (Int -> a) -> List8 a
genList f :: Int -> a
f = [a] -> List8 a
forall a. [a] -> List8 a
unsafeMkList8 [ Int -> a
f Int
x | Int
x <- [0..7]]
defaultStandardColours :: (Ord b, Floating b) => List8 (AlphaColour b)
defaultStandardColours :: List8 (AlphaColour b)
defaultStandardColours = Word8 -> Word8 -> List8 (AlphaColour b)
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits 192 0
defaultLightColours :: (Ord b, Floating b) => List8 (AlphaColour b)
defaultLightColours :: List8 (AlphaColour b)
defaultLightColours = Word8 -> Word8 -> List8 (AlphaColour b)
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> List8 (AlphaColour b)
coloursFromBits 192 63
pureColour :: AlphaColour Double -> Colour Double
pureColour :: AlphaColour Double -> Colour Double
pureColour alaphaColour :: AlphaColour Double
alaphaColour
| Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Double -> Colour Double -> Colour Double
forall (f :: * -> *) a. (ColourOps f, Num a) => a -> f a -> f a
darken (Double -> Double
forall a. Fractional a => a -> a
recip Double
a) (AlphaColour Double
alaphaColour AlphaColour Double -> Colour Double -> Colour Double
forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` Colour Double
forall a. Num a => Colour a
black)
| Bool
otherwise = Colour Double
forall a. Num a => Colour a
black
where
a :: Double
a :: Double
a = AlphaColour Double -> Double
forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
alaphaColour
quantize :: forall a b. (RealFrac a, Integral b, Bounded b) => a -> b
quantize :: a -> b
quantize x :: a
x
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
l = b
l
| b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
h a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x = b
h
| Bool
otherwise = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
x
where
l :: b
l :: b
l = b
forall a. Bounded a => a
minBound
h :: b
h :: b
h = b
forall a. Bounded a => a
maxBound
sRGB32show :: AlphaColour Double -> String
sRGB32show :: AlphaColour Double -> String
sRGB32show c :: AlphaColour Double
c = String -> Word8 -> Word8 -> Word8 -> Word8 -> String
forall r. PrintfType r => String -> r
printf "#%02x%02x%02x%02x" Word8
r Word8
g Word8
b Word8
a
where
r, g, b :: Word8
RGB r :: Word8
r g :: Word8
g b :: Word8
b = Colour Double -> RGB Word8
forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 (Colour Double -> RGB Word8) -> Colour Double -> RGB Word8
forall a b. (a -> b) -> a -> b
$ AlphaColour Double -> Colour Double
pureColour AlphaColour Double
c
a :: Word8
a :: Word8
a = Double -> Word8
forall a b. (RealFrac a, Integral b, Bounded b) => a -> b
quantize (255 Double -> Double -> Double
forall a. Num a => a -> a -> a
* AlphaColour Double -> Double
forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
c)
sRGB32
:: Word8
-> Word8
-> Word8
-> Word8
-> AlphaColour Double
sRGB32 :: Word8 -> Word8 -> Word8 -> Word8 -> AlphaColour Double
sRGB32 r :: Word8
r g :: Word8
g b :: Word8
b 255 = Colour Double -> Double -> AlphaColour Double
forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity (Word8 -> Word8 -> Word8 -> Colour Double
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
r Word8
g Word8
b) 1
sRGB32 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a =
let aDouble :: Double
aDouble = Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 255
in (Colour Double -> Double -> AlphaColour Double
forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity (Word8 -> Word8 -> Word8 -> Colour Double
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 r :: Word8
r g :: Word8
g b :: Word8
b = Word8 -> Word8 -> Word8 -> Word8 -> AlphaColour Double
sRGB32 Word8
r Word8
g Word8
b 255
showColourVec :: List8 (AlphaColour Double) -> [String]
showColourVec :: List8 (AlphaColour Double) -> [String]
showColourVec (List8 xs :: [AlphaColour Double]
xs) = (AlphaColour Double -> String) -> [AlphaColour Double] -> [String]
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 :: (Int -> Int -> Int -> a) -> [a]
genMatrix f :: Int -> Int -> Int -> a
f = [ Int -> Int -> Int -> a
f Int
x Int
y Int
z | Int
x <- [0..5], Int
y <- [0..5], Int
z <- [0..5] ]
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g :: (a -> [a] -> [a]) -> [a] -> [a]
g = (a -> [a] -> [a]) -> [a] -> [a]
g (:) []
chunksOf :: Int -> [e] -> [[e]]
chunksOf :: Int -> [e] -> [[e]]
chunksOf i :: Int
i ls :: [e]
ls = ([e] -> [e]) -> [[e]] -> [[e]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Index [e] -> [e] -> [e]
forall seq. IsSequence seq => Index seq -> seq -> seq
take Int
Index [e]
i) ((([e] -> [[e]] -> [[e]]) -> [[e]] -> [[e]]) -> [[e]]
forall a. ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build ([e] -> ([e] -> [[e]] -> [[e]]) -> [[e]] -> [[e]]
forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter [e]
ls)) where
splitter :: [e] -> ([e] -> a -> a) -> a -> a
splitter :: [e] -> ([e] -> a -> a) -> a -> a
splitter [] _ n :: a
n = a
n
splitter l :: [e]
l c :: [e] -> a -> a
c n :: a
n = [e]
l [e] -> a -> a
`c` [e] -> ([e] -> a -> a) -> a -> a
forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter (Index [e] -> [e] -> [e]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
Index [e]
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 :: AlphaColour b
-> AlphaColour b
-> AlphaColour b
-> AlphaColour b
-> Matrix (AlphaColour b)
cube d :: AlphaColour b
d i :: AlphaColour b
i j :: AlphaColour b
j k :: AlphaColour b
k =
let xs :: [AlphaColour b]
xs = (Int -> Int -> Int -> AlphaColour b) -> [AlphaColour b]
forall a. (Int -> Int -> Int -> a) -> [a]
genMatrix ((Int -> Int -> Int -> AlphaColour b) -> [AlphaColour b])
-> (Int -> Int -> Int -> AlphaColour b) -> [AlphaColour b]
forall a b. (a -> b) -> a -> b
$ \x :: Int
x y :: Int
y z :: Int
z ->
[(b, AlphaColour b)] -> AlphaColour b -> AlphaColour b
forall (f :: * -> *) a.
(AffineSpace f, Num a) =>
[(a, f a)] -> f a -> f a
affineCombo [(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)] (AlphaColour b -> AlphaColour b) -> AlphaColour b -> AlphaColour b
forall a b. (a -> b) -> a -> b
$ Colour b -> AlphaColour b
forall a. Num a => Colour a -> AlphaColour a
opaque Colour b
forall a. Num a => Colour a
black
in [[[AlphaColour b]]] -> Matrix (AlphaColour b)
forall a. [[[a]]] -> Matrix a
unsafeMkMatrix ([[[AlphaColour b]]] -> Matrix (AlphaColour b))
-> [[[AlphaColour b]]] -> Matrix (AlphaColour b)
forall a b. (a -> b) -> a -> b
$ Int -> [[AlphaColour b]] -> [[[AlphaColour b]]]
forall e. Int -> [e] -> [[e]]
chunksOf 6 ([[AlphaColour b]] -> [[[AlphaColour b]]])
-> [[AlphaColour b]] -> [[[AlphaColour b]]]
forall a b. (a -> b) -> a -> b
$ Int -> [AlphaColour b] -> [[AlphaColour b]]
forall e. Int -> [e] -> [[e]]
chunksOf 6 [AlphaColour b]
xs
where
coef :: Int -> b
coef :: Int -> b
coef x :: Int
x = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x b -> b -> b
forall a. Fractional a => a -> a -> a
/ 5
defaultColourCube :: (Ord b, Floating b) => Matrix (AlphaColour b)
defaultColourCube :: Matrix (AlphaColour b)
defaultColourCube =
let xs :: [AlphaColour b]
xs = (Int -> Int -> Int -> AlphaColour b) -> [AlphaColour b]
forall a. (Int -> Int -> Int -> a) -> [a]
genMatrix ((Int -> Int -> Int -> AlphaColour b) -> [AlphaColour b])
-> (Int -> Int -> Int -> AlphaColour b) -> [AlphaColour b]
forall a b. (a -> b) -> a -> b
$ \x :: Int
x y :: Int
y z :: Int
z -> Colour b -> AlphaColour b
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour b -> AlphaColour b) -> Colour b -> AlphaColour b
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Colour 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 [[[AlphaColour b]]] -> Matrix (AlphaColour b)
forall a. [[[a]]] -> Matrix a
unsafeMkMatrix ([[[AlphaColour b]]] -> Matrix (AlphaColour b))
-> [[[AlphaColour b]]] -> Matrix (AlphaColour b)
forall a b. (a -> b) -> a -> b
$ Int -> [[AlphaColour b]] -> [[[AlphaColour b]]]
forall e. Int -> [e] -> [[e]]
chunksOf 6 ([[AlphaColour b]] -> [[[AlphaColour b]]])
-> [[AlphaColour b]] -> [[[AlphaColour b]]]
forall a b. (a -> b) -> a -> b
$ Int -> [AlphaColour b] -> [[AlphaColour b]]
forall e. Int -> [e] -> [[e]]
chunksOf 6 [AlphaColour b]
xs
where
cmp :: Int -> Word8
cmp :: Int -> Word8
cmp i :: Int
i = let i' :: Word8
i' = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i in Word8 -> Word8
forall a. Num a => a -> a
signum Word8
i' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* 55 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 40 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
i'
showColourCube :: Matrix (AlphaColour Double) -> String
showColourCube :: Matrix (AlphaColour Double) -> String
showColourCube matrix :: Matrix (AlphaColour Double)
matrix =
let itemList :: [AlphaColour Double]
itemList = ([[AlphaColour Double]] -> [AlphaColour Double]
forall a. Monoid a => [a] -> a
mconcat ([[AlphaColour Double]] -> [AlphaColour Double])
-> ([[[AlphaColour Double]]] -> [[AlphaColour Double]])
-> [[[AlphaColour Double]]]
-> [AlphaColour Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[[AlphaColour Double]]] -> [[AlphaColour Double]]
forall a. Monoid a => [a] -> a
mconcat) ([[[AlphaColour Double]]] -> [AlphaColour Double])
-> [[[AlphaColour Double]]] -> [AlphaColour Double]
forall a b. (a -> b) -> a -> b
$ Matrix (AlphaColour Double) -> [[[AlphaColour Double]]]
forall a. Matrix a -> [[[a]]]
getMatrix Matrix (AlphaColour Double)
matrix
in [AlphaColour Double] -> ShowS
showSColourCube [AlphaColour Double]
itemList ""
where
showSColourCube :: [AlphaColour Double] -> String -> String
showSColourCube :: [AlphaColour Double] -> ShowS
showSColourCube itemList :: [AlphaColour Double]
itemList =
String -> ShowS
showString "[ " ShowS -> ShowS -> ShowS
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 0 [AlphaColour Double]
itemList ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 1 [AlphaColour Double]
itemList ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 2 [AlphaColour Double]
itemList ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 3 [AlphaColour Double]
itemList ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 4 [AlphaColour Double]
itemList ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 5 [AlphaColour Double]
itemList ShowS -> ShowS -> ShowS
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 "]"
showSquare :: Int -> [AlphaColour Double] -> String -> String
showSquare :: Int -> [AlphaColour Double] -> ShowS
showSquare i :: Int
i colours :: [AlphaColour Double]
colours =
String -> ShowS
showString "[ " ShowS -> ShowS -> ShowS
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 0 [AlphaColour Double]
colours ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 1 [AlphaColour Double]
colours ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 2 [AlphaColour Double]
colours ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 3 [AlphaColour Double]
colours ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 4 [AlphaColour Double]
colours ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 5 [AlphaColour Double]
colours ShowS -> ShowS -> ShowS
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 "]\n"
showRow :: Int -> Int -> [AlphaColour Double] -> String -> String
showRow :: Int -> Int -> [AlphaColour Double] -> ShowS
showRow i :: Int
i j :: Int
j colours :: [AlphaColour Double]
colours =
AlphaColour Double -> ShowS
showCol ([AlphaColour Double] -> AlphaColour Double
forall mono. MonoFoldable mono => mono -> Element mono
headEx ([AlphaColour Double] -> AlphaColour Double)
-> [AlphaColour Double] -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Index [AlphaColour Double]
-> [AlphaColour Double] -> [AlphaColour Double]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 0) [AlphaColour Double]
colours) ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 ([AlphaColour Double] -> AlphaColour Double
forall mono. MonoFoldable mono => mono -> Element mono
headEx ([AlphaColour Double] -> AlphaColour Double)
-> [AlphaColour Double] -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Index [AlphaColour Double]
-> [AlphaColour Double] -> [AlphaColour Double]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [AlphaColour Double]
colours) ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 ([AlphaColour Double] -> AlphaColour Double
forall mono. MonoFoldable mono => mono -> Element mono
headEx ([AlphaColour Double] -> AlphaColour Double)
-> [AlphaColour Double] -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Index [AlphaColour Double]
-> [AlphaColour Double] -> [AlphaColour Double]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) [AlphaColour Double]
colours) ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 ([AlphaColour Double] -> AlphaColour Double
forall mono. MonoFoldable mono => mono -> Element mono
headEx ([AlphaColour Double] -> AlphaColour Double)
-> [AlphaColour Double] -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Index [AlphaColour Double]
-> [AlphaColour Double] -> [AlphaColour Double]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) [AlphaColour Double]
colours) ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 ([AlphaColour Double] -> AlphaColour Double
forall mono. MonoFoldable mono => mono -> Element mono
headEx ([AlphaColour Double] -> AlphaColour Double)
-> [AlphaColour Double] -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Index [AlphaColour Double]
-> [AlphaColour Double] -> [AlphaColour Double]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4) [AlphaColour Double]
colours) ShowS -> ShowS -> ShowS
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 ", " ShowS -> ShowS -> ShowS
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 ([AlphaColour Double] -> AlphaColour Double
forall mono. MonoFoldable mono => mono -> Element mono
headEx ([AlphaColour Double] -> AlphaColour Double)
-> [AlphaColour Double] -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Index [AlphaColour Double]
-> [AlphaColour Double] -> [AlphaColour Double]
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5) [AlphaColour Double]
colours) ShowS -> ShowS -> ShowS
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 "\n "
showCol :: AlphaColour Double -> String -> String
showCol :: AlphaColour Double -> ShowS
showCol col :: AlphaColour Double
col str :: String
str = AlphaColour Double -> String
sRGB32show AlphaColour Double
col String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str
defaultGreyscale :: (Ord b, Floating b) => List24 (AlphaColour b)
defaultGreyscale :: List24 (AlphaColour b)
defaultGreyscale = [AlphaColour b] -> List24 (AlphaColour b)
forall a. [a] -> List24 a
unsafeMkList24 ([AlphaColour b] -> List24 (AlphaColour b))
-> [AlphaColour b] -> List24 (AlphaColour b)
forall a b. (a -> b) -> a -> b
$ do
Word8
n <- [0..23]
let l :: Word8
l = 8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
n
AlphaColour b -> [AlphaColour b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlphaColour b -> [AlphaColour b])
-> AlphaColour b -> [AlphaColour b]
forall a b. (a -> b) -> a -> b
$ Colour b -> AlphaColour b
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour b -> AlphaColour b) -> Colour b -> AlphaColour b
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Colour b
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
l Word8
l Word8
l
data ColourConfig c = ColourConfig
{ ColourConfig c -> Option c
cursorFgColour :: !(Option c)
, ColourConfig c -> Option c
cursorBgColour :: !(Option c)
, ColourConfig c -> Option c
foregroundColour :: !(Option c)
, ColourConfig c -> Option c
backgroundColour :: !(Option c)
, ColourConfig c -> Palette c
palette :: !(Palette c)
} deriving (ColourConfig c -> ColourConfig c -> Bool
(ColourConfig c -> ColourConfig c -> Bool)
-> (ColourConfig c -> ColourConfig c -> Bool)
-> Eq (ColourConfig c)
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
[ColourConfig c] -> ShowS
ColourConfig c -> String
(Int -> ColourConfig c -> ShowS)
-> (ColourConfig c -> String)
-> ([ColourConfig c] -> ShowS)
-> Show (ColourConfig c)
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, a -> ColourConfig b -> ColourConfig a
(a -> b) -> ColourConfig a -> ColourConfig b
(forall a b. (a -> b) -> ColourConfig a -> ColourConfig b)
-> (forall a b. a -> ColourConfig b -> ColourConfig a)
-> Functor ColourConfig
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
<$ :: a -> ColourConfig b -> ColourConfig a
$c<$ :: forall a b. a -> ColourConfig b -> ColourConfig a
fmap :: (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 = $WColourConfig :: forall c.
Option c
-> Option c -> Option c -> Option c -> Palette c -> ColourConfig c
ColourConfig
{ cursorFgColour :: Option (AlphaColour Double)
cursorFgColour = Option (AlphaColour Double)
forall a. Option a
Unset
, cursorBgColour :: Option (AlphaColour Double)
cursorBgColour = Option (AlphaColour Double)
forall a. Option a
Unset
, foregroundColour :: Option (AlphaColour Double)
foregroundColour = Option (AlphaColour Double)
forall a. Option a
Unset
, backgroundColour :: Option (AlphaColour Double)
backgroundColour = Option (AlphaColour Double)
forall a. Option a
Unset
, palette :: Palette (AlphaColour Double)
palette = Palette (AlphaColour Double)
forall c. Palette c
NoPalette
}
$(makeLensesFor
[ ("cursorFgColour", "lensCursorFgColour")
, ("cursorBgColour", "lensCursorBgColour")
, ("foregroundColour", "lensForegroundColour")
, ("backgroundColour", "lensBackgroundColour")
, ("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 mvarColourConf :: MVar (ColourConfig (AlphaColour Double))
mvarColourConf _ vteTerm :: Terminal
vteTerm = do
ColourConfig (AlphaColour Double)
colourConf <- MVar (ColourConfig (AlphaColour Double))
-> IO (ColourConfig (AlphaColour Double))
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar (ColourConfig (AlphaColour Double))
mvarColourConf
let paletteColourList :: [AlphaColour Double]
paletteColourList = Palette (AlphaColour Double) -> [AlphaColour Double]
forall a. Palette a -> [a]
paletteToList (Palette (AlphaColour Double) -> [AlphaColour Double])
-> Palette (AlphaColour Double) -> [AlphaColour Double]
forall a b. (a -> b) -> a -> b
$ ColourConfig (AlphaColour Double) -> Palette (AlphaColour Double)
forall c. ColourConfig c -> Palette c
palette ColourConfig (AlphaColour Double)
colourConf
[RGBA]
rgbaPaletteColourList <- (AlphaColour Double -> IO RGBA)
-> [AlphaColour Double] -> IO [RGBA]
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
Terminal -> Maybe RGBA -> Maybe RGBA -> Maybe [RGBA] -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe RGBA -> Maybe RGBA -> Maybe [RGBA] -> m ()
terminalSetColors Terminal
vteTerm Maybe RGBA
forall a. Maybe a
Nothing Maybe RGBA
forall a. Maybe a
Nothing ([RGBA] -> Maybe [RGBA]
forall a. a -> Maybe a
Just [RGBA]
rgbaPaletteColourList)
Option (AlphaColour Double)
-> (AlphaColour Double -> IO ()) -> IO ()
forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (ColourConfig (AlphaColour Double) -> Option (AlphaColour Double)
forall c. ColourConfig c -> Option c
backgroundColour ColourConfig (AlphaColour Double)
colourConf) ((AlphaColour Double -> IO ()) -> IO ())
-> (AlphaColour Double -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
Terminal -> RGBA -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> RGBA -> m ()
terminalSetColorBackground Terminal
vteTerm (RGBA -> IO ())
-> (AlphaColour Double -> IO RGBA) -> AlphaColour Double -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba
Option (AlphaColour Double)
-> (AlphaColour Double -> IO ()) -> IO ()
forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (ColourConfig (AlphaColour Double) -> Option (AlphaColour Double)
forall c. ColourConfig c -> Option c
foregroundColour ColourConfig (AlphaColour Double)
colourConf) ((AlphaColour Double -> IO ()) -> IO ())
-> (AlphaColour Double -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
Terminal -> RGBA -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> RGBA -> m ()
terminalSetColorForeground Terminal
vteTerm (RGBA -> IO ())
-> (AlphaColour Double -> IO RGBA) -> AlphaColour Double -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlphaColour Double -> IO RGBA
colourToRgba
Option (AlphaColour Double)
-> (AlphaColour Double -> IO ()) -> IO ()
forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet (ColourConfig (AlphaColour Double) -> Option (AlphaColour Double)
forall c. ColourConfig c -> Option c
cursorBgColour ColourConfig (AlphaColour Double)
colourConf) ((AlphaColour Double -> IO ()) -> IO ())
-> (AlphaColour Double -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
Terminal -> Maybe RGBA -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe RGBA -> m ()
terminalSetColorCursor Terminal
vteTerm (Maybe RGBA -> IO ()) -> (RGBA -> Maybe RGBA) -> RGBA -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RGBA -> Maybe RGBA
forall a. a -> Maybe a
Just (RGBA -> IO ())
-> (AlphaColour Double -> IO RGBA) -> AlphaColour Double -> IO ()
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
colourToRgba :: AlphaColour Double -> IO RGBA
colourToRgba :: AlphaColour Double -> IO RGBA
colourToRgba colour :: AlphaColour Double
colour = do
let RGB red :: Double
red green :: Double
green blue :: Double
blue = Colour Double -> RGB Double
forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB (Colour Double -> RGB Double) -> Colour Double -> RGB Double
forall a b. (a -> b) -> a -> b
$ AlphaColour Double -> Colour Double
pureColour AlphaColour Double
colour
alpha :: Double
alpha = AlphaColour Double -> Double
forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
colour
RGBA
rgba <- IO RGBA
forall (m :: * -> *). MonadIO m => m RGBA
newZeroRGBA
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBARed RGBA
rgba Double
red
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBAGreen RGBA
rgba Double
green
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBABlue RGBA
rgba Double
blue
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBAAlpha RGBA
rgba Double
alpha
RGBA -> IO RGBA
forall (f :: * -> *) a. Applicative f => a -> f a
pure RGBA
rgba
createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension conf :: ColourConfig (AlphaColour Double)
conf = do
MVar (ColourConfig (AlphaColour Double))
mvarConf <- ColourConfig (AlphaColour Double)
-> IO (MVar (ColourConfig (AlphaColour Double)))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar ColourConfig (AlphaColour Double)
conf
ColourExtension -> IO ColourExtension
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColourExtension -> IO ColourExtension)
-> ColourExtension -> IO ColourExtension
forall a b. (a -> b) -> a -> b
$
ColourExtension :: MVar (ColourConfig (AlphaColour Double))
-> (TMState -> Terminal -> IO ()) -> ColourExtension
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 tmConf :: TMConfig
tmConf colConf :: ColourConfig (AlphaColour Double)
colConf = do
ColourExtension _ newHook :: TMState -> Terminal -> IO ()
newHook <- ColourConfig (AlphaColour Double) -> IO ColourExtension
createColourExtension ColourConfig (AlphaColour Double)
colConf
let newTMConf :: TMConfig
newTMConf = TMConfig
tmConf TMConfig -> (TMConfig -> TMConfig) -> TMConfig
forall a b. a -> (a -> b) -> b
& (ConfigHooks -> Identity ConfigHooks)
-> TMConfig -> Identity TMConfig
Lens' TMConfig ConfigHooks
lensHooks ((ConfigHooks -> Identity ConfigHooks)
-> TMConfig -> Identity TMConfig)
-> (((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> ConfigHooks -> Identity ConfigHooks)
-> ((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> TMConfig
-> Identity TMConfig
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> ConfigHooks -> Identity ConfigHooks
Iso' ConfigHooks (TMState -> Terminal -> IO ())
lensCreateTermHook (((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> TMConfig -> Identity TMConfig)
-> ((TMState -> Terminal -> IO ()) -> TMState -> Terminal -> IO ())
-> TMConfig
-> TMConfig
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
TMConfig -> IO TMConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMConfig
newTMConf
addColourExtension :: TMConfig -> ColourExtension -> TMConfig
addColourExtension :: TMConfig -> ColourExtension -> TMConfig
addColourExtension tmConf :: TMConfig
tmConf (ColourExtension _ newHook :: TMState -> Terminal -> IO ()
newHook) =
TMConfig
tmConf TMConfig -> (TMConfig -> TMConfig) -> TMConfig
forall a b. a -> (a -> b) -> b
& (ConfigHooks -> Identity ConfigHooks)
-> TMConfig -> Identity TMConfig
Lens' TMConfig ConfigHooks
lensHooks ((ConfigHooks -> Identity ConfigHooks)
-> TMConfig -> Identity TMConfig)
-> (((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> ConfigHooks -> Identity ConfigHooks)
-> ((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> TMConfig
-> Identity TMConfig
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> ConfigHooks -> Identity ConfigHooks
Iso' ConfigHooks (TMState -> Terminal -> IO ())
lensCreateTermHook (((TMState -> Terminal -> IO ())
-> Identity (TMState -> Terminal -> IO ()))
-> TMConfig -> Identity TMConfig)
-> ((TMState -> Terminal -> IO ()) -> TMState -> Terminal -> IO ())
-> TMConfig
-> TMConfig
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 newHook :: TMState -> Terminal -> IO ()
newHook oldHook :: TMState -> Terminal -> IO ()
oldHook tmState :: TMState
tmState term :: Terminal
term = do
TMState -> Terminal -> IO ()
oldHook TMState
tmState Terminal
term
TMState -> Terminal -> IO ()
newHook TMState
tmState Terminal
term