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

196 lines
5.1 KiB
Haskell
Raw Normal View History

2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Theme for XMonad and Xmobar
2020-04-01 20:17:47 -04:00
module XMonad.Internal.Theme
( baseColor
, bgColor
, fgColor
, bordersColor
, warningColor
, errorColor
, selectedFgColor
, selectedBgColor
, selectedBordersColor
, backdropBaseColor
, backdropFgColor
, backdropTextColor
, blend'
, darken'
, Slant(..)
, Weight(..)
2022-07-02 17:09:21 -04:00
, FontData(..)
, FontBuilder
, buildFont
, defFontData
, defFont
, fontFeature
2020-04-01 20:17:47 -04:00
, tabbedTheme
, promptTheme
) where
2020-04-01 21:03:00 -04:00
import Data.Char
2020-04-01 20:17:47 -04:00
import Data.Colour
import Data.Colour.SRGB
import Data.List
2020-03-16 13:50:08 -04:00
2022-07-02 17:09:21 -04:00
import XMonad.Internal.Dependency
import qualified XMonad.Layout.Decoration as D
import qualified XMonad.Prompt as P
2020-03-16 13:50:08 -04:00
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Colors - vocabulary roughly based on GTK themes
2020-03-16 13:50:08 -04:00
baseColor :: String
baseColor = "#f7f7f7"
bgColor :: String
bgColor = "#d6d6d6"
fgColor :: String
2020-03-16 14:48:38 -04:00
fgColor = "#2c2c2c"
2020-03-16 13:50:08 -04:00
bordersColor :: String
2020-03-22 17:59:49 -04:00
bordersColor = darken' 0.3 bgColor
2020-03-16 13:50:08 -04:00
warningColor :: String
warningColor = "#ffca28"
errorColor :: String
errorColor = "#e53935"
selectedFgColor :: String
selectedFgColor = "#ffffff"
selectedBgColor :: String
2021-11-05 16:54:53 -04:00
selectedBgColor = "#4a79c7"
2020-03-16 13:50:08 -04:00
2020-03-22 17:59:49 -04:00
selectedBordersColor :: String
2021-11-05 16:54:53 -04:00
selectedBordersColor = "#4a79c7"
2020-03-22 17:59:49 -04:00
2020-03-16 13:50:08 -04:00
backdropBaseColor :: String
backdropBaseColor = baseColor
backdropTextColor :: String
backdropTextColor = blend' 0.95 fgColor backdropBaseColor
backdropFgColor :: String
backdropFgColor = blend' 0.75 fgColor bgColor
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Color functions
2020-03-16 13:50:08 -04:00
blend' :: Float -> String -> String -> String
blend' wt c0 c1 = sRGB24show $ blend wt (sRGB24read c0) (sRGB24read c1)
darken' :: Float -> String -> String
darken' wt = sRGB24show . darken wt . sRGB24read
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Fonts
2020-03-16 13:50:08 -04:00
2020-03-22 17:59:49 -04:00
data Slant = Roman
| Italic
| Oblique
deriving (Eq, Show)
data Weight = Light
| Medium
| Demibold
| Bold
| Black
deriving (Eq, Show)
2022-07-02 17:09:21 -04:00
data FontData = FontData
{ weight :: Maybe Weight
2020-03-22 17:59:49 -04:00
, slant :: Maybe Slant
, size :: Maybe Int
, pixelsize :: Maybe Int
, antialias :: Maybe Bool
}
2020-03-16 13:50:08 -04:00
2022-07-02 17:09:21 -04:00
type FontBuilder = FontData -> String
buildFont :: Maybe String -> FontData -> String
buildFont Nothing _ = "fixed"
buildFont (Just fam) FontData { weight = w
, slant = l
, size = s
, pixelsize = p
, antialias = a
}
= intercalate ":" $ ["xft", fam] ++ elems
2020-03-16 13:50:08 -04:00
where
2020-04-01 21:03:00 -04:00
elems = [ 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 String
showLower = fmap (fmap toLower . show)
2020-03-16 13:50:08 -04:00
2022-07-02 17:09:21 -04:00
fontFeature :: String -> String -> Always FontBuilder
fontFeature n fam = always1 n sfn root def
where
sfn = "Font family for " ++ fam
root = IORoot_ (buildFont $ Just fam) $ Only_ $ fontFam fam
def = buildFont Nothing
--------------------------------------------------------------------------------
-- | Default font and data
defFontData :: FontData
defFontData = FontData
{ size = Just 10
2020-03-16 13:50:08 -04:00
, antialias = Just True
, weight = Nothing
, slant = Nothing
, pixelsize = Nothing
}
2022-07-02 17:09:21 -04:00
defFont :: Always FontBuilder
defFont = fontFeature "Default Font" "DejaVu Sans"
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Complete themes
2020-03-16 13:50:08 -04:00
2022-07-02 17:09:21 -04:00
tabbedTheme :: FontBuilder -> D.Theme
tabbedTheme fb = D.def
{ D.fontName = fb $ defFontData { weight = Just Bold }
2020-03-16 13:50:08 -04:00
, D.activeTextColor = fgColor
, D.activeColor = bgColor
, D.activeBorderColor = bgColor
, D.inactiveTextColor = backdropTextColor
, D.inactiveColor = backdropFgColor
, D.inactiveBorderColor = backdropFgColor
, D.urgentTextColor = darken' 0.5 errorColor
, D.urgentColor = errorColor
, D.urgentBorderColor = errorColor
-- this is in a newer version
-- , D.activeBorderWidth = 0
-- , D.inactiveBorderWidth = 0
-- , D.urgentBorderWidth = 0
, D.decoHeight = 20
, D.windowTitleAddons = []
, D.windowTitleIcons = []
2022-07-02 17:09:21 -04:00
}
2020-03-16 13:50:08 -04:00
2022-07-02 17:09:21 -04:00
promptTheme :: FontBuilder -> P.XPConfig
promptTheme fb = P.def
{ P.font = fb $ defFontData { size = Just 12 }
2020-03-16 13:50:08 -04:00
, P.bgColor = bgColor
, P.fgColor = fgColor
, P.fgHLight = selectedFgColor
, P.bgHLight = selectedBgColor
, P.borderColor = bordersColor
, P.promptBorderWidth = 1
2020-04-01 22:49:36 -04:00
, P.height = 35
2020-03-16 13:50:08 -04:00
, P.position = P.CenteredAt 0.5 0.5
}