diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index f5b9ac8..6c0aa3b 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -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 = "" ++ s ++ ""
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", "\xf028"
, "-o", "\xf026 "
- , "-c", fgColor0
- , "-C", fgColor0
+ , "-c", T.fgColor
+ , "-C", T.fgColor
]
, Run $ Battery [ "--template", ""
, "--Low", "10"
, "--High", "80"
, "--low", "red"
- , "--normal", fgColor0
- , "--high", fgColor0
+ , "--normal", T.fgColor
+ , "--high", T.fgColor
, "--"
, "-P"
, "-o" , "\xf0e7"
@@ -103,9 +111,9 @@ config confDir = defaultConfig {
, Run $ Locks
[ "-N", "\x1f13d"
- , "-n", wrapColor fgColor1 "\x1f13d"
+ , "-n", wrapColor T.backdropFgColor "\x1f13d"
, "-C", "\x1f132"
- , "-c", wrapColor fgColor1 "\x1f132"
+ , "-c", wrapColor T.backdropFgColor "\x1f132"
, "-s", ""
, "-S", ""
, "-d", " "
@@ -113,7 +121,7 @@ config confDir = defaultConfig {
, Run $ Date "%Y-%m-%d %H:%M" "date" 10
- , Run $ Screensaver ("\xf254", fgColor0, fgColor1) 10
+ , Run $ Screensaver ("\xf254", T.fgColor, T.fgColor) 10
, Run UnsafeStdinReader
]
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 1730c40..b63170b 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -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"]
diff --git a/lib/Theme.hs b/lib/Theme.hs
new file mode 100644
index 0000000..7169f64
--- /dev/null
+++ b/lib/Theme.hs
@@ -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
+ }
diff --git a/my-xmonad.cabal b/my-xmonad.cabal
index d43b705..2f4f11b 100644
--- a/my-xmonad.cabal
+++ b/my-xmonad.cabal
@@ -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