ENH move theming to own module
This commit is contained in:
parent
6c385c27cb
commit
7787006621
|
|
@ -1,27 +1,17 @@
|
|||
import Xmobar.Screensaver
|
||||
|
||||
import qualified Theme as T
|
||||
|
||||
import Data.List
|
||||
|
||||
import Xmobar
|
||||
import XMonad (getXMonadDir)
|
||||
|
||||
fgColor0 :: String
|
||||
fgColor0 = "black"
|
||||
|
||||
fgColor1 :: String
|
||||
fgColor1 = "#888888"
|
||||
|
||||
bgColor0 :: String
|
||||
bgColor0 = "#eeeeee"
|
||||
|
||||
bdColor :: String
|
||||
bdColor = "#cccccc"
|
||||
|
||||
wrapColor :: String -> String -> String
|
||||
wrapColor c s = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
|
||||
|
||||
sep :: String
|
||||
sep = wrapColor fgColor1 " : "
|
||||
sep = wrapColor T.backdropFgColor " : "
|
||||
|
||||
myTemplate :: String
|
||||
myTemplate = formatTemplate left right
|
||||
|
|
@ -40,20 +30,38 @@ myTemplate = formatTemplate left right
|
|||
, "%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 confDir = defaultConfig {
|
||||
font = "xft:DejaVu Sans Mono:size=11:bold:antialias=true"
|
||||
, additionalFonts =
|
||||
[ "xft:FontAwesome:pixelsize=13:antialias=true:hinting=true"
|
||||
, "xft:Symbola:size=13:bold:antialias=true"
|
||||
]
|
||||
font = barFont
|
||||
, additionalFonts = [ iconFont, blockFont ]
|
||||
, textOffset = 16
|
||||
, textOffsets = [ 16, 17 ]
|
||||
, bgColor = bgColor0
|
||||
, fgColor = fgColor0
|
||||
, bgColor = T.bgColor
|
||||
, fgColor = T.fgColor
|
||||
, position = BottomSize C 100 24
|
||||
, border = NoBorder
|
||||
, borderColor = bdColor
|
||||
, borderColor = T.bordersColor
|
||||
|
||||
, sepChar = "%"
|
||||
, alignSep = "}{"
|
||||
|
|
@ -73,16 +81,16 @@ config confDir = defaultConfig {
|
|||
, "--"
|
||||
, "-O", "<fn=1>\xf028</fn>"
|
||||
, "-o", "<fn=1>\xf026 </fn>"
|
||||
, "-c", fgColor0
|
||||
, "-C", fgColor0
|
||||
, "-c", T.fgColor
|
||||
, "-C", T.fgColor
|
||||
]
|
||||
|
||||
, Run $ Battery [ "--template", "<acstatus><left>"
|
||||
, "--Low", "10"
|
||||
, "--High", "80"
|
||||
, "--low", "red"
|
||||
, "--normal", fgColor0
|
||||
, "--high", fgColor0
|
||||
, "--normal", T.fgColor
|
||||
, "--high", T.fgColor
|
||||
, "--"
|
||||
, "-P"
|
||||
, "-o" , "<fn=1>\xf0e7</fn>"
|
||||
|
|
@ -103,9 +111,9 @@ config confDir = defaultConfig {
|
|||
|
||||
, Run $ Locks
|
||||
[ "-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", wrapColor fgColor1 "<fn=2>\x1f132</fn>"
|
||||
, "-c", wrapColor T.backdropFgColor "<fn=2>\x1f132</fn>"
|
||||
, "-s", ""
|
||||
, "-S", ""
|
||||
, "-d", "<fn=2> </fn>"
|
||||
|
|
@ -113,7 +121,7 @@ config confDir = defaultConfig {
|
|||
|
||||
, 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
|
||||
]
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@ module Main (main) where
|
|||
|
||||
import ACPI
|
||||
import SendXMsg
|
||||
import Theme
|
||||
|
||||
import Control.Monad (mapM_, forM_, void, when)
|
||||
|
||||
|
|
@ -97,29 +98,6 @@ spawnPipe' x = io $ do
|
|||
closeFd rd
|
||||
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]
|
||||
|
||||
myVMWorkspace = "VM"
|
||||
|
|
@ -129,7 +107,7 @@ myLayouts = onWorkspace myVMWorkspace (noBorders Full)
|
|||
-- $ onWorkspace myGimpWorkspace gimpLayout
|
||||
$ tall ||| single ||| full
|
||||
where
|
||||
addTopBar = noFrillsDeco shrinkText myTopBarTheme
|
||||
addTopBar = noFrillsDeco shrinkText tabbedTheme
|
||||
tall = named "Tall"
|
||||
$ avoidStruts
|
||||
$ addTopBar
|
||||
|
|
@ -139,7 +117,7 @@ myLayouts = onWorkspace myVMWorkspace (noBorders Full)
|
|||
-- $ addTopBar
|
||||
$ avoidStruts
|
||||
$ noBorders
|
||||
$ tabbedAlways shrinkText myTabbedTheme
|
||||
$ tabbedAlways shrinkText tabbedTheme
|
||||
full = named "Full"
|
||||
$ noBorders Full
|
||||
-- gimpLayout = named "Gimp Layout"
|
||||
|
|
@ -230,7 +208,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
|||
let acpiTag = readMaybe tag :: Maybe ACPIEvent
|
||||
forM_ acpiTag $ \case
|
||||
Power -> myPowerPrompt
|
||||
Sleep -> confirmPrompt myPromptTheme "suspend?" runSuspend
|
||||
Sleep -> confirmPrompt promptTheme "suspend?" runSuspend
|
||||
LidClose -> do
|
||||
status <- io isDischarging
|
||||
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
||||
|
|
@ -248,57 +226,6 @@ removeEmptyWorkspaceByTag' tag = do
|
|||
-- this will be enough to make it disappear.
|
||||
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?
|
||||
data PowerPrompt = PowerPrompt
|
||||
|
||||
|
|
@ -326,7 +253,7 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps
|
|||
. (`lookup` commands)
|
||||
where
|
||||
comps = mkComplFunFromList' (map fst commands)
|
||||
conf = myPromptTheme
|
||||
conf = promptTheme
|
||||
commands =
|
||||
[ ("poweroff", runPowerOff)
|
||||
, ("suspend", runScreenLock >> runSuspend)
|
||||
|
|
@ -335,7 +262,7 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps
|
|||
]
|
||||
|
||||
myQuitPrompt :: X ()
|
||||
myQuitPrompt = confirmPrompt myPromptTheme "quit?" $ io exitSuccess
|
||||
myQuitPrompt = confirmPrompt promptTheme "quit?" $ io exitSuccess
|
||||
|
||||
-- shell commands
|
||||
|
||||
|
|
@ -508,9 +435,11 @@ runVolumeUp = void (raiseVolume 2)
|
|||
runVolumeMute :: X ()
|
||||
runVolumeMute = void toggleMute
|
||||
|
||||
-- TODO write this in haskell
|
||||
runToggleBluetooth :: X ()
|
||||
runToggleBluetooth = spawn "togglebt"
|
||||
|
||||
-- TODO write these in haskell
|
||||
runIncBacklight :: X ()
|
||||
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
|
||||
exposed-modules: SendXMsg
|
||||
, ACPI
|
||||
, Theme
|
||||
, Xmobar.Screensaver
|
||||
build-depends: base
|
||||
, X11 >= 1.9.1
|
||||
, colour >= 2.3.5
|
||||
, xmonad-contrib >= 0.13
|
||||
, xmobar
|
||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in New Issue