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