From 620b5c7e327eb3fb81259aecdd2d2f6b481a055b Mon Sep 17 00:00:00 2001 From: A D Date: Mon, 24 Jun 2019 19:10:26 +0400 Subject: [PATCH] Fix foreground and background colors --- example-config/ExampleColourExtension.hs | 4 +- .../ExampleSolarizedColourExtension.hs | 6 +-- src/Termonad/Config.hs | 1 + src/Termonad/Config/Colour.hs | 45 ++++++++++--------- src/Termonad/Types.hs | 6 +++ 5 files changed, 37 insertions(+), 25 deletions(-) diff --git a/example-config/ExampleColourExtension.hs b/example-config/ExampleColourExtension.hs index 6068d481..da968c55 100644 --- a/example-config/ExampleColourExtension.hs +++ b/example-config/ExampleColourExtension.hs @@ -7,7 +7,7 @@ module Main where import Data.Colour.SRGB (Colour, sRGB24) import Data.Singletons (sing) import Termonad - ( CursorBlinkMode(CursorBlinkModeOff), Option(Set) + ( CursorBlinkMode(CursorBlinkModeOff), DefaultOrUser(User), Option(Set) , ShowScrollbar(ShowScrollbarNever), TMConfig, confirmExit, cursorBlinkMode , defaultConfigOptions, defaultTMConfig, options, showMenu, showScrollbar , start @@ -45,7 +45,7 @@ myColourConfig = -- cursor. { cursorBgColour = Set (sRGB24 120 80 110) -- purple -- Set the default foreground colour of text of the terminal. - , foregroundColour = sRGB24 220 180 210 -- light pink + , foregroundColour = User (sRGB24 220 180 210) -- light pink -- Set the extended palette that has 8 colours standard colors and then 8 -- light colors. , palette = ExtendedPalette myStandardColours myLightColours diff --git a/example-config/ExampleSolarizedColourExtension.hs b/example-config/ExampleSolarizedColourExtension.hs index 93cf5dc8..be928de9 100644 --- a/example-config/ExampleSolarizedColourExtension.hs +++ b/example-config/ExampleSolarizedColourExtension.hs @@ -5,7 +5,7 @@ module Main where import Termonad - ( CursorBlinkMode(CursorBlinkModeOff), Option(Set) + ( CursorBlinkMode(CursorBlinkModeOff), DefaultOrUser(User), Option(Set) , ShowScrollbar(ShowScrollbarNever), TMConfig, confirmExit, cursorBlinkMode , defaultConfigOptions, defaultTMConfig, options, showMenu, showScrollbar , start @@ -39,7 +39,7 @@ solarizedDark :: ColourConfig (Colour Double) solarizedDark = defaultColourConfig -- Set the default foreground colour of text of the terminal. - { foregroundColour = sRGB24 131 148 150 -- base0 + { foregroundColour = User (sRGB24 131 148 150) -- base0 -- Set the extended palette that has 2 Vecs of 8 Solarized pallette colours , palette = ExtendedPalette solarizedDark1 solarizedDark2 } @@ -73,7 +73,7 @@ solarizedLight :: ColourConfig (Colour Double) solarizedLight = defaultColourConfig -- Set the default foreground colour of text of the terminal. - { foregroundColour = sRGB24 101 123 131 -- base00 + { foregroundColour = User (sRGB24 101 123 131) -- base00 -- Set the extended palette that has 2 Vecs of 8 Solarized pallette colours , palette = ExtendedPalette solarizedLight1 solarizedLight2 } diff --git a/src/Termonad/Config.hs b/src/Termonad/Config.hs index 67513108..f75169a5 100644 --- a/src/Termonad/Config.hs +++ b/src/Termonad/Config.hs @@ -50,6 +50,7 @@ module Termonad.Config , FontConfig(..) , defaultFontConfig -- * Misc + , DefaultOrUser(..) , Option(..) , ShowScrollbar(..) , ShowTabBar(..) diff --git a/src/Termonad/Config/Colour.hs b/src/Termonad/Config/Colour.hs index 40af791d..52c99903 100644 --- a/src/Termonad/Config/Colour.hs +++ b/src/Termonad/Config/Colour.hs @@ -57,7 +57,7 @@ import Control.Lens ((%~), makeLensesFor) import Data.Colour (Colour, black, affineCombo) import Data.Colour.SRGB (RGB(RGB), toSRGB, sRGB24, sRGB24show) import qualified Data.Foldable -import GI.Gdk (RGBA, newZeroRGBA, setRGBABlue, setRGBAGreen, setRGBARed) +import GI.Gdk (RGBA, newZeroRGBA, setRGBABlue, setRGBAGreen, setRGBARed, setRGBAAlpha) import GI.Vte ( Terminal , terminalSetColors @@ -65,7 +65,7 @@ import GI.Vte #ifdef VTE_VERSION_GEQ_0_44 , terminalSetColorCursorForeground #endif ---, terminalSetColorBackground + , terminalSetColorBackground , terminalSetColorForeground ) import Text.Show (showString) @@ -74,6 +74,7 @@ import Termonad.Config.Vec import Termonad.Lenses (lensCreateTermHook, lensHooks) import Termonad.Types ( Option(Unset) + , DefaultOrUser(Default, User) , TMConfig , TMState , whenSet @@ -328,12 +329,6 @@ defaultGreyscale = genVec_ $ \n -> -- foreground, it may be a good idea to change some of the colors in the -- 'Palette' as well. -- --- (__WARNING__: Currently due to issues either with VTE or the bindings generated for --- Haskell, background colour cannot be set independently of the palette. --- The @backgroundColour@ field will be ignored and the 0th colour in the --- palette (by default black) will be used as the background colour. See --- . --- -- 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 @@ -399,10 +394,9 @@ data ColourConfig c = ColourConfig -- versions of VTE. , cursorBgColour :: !(Option c) -- ^ Background color of the cursor. This is -- the color of the cursor itself. - , foregroundColour :: !c -- ^ Color of the default default foreground text in + , foregroundColour :: !(DefaultOrUser c) -- ^ Color of the default default foreground text in -- the terminal. - , backgroundColour :: !c -- ^ Background color for the terminal, however, See - -- the __WARNING__ above. + , backgroundColour :: !(DefaultOrUser c) -- ^ Background color for the terminal , palette :: !(Palette c) -- ^ Color palette for the terminal. See 'Palette'. } deriving (Eq, Show, Functor) @@ -420,8 +414,8 @@ defaultColourConfig :: ColourConfig (Colour Double) defaultColourConfig = ColourConfig { cursorFgColour = Unset , cursorBgColour = Unset - , foregroundColour = sRGB24 192 192 192 - , backgroundColour = black + , foregroundColour = Default (sRGB24 192 192 192) + , backgroundColour = Default black , palette = NoPalette } @@ -455,13 +449,23 @@ data ColourExtension = ColourExtension colourHook :: MVar (ColourConfig (Colour Double)) -> TMState -> Terminal -> IO () colourHook mvarColourConf _ vteTerm = do colourConf <- readMVar mvarColourConf - terminalSetColors vteTerm Nothing Nothing . Just - =<< traverse toRGBA (paletteToList . palette $ colourConf) - -- PR #28 / issue #29: Setting the background colour is broken in gi-vte or VTE. If - -- this next line is called, then you are no longer able to set the - -- background color using the palette. - -- terminalSetColorBackground vteTerm =<< toRGBA (backgroundColour colourConf) - terminalSetColorForeground vteTerm =<< toRGBA (foregroundColour colourConf) + case palette colourConf of + NoPalette -> do + case foregroundColour colourConf of + User colour -> terminalSetColorForeground vteTerm =<< toRGBA colour + Default colour -> terminalSetColorForeground vteTerm =<< toRGBA colour + case backgroundColour colourConf of + User colour -> terminalSetColorBackground vteTerm =<< toRGBA colour + Default colour -> terminalSetColorBackground vteTerm =<< toRGBA colour + _ -> do + terminalSetColors vteTerm Nothing Nothing . Just + =<< traverse toRGBA (paletteToList . palette $ colourConf) + case foregroundColour colourConf of + User colour -> terminalSetColorForeground vteTerm =<< toRGBA colour + Default _ -> pure () + case backgroundColour colourConf of + User colour -> terminalSetColorBackground vteTerm =<< toRGBA colour + Default _ -> pure () let optPerform setC cField = whenSet (cField colourConf) $ \c -> setC vteTerm . Just =<< toRGBA c optPerform terminalSetColorCursor cursorBgColour @@ -476,6 +480,7 @@ colourHook mvarColourConf _ vteTerm = do setRGBARed rgba red setRGBAGreen rgba green setRGBABlue rgba blue + setRGBAAlpha rgba 1 pure rgba -- | Create a 'ColourExtension' based on a given 'ColourConfig'. diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 9b5cd5d2..463efbcc 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -338,6 +338,12 @@ whenSet = \case Unset -> \_ -> mempty Set x -> \f -> f x +-- | Type for differentiating between a default value and a value set by user in config. +-- It is needed for background and foreground colors of a terminal when the palette value +-- is present. +data DefaultOrUser a = Default !a | User !a + deriving (Eq, Show, Functor) + -- | Whether or not to show the scroll bar in a terminal. data ShowScrollbar = ShowScrollbarNever -- ^ Never show the scroll bar, even if there are too