xmonad-config/lib/XMonad/Internal/Theme.hs

212 lines
5.0 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- Theme for XMonad and Xmobar
module XMonad.Internal.Theme
( baseColor
, bgColor
, fgColor
, bordersColor
, warningColor
, errorColor
, selectedFgColor
, selectedBgColor
, selectedBordersColor
, backdropBaseColor
, backdropFgColor
, backdropTextColor
, blend'
, darken'
, Slant (..)
, Weight (..)
, FontData (..)
, FontBuilder
, buildFont
, fallbackFont
, defFontFamily
, defFontData
, tabbedTheme
, promptTheme
)
where
import Data.Colour
import Data.Colour.SRGB
import qualified RIO.Text as T
import qualified XMonad.Layout.Decoration as D
import qualified XMonad.Prompt as P
--------------------------------------------------------------------------------
-- Colors - vocabulary roughly based on GTK themes
baseColor :: T.Text
baseColor = "#f7f7f7"
bgColor :: T.Text
bgColor = "#d6d6d6"
fgColor :: T.Text
fgColor = "#2c2c2c"
bordersColor :: T.Text
bordersColor = darken' 0.3 bgColor
warningColor :: T.Text
warningColor = "#ffca28"
errorColor :: T.Text
errorColor = "#e53935"
selectedFgColor :: T.Text
selectedFgColor = "#ffffff"
selectedBgColor :: T.Text
selectedBgColor = "#4a79c7"
selectedBordersColor :: T.Text
selectedBordersColor = "#4a79c7"
backdropBaseColor :: T.Text
backdropBaseColor = baseColor
backdropTextColor :: T.Text
backdropTextColor = blend' 0.95 fgColor backdropBaseColor
backdropFgColor :: T.Text
backdropFgColor = blend' 0.75 fgColor bgColor
--------------------------------------------------------------------------------
-- Color functions
blend' :: Float -> T.Text -> T.Text -> T.Text
blend' wt c0 c1 = sRGB24showT $ blend wt (sRGB24readT c0) (sRGB24readT c1)
darken' :: Float -> T.Text -> T.Text
darken' wt = sRGB24showT . darken wt . sRGB24readT
sRGB24readT :: (RealFrac a, Floating a) => T.Text -> Colour a
sRGB24readT = sRGB24read . T.unpack
sRGB24showT :: (RealFrac a, Floating a) => Colour a -> T.Text
sRGB24showT = T.pack . sRGB24show
--------------------------------------------------------------------------------
-- Fonts
data Slant
= Roman
| Italic
| Oblique
deriving (Eq, Show)
data Weight
= Light
| Medium
| Demibold
| Bold
| Black
deriving (Eq, Show)
data FontData = FontData
{ weight :: Maybe Weight
, slant :: Maybe Slant
, size :: Maybe Int
, pixelsize :: Maybe Int
, antialias :: Maybe Bool
}
type FontBuilder = FontData -> T.Text
buildFont :: Maybe T.Text -> FontData -> T.Text
buildFont Nothing _ = "fixed"
buildFont
(Just fam)
FontData
{ weight = w
, slant = l
, size = s
, pixelsize = p
, antialias = a
} =
T.intercalate ":" $ ["xft", fam] ++ elems
where
elems =
[ T.concat [k, "=", v]
| (k, Just v) <-
[ ("weight", showLower w)
, ("slant", showLower l)
, ("size", showLower s)
, ("pixelsize", showLower p)
, ("antialias", showLower a)
]
]
showLower :: Show a => Maybe a -> Maybe T.Text
showLower = fmap (T.toLower . T.pack . show)
fallbackFont :: FontBuilder
fallbackFont = buildFont Nothing
--------------------------------------------------------------------------------
-- Default font and data
defFontData :: FontData
defFontData =
FontData
{ size = Just 10
, antialias = Just True
, weight = Nothing
, slant = Nothing
, pixelsize = Nothing
}
defFontFamily :: T.Text
defFontFamily = "DejaVu Sans"
-- defFontDep :: IODependency FontBuilder
-- defFontDep = fontDependency "DejaVu Sans"
-- defFontTree :: IOTree FontBuilder
-- defFontTree = fontTree "DejaVu Sans"
--------------------------------------------------------------------------------
-- Complete themes
tabbedTheme :: FontBuilder -> D.Theme
tabbedTheme fb =
D.def
{ D.fontName = T.unpack $ fb $ defFontData {weight = Just Bold}
, D.activeTextColor = T.unpack fgColor
, D.activeColor = T.unpack bgColor
, D.activeBorderColor = T.unpack bgColor
, D.inactiveTextColor = T.unpack backdropTextColor
, D.inactiveColor = T.unpack backdropFgColor
, D.inactiveBorderColor = T.unpack backdropFgColor
, D.urgentTextColor = T.unpack $ darken' 0.5 errorColor
, D.urgentColor = T.unpack errorColor
, D.urgentBorderColor = T.unpack errorColor
, -- this is in a newer version
-- , D.activeBorderWidth = 0
-- , D.inactiveBorderWidth = 0
-- , D.urgentBorderWidth = 0
D.decoHeight = 20
, D.windowTitleAddons = []
, D.windowTitleIcons = []
}
promptTheme :: FontBuilder -> P.XPConfig
promptTheme fb =
P.def
{ P.font = T.unpack $ fb $ defFontData {size = Just 12}
, P.bgColor = T.unpack bgColor
, P.fgColor = T.unpack fgColor
, P.fgHLight = T.unpack selectedFgColor
, P.bgHLight = T.unpack selectedBgColor
, P.borderColor = T.unpack bordersColor
, P.promptBorderWidth = 1
, P.height = 35
, P.position = P.CenteredAt 0.5 0.5
, P.historySize = 0
}