Fix foreground and background colors

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

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
     }

src/Termonad/Config.hs

@@ -50,6 +50,7 @@ module Termonad.Config
   , FontConfig(..)
   , defaultFontConfig
   -- * Misc
+  , DefaultOrUser(..)
   , Option(..)
   , ShowScrollbar(..)
   , ShowTabBar(..)

src/Termonad/Config/Colour.hs

@@ -57,15 +57,15 @@ 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
   , terminalSetColorCursor
 #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
--- <https://github.com/cdepillabout/termonad/issues/29 this issue>.
---
 -- 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'.

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