ENH move theming to own module
This commit is contained in:
parent
6c385c27cb
commit
7787006621
|
@ -1,27 +1,17 @@
|
||||||
import Xmobar.Screensaver
|
import Xmobar.Screensaver
|
||||||
|
|
||||||
|
import qualified Theme as T
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
import XMonad (getXMonadDir)
|
import XMonad (getXMonadDir)
|
||||||
|
|
||||||
fgColor0 :: String
|
|
||||||
fgColor0 = "black"
|
|
||||||
|
|
||||||
fgColor1 :: String
|
|
||||||
fgColor1 = "#888888"
|
|
||||||
|
|
||||||
bgColor0 :: String
|
|
||||||
bgColor0 = "#eeeeee"
|
|
||||||
|
|
||||||
bdColor :: String
|
|
||||||
bdColor = "#cccccc"
|
|
||||||
|
|
||||||
wrapColor :: String -> String -> String
|
wrapColor :: String -> String -> String
|
||||||
wrapColor c s = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
|
wrapColor c s = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
|
||||||
|
|
||||||
sep :: String
|
sep :: String
|
||||||
sep = wrapColor fgColor1 " : "
|
sep = wrapColor T.backdropFgColor " : "
|
||||||
|
|
||||||
myTemplate :: String
|
myTemplate :: String
|
||||||
myTemplate = formatTemplate left right
|
myTemplate = formatTemplate left right
|
||||||
|
@ -40,20 +30,38 @@ myTemplate = formatTemplate left right
|
||||||
, "%date%"
|
, "%date%"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
barFont :: String
|
||||||
|
barFont = T.fmtFontXFT T.font
|
||||||
|
{ T.family = "DejaVu Sans Mono"
|
||||||
|
, T.size = Just 11
|
||||||
|
, T.weight = Just T.Bold
|
||||||
|
}
|
||||||
|
|
||||||
|
iconFont :: String
|
||||||
|
iconFont = T.fmtFontXFT T.font
|
||||||
|
{ T.family = "FontAwesome"
|
||||||
|
, T.size = Nothing
|
||||||
|
, T.pixelsize = Just 13
|
||||||
|
}
|
||||||
|
|
||||||
|
blockFont :: String
|
||||||
|
blockFont = T.fmtFontXFT T.font
|
||||||
|
{ T.family = "Symbola"
|
||||||
|
, T.size = Just 13
|
||||||
|
, T.weight = Just T.Bold
|
||||||
|
}
|
||||||
|
|
||||||
config :: String -> Config
|
config :: String -> Config
|
||||||
config confDir = defaultConfig {
|
config confDir = defaultConfig {
|
||||||
font = "xft:DejaVu Sans Mono:size=11:bold:antialias=true"
|
font = barFont
|
||||||
, additionalFonts =
|
, additionalFonts = [ iconFont, blockFont ]
|
||||||
[ "xft:FontAwesome:pixelsize=13:antialias=true:hinting=true"
|
|
||||||
, "xft:Symbola:size=13:bold:antialias=true"
|
|
||||||
]
|
|
||||||
, textOffset = 16
|
, textOffset = 16
|
||||||
, textOffsets = [ 16, 17 ]
|
, textOffsets = [ 16, 17 ]
|
||||||
, bgColor = bgColor0
|
, bgColor = T.bgColor
|
||||||
, fgColor = fgColor0
|
, fgColor = T.fgColor
|
||||||
, position = BottomSize C 100 24
|
, position = BottomSize C 100 24
|
||||||
, border = NoBorder
|
, border = NoBorder
|
||||||
, borderColor = bdColor
|
, borderColor = T.bordersColor
|
||||||
|
|
||||||
, sepChar = "%"
|
, sepChar = "%"
|
||||||
, alignSep = "}{"
|
, alignSep = "}{"
|
||||||
|
@ -73,16 +81,16 @@ config confDir = defaultConfig {
|
||||||
, "--"
|
, "--"
|
||||||
, "-O", "<fn=1>\xf028</fn>"
|
, "-O", "<fn=1>\xf028</fn>"
|
||||||
, "-o", "<fn=1>\xf026 </fn>"
|
, "-o", "<fn=1>\xf026 </fn>"
|
||||||
, "-c", fgColor0
|
, "-c", T.fgColor
|
||||||
, "-C", fgColor0
|
, "-C", T.fgColor
|
||||||
]
|
]
|
||||||
|
|
||||||
, Run $ Battery [ "--template", "<acstatus><left>"
|
, Run $ Battery [ "--template", "<acstatus><left>"
|
||||||
, "--Low", "10"
|
, "--Low", "10"
|
||||||
, "--High", "80"
|
, "--High", "80"
|
||||||
, "--low", "red"
|
, "--low", "red"
|
||||||
, "--normal", fgColor0
|
, "--normal", T.fgColor
|
||||||
, "--high", fgColor0
|
, "--high", T.fgColor
|
||||||
, "--"
|
, "--"
|
||||||
, "-P"
|
, "-P"
|
||||||
, "-o" , "<fn=1>\xf0e7</fn>"
|
, "-o" , "<fn=1>\xf0e7</fn>"
|
||||||
|
@ -103,9 +111,9 @@ config confDir = defaultConfig {
|
||||||
|
|
||||||
, Run $ Locks
|
, Run $ Locks
|
||||||
[ "-N", "<fn=2>\x1f13d</fn>"
|
[ "-N", "<fn=2>\x1f13d</fn>"
|
||||||
, "-n", wrapColor fgColor1 "<fn=2>\x1f13d</fn>"
|
, "-n", wrapColor T.backdropFgColor "<fn=2>\x1f13d</fn>"
|
||||||
, "-C", "<fn=2>\x1f132</fn>"
|
, "-C", "<fn=2>\x1f132</fn>"
|
||||||
, "-c", wrapColor fgColor1 "<fn=2>\x1f132</fn>"
|
, "-c", wrapColor T.backdropFgColor "<fn=2>\x1f132</fn>"
|
||||||
, "-s", ""
|
, "-s", ""
|
||||||
, "-S", ""
|
, "-S", ""
|
||||||
, "-d", "<fn=2> </fn>"
|
, "-d", "<fn=2> </fn>"
|
||||||
|
@ -113,7 +121,7 @@ config confDir = defaultConfig {
|
||||||
|
|
||||||
, Run $ Date "%Y-%m-%d %H:%M" "date" 10
|
, Run $ Date "%Y-%m-%d %H:%M" "date" 10
|
||||||
|
|
||||||
, Run $ Screensaver ("<fn=1>\xf254</fn>", fgColor0, fgColor1) 10
|
, Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.fgColor) 10
|
||||||
|
|
||||||
, Run UnsafeStdinReader
|
, Run UnsafeStdinReader
|
||||||
]
|
]
|
||||||
|
|
|
@ -5,6 +5,7 @@ module Main (main) where
|
||||||
|
|
||||||
import ACPI
|
import ACPI
|
||||||
import SendXMsg
|
import SendXMsg
|
||||||
|
import Theme
|
||||||
|
|
||||||
import Control.Monad (mapM_, forM_, void, when)
|
import Control.Monad (mapM_, forM_, void, when)
|
||||||
|
|
||||||
|
@ -97,29 +98,6 @@ spawnPipe' x = io $ do
|
||||||
closeFd rd
|
closeFd rd
|
||||||
return (p, h)
|
return (p, h)
|
||||||
|
|
||||||
myTopBarTheme = def
|
|
||||||
{ fontName = myFont
|
|
||||||
, inactiveBorderColor = "#999999"
|
|
||||||
, inactiveColor = "#999999"
|
|
||||||
, inactiveTextColor = "#999999"
|
|
||||||
, activeBorderColor = "#d6d6d6"
|
|
||||||
, activeColor = "#d6d6d6"
|
|
||||||
, activeTextColor = "#d6d6d6"
|
|
||||||
-- , urgentBorderColor = red
|
|
||||||
-- , urgentTextColor = yellow
|
|
||||||
, decoHeight = 20
|
|
||||||
}
|
|
||||||
|
|
||||||
myTabbedTheme = def
|
|
||||||
{ fontName = myFont
|
|
||||||
, activeColor = "#d6d6d6"
|
|
||||||
, activeTextColor = "black"
|
|
||||||
, activeBorderColor = "#d6d6d6"
|
|
||||||
, inactiveColor = "#999999"
|
|
||||||
, inactiveTextColor = "#333333"
|
|
||||||
, inactiveBorderColor = "#999999"
|
|
||||||
}
|
|
||||||
|
|
||||||
myWorkspaces = map show [1..10 :: Int]
|
myWorkspaces = map show [1..10 :: Int]
|
||||||
|
|
||||||
myVMWorkspace = "VM"
|
myVMWorkspace = "VM"
|
||||||
|
@ -129,7 +107,7 @@ myLayouts = onWorkspace myVMWorkspace (noBorders Full)
|
||||||
-- $ onWorkspace myGimpWorkspace gimpLayout
|
-- $ onWorkspace myGimpWorkspace gimpLayout
|
||||||
$ tall ||| single ||| full
|
$ tall ||| single ||| full
|
||||||
where
|
where
|
||||||
addTopBar = noFrillsDeco shrinkText myTopBarTheme
|
addTopBar = noFrillsDeco shrinkText tabbedTheme
|
||||||
tall = named "Tall"
|
tall = named "Tall"
|
||||||
$ avoidStruts
|
$ avoidStruts
|
||||||
$ addTopBar
|
$ addTopBar
|
||||||
|
@ -139,7 +117,7 @@ myLayouts = onWorkspace myVMWorkspace (noBorders Full)
|
||||||
-- $ addTopBar
|
-- $ addTopBar
|
||||||
$ avoidStruts
|
$ avoidStruts
|
||||||
$ noBorders
|
$ noBorders
|
||||||
$ tabbedAlways shrinkText myTabbedTheme
|
$ tabbedAlways shrinkText tabbedTheme
|
||||||
full = named "Full"
|
full = named "Full"
|
||||||
$ noBorders Full
|
$ noBorders Full
|
||||||
-- gimpLayout = named "Gimp Layout"
|
-- gimpLayout = named "Gimp Layout"
|
||||||
|
@ -230,7 +208,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
let acpiTag = readMaybe tag :: Maybe ACPIEvent
|
let acpiTag = readMaybe tag :: Maybe ACPIEvent
|
||||||
forM_ acpiTag $ \case
|
forM_ acpiTag $ \case
|
||||||
Power -> myPowerPrompt
|
Power -> myPowerPrompt
|
||||||
Sleep -> confirmPrompt myPromptTheme "suspend?" runSuspend
|
Sleep -> confirmPrompt promptTheme "suspend?" runSuspend
|
||||||
LidClose -> do
|
LidClose -> do
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
||||||
|
@ -248,57 +226,6 @@ removeEmptyWorkspaceByTag' tag = do
|
||||||
-- this will be enough to make it disappear.
|
-- this will be enough to make it disappear.
|
||||||
removeEmptyWorkspaceByTag tag
|
removeEmptyWorkspaceByTag tag
|
||||||
|
|
||||||
-- themes
|
|
||||||
myFont = "xft:DejaVu Sans:size=11:autohint=false"
|
|
||||||
|
|
||||||
-- base00 = "#657b83"
|
|
||||||
-- base01 = "#586e75"
|
|
||||||
-- base02 = "#073642"
|
|
||||||
-- base03 = "#002b36"
|
|
||||||
-- base0 = "#839496"
|
|
||||||
-- base1 = "#93a1a1"
|
|
||||||
-- base2 = "#eee8d5"
|
|
||||||
-- base3 = "#fdf6e3"
|
|
||||||
-- yellow = "#b58900"
|
|
||||||
-- orange = "#cb4b16"
|
|
||||||
-- red = "#dc322f"
|
|
||||||
-- magenta = "#d33682"
|
|
||||||
-- violet = "#6c71c4"
|
|
||||||
-- blue = "#268bd2"
|
|
||||||
-- cyan = "#2aa198"
|
|
||||||
-- green = "#859900"
|
|
||||||
|
|
||||||
-- gap = 10
|
|
||||||
-- topbar = 10
|
|
||||||
-- border = 0
|
|
||||||
-- prompt = 20
|
|
||||||
-- status = 20
|
|
||||||
|
|
||||||
-- active = blue
|
|
||||||
-- activeWarn = red
|
|
||||||
-- inactive = base02
|
|
||||||
-- focusColor = blue
|
|
||||||
-- unfocusColor = base02
|
|
||||||
|
|
||||||
myPromptTheme = def
|
|
||||||
{ font = myFont
|
|
||||||
, bgColor = "#eeeeee"
|
|
||||||
, fgColor = "#282828"
|
|
||||||
, fgHLight = "white"
|
|
||||||
, bgHLight = "#268bd2"
|
|
||||||
, borderColor = "white"
|
|
||||||
, promptBorderWidth = 0
|
|
||||||
, height = 30
|
|
||||||
, position = CenteredAt 0.5 0.5
|
|
||||||
}
|
|
||||||
|
|
||||||
-- hotPromptTheme = myPromptTheme
|
|
||||||
-- { bgColor = red
|
|
||||||
-- , fgColor = base3
|
|
||||||
-- , position = Top
|
|
||||||
-- }
|
|
||||||
|
|
||||||
|
|
||||||
-- TODO is there a better way to get the prompt to say what I want?
|
-- TODO is there a better way to get the prompt to say what I want?
|
||||||
data PowerPrompt = PowerPrompt
|
data PowerPrompt = PowerPrompt
|
||||||
|
|
||||||
|
@ -326,7 +253,7 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps
|
||||||
. (`lookup` commands)
|
. (`lookup` commands)
|
||||||
where
|
where
|
||||||
comps = mkComplFunFromList' (map fst commands)
|
comps = mkComplFunFromList' (map fst commands)
|
||||||
conf = myPromptTheme
|
conf = promptTheme
|
||||||
commands =
|
commands =
|
||||||
[ ("poweroff", runPowerOff)
|
[ ("poweroff", runPowerOff)
|
||||||
, ("suspend", runScreenLock >> runSuspend)
|
, ("suspend", runScreenLock >> runSuspend)
|
||||||
|
@ -335,7 +262,7 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps
|
||||||
]
|
]
|
||||||
|
|
||||||
myQuitPrompt :: X ()
|
myQuitPrompt :: X ()
|
||||||
myQuitPrompt = confirmPrompt myPromptTheme "quit?" $ io exitSuccess
|
myQuitPrompt = confirmPrompt promptTheme "quit?" $ io exitSuccess
|
||||||
|
|
||||||
-- shell commands
|
-- shell commands
|
||||||
|
|
||||||
|
@ -508,9 +435,11 @@ runVolumeUp = void (raiseVolume 2)
|
||||||
runVolumeMute :: X ()
|
runVolumeMute :: X ()
|
||||||
runVolumeMute = void toggleMute
|
runVolumeMute = void toggleMute
|
||||||
|
|
||||||
|
-- TODO write this in haskell
|
||||||
runToggleBluetooth :: X ()
|
runToggleBluetooth :: X ()
|
||||||
runToggleBluetooth = spawn "togglebt"
|
runToggleBluetooth = spawn "togglebt"
|
||||||
|
|
||||||
|
-- TODO write these in haskell
|
||||||
runIncBacklight :: X ()
|
runIncBacklight :: X ()
|
||||||
runIncBacklight = spawnCmd "adj_backlight" ["up"]
|
runIncBacklight = spawnCmd "adj_backlight" ["up"]
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,141 @@
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Theme where
|
||||||
|
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
|
import Data.Colour
|
||||||
|
import Data.Colour.SRGB
|
||||||
|
|
||||||
|
import Data.List
|
||||||
|
|
||||||
|
import qualified XMonad.Layout.Decoration as D
|
||||||
|
import qualified XMonad.Prompt as P
|
||||||
|
|
||||||
|
-- Colors
|
||||||
|
|
||||||
|
baseColor :: String
|
||||||
|
baseColor = "#f7f7f7"
|
||||||
|
|
||||||
|
bgColor :: String
|
||||||
|
bgColor = "#d6d6d6"
|
||||||
|
|
||||||
|
fgColor :: String
|
||||||
|
fgColor = "#000000"
|
||||||
|
|
||||||
|
bordersColor :: String
|
||||||
|
bordersColor = darken' 0.85 bgColor
|
||||||
|
|
||||||
|
warningColor :: String
|
||||||
|
warningColor = "#ffca28"
|
||||||
|
|
||||||
|
errorColor :: String
|
||||||
|
errorColor = "#e53935"
|
||||||
|
|
||||||
|
selectedFgColor :: String
|
||||||
|
selectedFgColor = "#ffffff"
|
||||||
|
|
||||||
|
selectedBgColor :: String
|
||||||
|
selectedBgColor = "#3399ff"
|
||||||
|
|
||||||
|
backdropBaseColor :: String
|
||||||
|
backdropBaseColor = baseColor
|
||||||
|
|
||||||
|
backdropTextColor :: String
|
||||||
|
backdropTextColor = blend' 0.95 fgColor backdropBaseColor
|
||||||
|
|
||||||
|
backdropFgColor :: String
|
||||||
|
backdropFgColor = blend' 0.75 fgColor bgColor
|
||||||
|
|
||||||
|
-- Color functions
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
-- Fonts
|
||||||
|
|
||||||
|
data Slant = Roman | Italic | Oblique deriving (Eq, Show)
|
||||||
|
|
||||||
|
data Weight = Light | Medium | Demibold | Bold | Black deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ThemeFont = ThemeFont
|
||||||
|
{ family :: String
|
||||||
|
, weight :: Maybe Weight
|
||||||
|
, slant :: Maybe Slant
|
||||||
|
, size :: Maybe Int
|
||||||
|
, pixelsize :: Maybe Int
|
||||||
|
, antialias :: Maybe Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
fmtFontXFT :: ThemeFont -> String
|
||||||
|
fmtFontXFT ThemeFont
|
||||||
|
-- TODO there should be a better way to do this...
|
||||||
|
{ family = f
|
||||||
|
, weight = w
|
||||||
|
, slant = l
|
||||||
|
, size = s
|
||||||
|
, pixelsize = i
|
||||||
|
, antialias = a
|
||||||
|
} = "xft:" ++ intercalate ":" (filter (not . null) elems)
|
||||||
|
where
|
||||||
|
elems = [ f
|
||||||
|
, fmt "weight" w
|
||||||
|
, fmt "slant" l
|
||||||
|
, fmt "size" s
|
||||||
|
, fmt "pixelsize" i
|
||||||
|
, fmt "antialias" a]
|
||||||
|
fmt :: Show a => String -> Maybe a -> String
|
||||||
|
fmt e = \case
|
||||||
|
Just d -> e ++ "=" ++ map toLower (show d)
|
||||||
|
Nothing -> ""
|
||||||
|
|
||||||
|
font = ThemeFont
|
||||||
|
{ family = "DejaVu Sans"
|
||||||
|
, size = Just 11
|
||||||
|
, antialias = Just True
|
||||||
|
, weight = Nothing
|
||||||
|
, slant = Nothing
|
||||||
|
, pixelsize = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
-- Complete themes
|
||||||
|
|
||||||
|
tabbedTheme = D.def
|
||||||
|
{ D.fontName = fmtFontXFT font
|
||||||
|
|
||||||
|
, 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 = []
|
||||||
|
}
|
||||||
|
|
||||||
|
promptTheme = P.def
|
||||||
|
{ P.font = fmtFontXFT font
|
||||||
|
, P.bgColor = bgColor
|
||||||
|
, P.fgColor = fgColor
|
||||||
|
, P.fgHLight = selectedFgColor
|
||||||
|
, P.bgHLight = selectedBgColor
|
||||||
|
, P.borderColor = bordersColor
|
||||||
|
, P.promptBorderWidth = 1
|
||||||
|
, P.height = 30
|
||||||
|
, P.position = P.CenteredAt 0.5 0.5
|
||||||
|
}
|
|
@ -7,9 +7,12 @@ library
|
||||||
hs-source-dirs: lib
|
hs-source-dirs: lib
|
||||||
exposed-modules: SendXMsg
|
exposed-modules: SendXMsg
|
||||||
, ACPI
|
, ACPI
|
||||||
|
, Theme
|
||||||
, Xmobar.Screensaver
|
, Xmobar.Screensaver
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, X11 >= 1.9.1
|
, X11 >= 1.9.1
|
||||||
|
, colour >= 2.3.5
|
||||||
|
, xmonad-contrib >= 0.13
|
||||||
, xmobar
|
, xmobar
|
||||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in New Issue