Copyright | (c) Dennis Gosnell 2018 |
---|---|
License | BSD3 |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
To use this config extension in your ~/.config/termonad/termonad.hs
, first
import this module. Create a new ColourExtension
with the createColourExtension
function.
Then add the ColourExtension
to your TMConfig
with the addColourExtension
function.
See this code for a simple example.
Synopsis
- data ColourConfig c = ColourConfig {
- cursorFgColour :: !(Option c)
- cursorBgColour :: !(Option c)
- foregroundColour :: !(Option c)
- backgroundColour :: !(Option c)
- palette :: !(Palette c)
- defaultColourConfig :: ColourConfig (AlphaColour Double)
- lensCursorFgColour :: forall c. Lens' (ColourConfig c) (Option c)
- lensCursorBgColour :: forall c. Lens' (ColourConfig c) (Option c)
- lensForegroundColour :: forall c. Lens' (ColourConfig c) (Option c)
- lensBackgroundColour :: forall c. Lens' (ColourConfig c) (Option c)
- lensPalette :: forall c. Lens' (ColourConfig c) (Palette c)
- data ColourExtension = ColourExtension {
- colourExtConf :: MVar (ColourConfig (AlphaColour Double))
- colourExtCreateTermHook :: TMState -> Terminal -> IO ()
- createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension
- createDefColourExtension :: IO ColourExtension
- addColourExtension :: TMConfig -> ColourExtension -> TMConfig
- addColourConfig :: TMConfig -> ColourConfig (AlphaColour Double) -> IO TMConfig
- colourHook :: MVar (ColourConfig (AlphaColour Double)) -> TMState -> Terminal -> IO ()
- addColourHook :: (TMState -> Terminal -> IO ()) -> (TMState -> Terminal -> IO ()) -> TMState -> Terminal -> IO ()
- data Palette c
- defaultStandardColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b)
- defaultLightColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b)
- defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (AlphaColour b)
- defaultGreyscale :: (Ord b, Floating b) => Vec N24 (AlphaColour b)
- data AlphaColour a
- createColour :: Word8 -> Word8 -> Word8 -> AlphaColour Double
- sRGB32 :: Word8 -> Word8 -> Word8 -> Word8 -> AlphaColour Double
- sRGB32show :: AlphaColour Double -> String
- opaque :: Num a => Colour a -> AlphaColour a
- transparent :: Num a => AlphaColour a
- showColourVec :: forall n. Vec n (AlphaColour Double) -> [String]
- showColourCube :: Matrix '[N6, N6, N6] (AlphaColour Double) -> String
- paletteToList :: Palette c -> [c]
- coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (AlphaColour b)
- cube :: forall b. Fractional b => AlphaColour b -> Vec N3 (AlphaColour b) -> Matrix '[N6, N6, N6] (AlphaColour b)
Colour Config
data ColourConfig c Source #
The configuration for the colors used by Termonad.
foregroundColour
and backgroundColour
allow you to set the color of the
foreground text and background of the terminal.
palette
allows you to set the full color palette used by the terminal.
See Palette
for more information.
If you don't set foregroundColour
, backgroundColour
, or palette
, the
defaults from VTE are used.
If you want to use a terminal with a white (or light) background and a black
foreground, it may be a good idea to change some of the colors in the
Palette
as well.
VTE works as follows: if you don't explicitly set a background or foreground color,
it takes the 0th colour from the palette
to be the background color, and the 7th
colour from the palette
to be the foreground color. If you notice oddities with
colouring in certain applications, it may be helpful to make sure that these
palette
colours match up with the backgroundColour
and foregroundColour
you
have set.)
cursorFgColour
and cursorBgColour
allow you to set the foreground color
of the text under the cursor, as well as the color of the cursor itself.
Termonad will behave differently depending on the combination
cursorFgColour
and cursorBgColour
being Set
vs. Unset
.
Here is the summary of the different possibilities:
cursorFgColour
isSet
andcursorBgColour
isSet
The foreground and background colors of the cursor are as you have set.
cursorFgColour
isSet
andcursorBgColour
isUnset
The cursor background color turns completely black so that it is not visible. The foreground color of the cursor is the color that you have
Set
. This ends up being mostly unusable, so you are recommended to alwaysSet
cursorBgColour
when you haveSet
cursorFgColour
.cursorFgColour
isUnset
andcursorBgColour
isSet
The cursor background color becomes the color you
Set
, while the cursor foreground color doesn't change from the letter it is over. For instance, imagine there is a letter on the screen with a black background and a green foreground. If you bring the cursor overtop of it, the cursor background will be the color you haveSet
, while the cursor foreground will be green.This is completely usable, but is slightly annoying if you place the cursor over a letter with the same foreground color as the cursor's background color, because the letter will not be readable. For instance, imagine you have set your cursor background color to red, and somewhere on the screen there is a letter with a black background and a red foreground. If you move your cursor over the letter, the background of the cursor will be red (as you have set), and the cursor foreground will be red (to match the original foreground color of the letter). This will make it so you can't actually read the letter, because the foreground and background are both red.
cursorFgColour
isUnset
andcursorBgColour
isUnset
This combination makes the cursor inverse of whatever text it is over. If your cursor is over red text with a black background, the cursor background will be red and the cursor foreground will be black.
This is the default.
cursorFgColour
is not supported in vte-2.91
versions older than 0.44.
(This is somewhat confusing. Note that vte-2.91
is the name of the system
library, and 0.44
is its version number.)
See defaultColourConfig
for the defaults for ColourConfig
used in Termonad.
ColourConfig | |
|
Instances
Functor ColourConfig Source # | |
Defined in Termonad.Config.Colour fmap :: (a -> b) -> ColourConfig a -> ColourConfig b # (<$) :: a -> ColourConfig b -> ColourConfig a # | |
Eq c => Eq (ColourConfig c) Source # | |
Defined in Termonad.Config.Colour (==) :: ColourConfig c -> ColourConfig c -> Bool # (/=) :: ColourConfig c -> ColourConfig c -> Bool # | |
Show c => Show (ColourConfig c) Source # | |
Defined in Termonad.Config.Colour showsPrec :: Int -> ColourConfig c -> ShowS # show :: ColourConfig c -> String # showList :: [ColourConfig c] -> ShowS # |
defaultColourConfig :: ColourConfig (AlphaColour Double) Source #
Default setting for a ColourConfig
. The cursor colors, font foreground
color, background color, and color palette are all left at the defaults set
by VTE.
>>>
defaultColourConfig
ColourConfig {cursorFgColour = Unset, cursorBgColour = Unset, foregroundColour = Unset, backgroundColour = Unset, palette = NoPalette}
Colour Config Lenses
lensCursorFgColour :: forall c. Lens' (ColourConfig c) (Option c) Source #
lensCursorBgColour :: forall c. Lens' (ColourConfig c) (Option c) Source #
lensForegroundColour :: forall c. Lens' (ColourConfig c) (Option c) Source #
lensBackgroundColour :: forall c. Lens' (ColourConfig c) (Option c) Source #
lensPalette :: forall c. Lens' (ColourConfig c) (Palette c) Source #
Colour Extension
data ColourExtension Source #
Extension that allows setting colors for terminals in Termonad.
ColourExtension | |
|
createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension Source #
Create a ColourExtension
based on a given ColourConfig
.
Most users will want to use this.
createDefColourExtension :: IO ColourExtension Source #
Create a ColourExtension
based on defaultColourConfig
.
Note that this is not needed if you just want to use the default colors for
Termonad. However, if you want to pass around the MVar
ColourConfig
for
extensions to use, then you may need this function.
addColourExtension :: TMConfig -> ColourExtension -> TMConfig Source #
This is similar to addColourConfig
, but can be used on a
ColourExtension
created with createColourExtension
.
addColourConfig :: TMConfig -> ColourConfig (AlphaColour Double) -> IO TMConfig Source #
Add a given ColourConfig
to a TMConfig
. This adds colourHook
to the
createTermHook
in TMConfig
.
colourHook :: MVar (ColourConfig (AlphaColour Double)) -> TMState -> Terminal -> IO () Source #
The default createTermHook
for colourExtCreateTermHook
. Set the colors
for a terminal based on the given ColourConfig
.
:: (TMState -> Terminal -> IO ()) | New hook |
-> (TMState -> Terminal -> IO ()) | Old hook |
-> TMState | |
-> Terminal | |
-> IO () |
This function shows how to combine createTermHook
s.
This first runs the old hook, followed by the new hook.
This is used internally by addColourConfig
and addColourExtension
.
Palette
This is the color palette to use for the terminal. Each data constructor lets you set progressively more colors. These colors are used by the terminal to render ANSI escape color codes.
There are 256 total terminal colors. BasicPalette
lets you set the first 8,
ExtendedPalette
lets you set the first 16, ColourCubePalette
lets you set
the first 232, and FullPalette
lets you set all 256.
The first 8 colors codes are the standard colors. The next 8 are the extended (light) colors. The next 216 are a full color cube. The last 24 are a grey scale.
The following image gives an idea of what each individual color looks like:
This picture does not exactly match up with Termonad's default colors, but it gives an idea of what each block of colors represents.
You can use defaultStandardColours
, defaultLightColours
,
defaultColourCube
, and defaultGreyscale
as a starting point to
customize the colors. The only time you'd need to use a constructor other
than NoPalette
is when you want to customize the default colors.
That is to say, using FullPalette
with all the defaults should give you the
same result as using NoPalette
.
NoPalette | Don't set any colors and just use the default from VTE. This is a black background with light grey text. |
BasicPalette !(Vec N8 c) | Set the colors from the standard colors. |
ExtendedPalette !(Vec N8 c) !(Vec N8 c) | Set the colors from the extended (light) colors (as well as standard colors). |
ColourCubePalette !(Vec N8 c) !(Vec N8 c) !(Matrix '[N6, N6, N6] c) | Set the colors from the color cube (as well as the standard colors and extended colors). |
FullPalette !(Vec N8 c) !(Vec N8 c) !(Matrix '[N6, N6, N6] c) !(Vec N24 c) | Set the colors from the grey scale (as well as the standard colors, extended colors, and color cube). |
Instances
Functor Palette Source # | |
Foldable Palette Source # | |
Defined in Termonad.Config.Colour fold :: Monoid m => Palette m -> m # foldMap :: Monoid m => (a -> m) -> Palette a -> m # foldr :: (a -> b -> b) -> b -> Palette a -> b # foldr' :: (a -> b -> b) -> b -> Palette a -> b # foldl :: (b -> a -> b) -> b -> Palette a -> b # foldl' :: (b -> a -> b) -> b -> Palette a -> b # foldr1 :: (a -> a -> a) -> Palette a -> a # foldl1 :: (a -> a -> a) -> Palette a -> a # elem :: Eq a => a -> Palette a -> Bool # maximum :: Ord a => Palette a -> a # minimum :: Ord a => Palette a -> a # | |
Eq c => Eq (Palette c) Source # | |
Show c => Show (Palette c) Source # | |
defaultStandardColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b) Source #
A Vec
of standard colors. Default value for BasicPalette
.
>>>
showColourVec defaultStandardColours
["#000000ff","#c00000ff","#00c000ff","#c0c000ff","#0000c0ff","#c000c0ff","#00c0c0ff","#c0c0c0ff"]
defaultLightColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b) Source #
A Vec
of extended (light) colors. Default value for ExtendedPalette
.
>>>
showColourVec defaultLightColours
["#3f3f3fff","#ff3f3fff","#3fff3fff","#ffff3fff","#3f3fffff","#ff3fffff","#3fffffff","#ffffffff"]
defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (AlphaColour b) Source #
A matrix of a 6 x 6 x 6 color cube. Default value for ColourCubePalette
.
>>>
putStrLn $ pack $ showColourCube defaultColourCube
[ [ #000000ff, #00005fff, #000087ff, #0000afff, #0000d7ff, #0000ffff , #005f00ff, #005f5fff, #005f87ff, #005fafff, #005fd7ff, #005fffff , #008700ff, #00875fff, #008787ff, #0087afff, #0087d7ff, #0087ffff , #00af00ff, #00af5fff, #00af87ff, #00afafff, #00afd7ff, #00afffff , #00d700ff, #00d75fff, #00d787ff, #00d7afff, #00d7d7ff, #00d7ffff , #00ff00ff, #00ff5fff, #00ff87ff, #00ffafff, #00ffd7ff, #00ffffff ] , [ #5f0000ff, #5f005fff, #5f0087ff, #5f00afff, #5f00d7ff, #5f00ffff , #5f5f00ff, #5f5f5fff, #5f5f87ff, #5f5fafff, #5f5fd7ff, #5f5fffff , #5f8700ff, #5f875fff, #5f8787ff, #5f87afff, #5f87d7ff, #5f87ffff , #5faf00ff, #5faf5fff, #5faf87ff, #5fafafff, #5fafd7ff, #5fafffff , #5fd700ff, #5fd75fff, #5fd787ff, #5fd7afff, #5fd7d7ff, #5fd7ffff , #5fff00ff, #5fff5fff, #5fff87ff, #5fffafff, #5fffd7ff, #5fffffff ] , [ #870000ff, #87005fff, #870087ff, #8700afff, #8700d7ff, #8700ffff , #875f00ff, #875f5fff, #875f87ff, #875fafff, #875fd7ff, #875fffff , #878700ff, #87875fff, #878787ff, #8787afff, #8787d7ff, #8787ffff , #87af00ff, #87af5fff, #87af87ff, #87afafff, #87afd7ff, #87afffff , #87d700ff, #87d75fff, #87d787ff, #87d7afff, #87d7d7ff, #87d7ffff , #87ff00ff, #87ff5fff, #87ff87ff, #87ffafff, #87ffd7ff, #87ffffff ] , [ #af0000ff, #af005fff, #af0087ff, #af00afff, #af00d7ff, #af00ffff , #af5f00ff, #af5f5fff, #af5f87ff, #af5fafff, #af5fd7ff, #af5fffff , #af8700ff, #af875fff, #af8787ff, #af87afff, #af87d7ff, #af87ffff , #afaf00ff, #afaf5fff, #afaf87ff, #afafafff, #afafd7ff, #afafffff , #afd700ff, #afd75fff, #afd787ff, #afd7afff, #afd7d7ff, #afd7ffff , #afff00ff, #afff5fff, #afff87ff, #afffafff, #afffd7ff, #afffffff ] , [ #d70000ff, #d7005fff, #d70087ff, #d700afff, #d700d7ff, #d700ffff , #d75f00ff, #d75f5fff, #d75f87ff, #d75fafff, #d75fd7ff, #d75fffff , #d78700ff, #d7875fff, #d78787ff, #d787afff, #d787d7ff, #d787ffff , #d7af00ff, #d7af5fff, #d7af87ff, #d7afafff, #d7afd7ff, #d7afffff , #d7d700ff, #d7d75fff, #d7d787ff, #d7d7afff, #d7d7d7ff, #d7d7ffff , #d7ff00ff, #d7ff5fff, #d7ff87ff, #d7ffafff, #d7ffd7ff, #d7ffffff ] , [ #ff0000ff, #ff005fff, #ff0087ff, #ff00afff, #ff00d7ff, #ff00ffff , #ff5f00ff, #ff5f5fff, #ff5f87ff, #ff5fafff, #ff5fd7ff, #ff5fffff , #ff8700ff, #ff875fff, #ff8787ff, #ff87afff, #ff87d7ff, #ff87ffff , #ffaf00ff, #ffaf5fff, #ffaf87ff, #ffafafff, #ffafd7ff, #ffafffff , #ffd700ff, #ffd75fff, #ffd787ff, #ffd7afff, #ffd7d7ff, #ffd7ffff , #ffff00ff, #ffff5fff, #ffff87ff, #ffffafff, #ffffd7ff, #ffffffff ] ]
defaultGreyscale :: (Ord b, Floating b) => Vec N24 (AlphaColour b) Source #
A Vec
of a grey scale. Default value for FullPalette
.
>>>
showColourVec defaultGreyscale
["#080808ff","#121212ff","#1c1c1cff","#262626ff","#303030ff","#3a3a3aff","#444444ff","#4e4e4eff","#585858ff","#626262ff","#6c6c6cff","#767676ff","#808080ff","#8a8a8aff","#949494ff","#9e9e9eff","#a8a8a8ff","#b2b2b2ff","#bcbcbcff","#c6c6c6ff","#d0d0d0ff","#dadadaff","#e4e4e4ff","#eeeeeeff"]
Colour
Check out the Data.Colour module for more info about AlphaColour
.
data AlphaColour a #
This type represents a Colour
that may be semi-transparent.
The Monoid
instance allows you to composite colours.
x `mappend` y == x `over` y
To get the (pre-multiplied) colour channel of an AlphaColour
c
,
simply composite c
over black.
c `over` black
Instances
AffineSpace AlphaColour | |
Defined in Data.Colour.Internal affineCombo :: Num a => [(a, AlphaColour a)] -> AlphaColour a -> AlphaColour a # | |
ColourOps AlphaColour | |
Defined in Data.Colour.Internal over :: Num a => AlphaColour a -> AlphaColour a -> AlphaColour a # darken :: Num a => a -> AlphaColour a -> AlphaColour a # | |
Eq a => Eq (AlphaColour a) | |
Defined in Data.Colour.Internal (==) :: AlphaColour a -> AlphaColour a -> Bool # (/=) :: AlphaColour a -> AlphaColour a -> Bool # | |
Num a => Semigroup (AlphaColour a) |
|
Defined in Data.Colour.Internal (<>) :: AlphaColour a -> AlphaColour a -> AlphaColour a # sconcat :: NonEmpty (AlphaColour a) -> AlphaColour a # stimes :: Integral b => b -> AlphaColour a -> AlphaColour a # | |
Num a => Monoid (AlphaColour a) | |
Defined in Data.Colour.Internal mempty :: AlphaColour a # mappend :: AlphaColour a -> AlphaColour a -> AlphaColour a # mconcat :: [AlphaColour a] -> AlphaColour a # |
:: Word8 | red channel |
-> Word8 | green channel |
-> Word8 | blue channel |
-> AlphaColour Double |
Create an AlphaColour
that is fully opaque
.
>>>
sRGB32show $ createColour 64 96 128
"#406080ff">>>
sRGB32show $ createColour 0 0 0
"#000000ff"
Similar to sRGB24
but for AlphaColour
.
:: Word8 | red channel |
-> Word8 | green channel |
-> Word8 | blue channel |
-> Word8 | alpha channel |
-> AlphaColour Double |
Create an AlphaColour
from a four Word8
s.
>>>
sRGB32show $ sRGB32 64 96 128 255
"#406080ff">>>
sRGB32show $ sRGB32 0x08 0x10 0x20 0x01
"#08102001"
Note that if you specify the alpha as 0 (which means completely translucent), all the color channels will be set to 0 as well.
>>>
sRGB32show $ sRGB32 100 150 200 0
"#00000000"
Similar to sRGB24
but also includes an alpha channel. Most users will
probably want to use createColour
instead.
sRGB32show :: AlphaColour Double -> String Source #
opaque :: Num a => Colour a -> AlphaColour a #
Creates an opaque AlphaColour
from a Colour
.
transparent :: Num a => AlphaColour a #
This AlphaColour
is entirely transparent and has no associated
colour channel.
Debugging and Internal Methods
showColourVec :: forall n. Vec n (AlphaColour Double) -> [String] Source #
A helper function for showing all the colors in Vec
of colors.
showColourCube :: Matrix '[N6, N6, N6] (AlphaColour Double) -> String Source #
Helper function for showing all the colors in a color cube. This is used for debugging.
paletteToList :: Palette c -> [c] Source #
Convert a Palette
to a list of colors. This is helpful for debugging.
coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (AlphaColour b) Source #
Create a vector of colors based on input bits.
This is used to derive defaultStandardColours
and defaultLightColours
.
>>>
coloursFromBits 192 0 == defaultStandardColours
True
>>>
coloursFromBits 192 63 == defaultLightColours
True
In general, as an end-user, you shouldn't need to use this.
cube :: forall b. Fractional b => AlphaColour b -> Vec N3 (AlphaColour b) -> Matrix '[N6, N6, N6] (AlphaColour b) Source #
Specify a colour cube with one colour vector for its displacement and three colour vectors for its edges. Produces a uniform 6x6x6 grid bounded by and orthognal to the faces.
Doctest setup
>>>
import Data.Colour.Names (green, red)
>>>
import Data.Colour.SRGB (sRGB24show)