diff options
| -rw-r--r-- | Config.hs | 8 | ||||
| -rw-r--r-- | Parsers.hs | 6 | ||||
| -rw-r--r-- | Xmobar.hs | 19 |
3 files changed, 27 insertions, 6 deletions
@@ -18,7 +18,7 @@ module Config ( -- * Configuration -- $config Config (..) - , XPosition (..), Align (..) + , XPosition (..), Align (..), Border(..) , defaultConfig , runnableTypes ) where @@ -47,6 +47,8 @@ data Config = , bgColor :: String -- ^ Backgroud color , fgColor :: String -- ^ Default font color , position :: XPosition -- ^ Top Bottom or Static + , border :: Border -- ^ NoBorder TopB BottomB or FullB + , borderColor :: String -- ^ Border color , lowerOnStart :: Bool -- ^ Lower to the bottom of the -- window stack on initialization , commands :: [Runnable] -- ^ For setting the command, the command arguments @@ -69,6 +71,8 @@ data XPosition = Top data Align = L | R | C deriving ( Read, Eq ) +data Border = NoBorder | TopB | BottomB | FullB deriving ( Read, Eq ) + -- | The default configuration values defaultConfig :: Config defaultConfig = @@ -76,6 +80,8 @@ defaultConfig = , bgColor = "#000000" , fgColor = "#BFBFBF" , position = Top + , border = NoBorder + , borderColor = "#BFBFBF" , lowerOnStart = True , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10 , Run StdinReader] @@ -130,21 +130,25 @@ parseConfig = runParser parseConf fields "Config" . stripComments perms = permute $ Config <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition + <|?> pBorder <|?> pBdColor <|?> pLowerOnStart <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" - , "template", "position", "lowerOnStart", "commands"] + , "border", "borderColor" ,"template", "position" + , "lowerOnStart", "commands"] pFont = strField font "font" pBgColor = strField bgColor "bgColor" pFgColor = strField fgColor "fgColor" + pBdColor = strField borderColor "borderColor" pSepChar = strField sepChar "sepChar" pAlignSep = strField alignSep "alignSep" pTemplate = strField template "template" pPosition = field position "position" $ tillFieldEnd >>= read' "position" pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart" + pBorder = field border "border" $ tillFieldEnd >>= read' "border" pCommands = field commands "commands" $ readCommands staticPos = do string "Static" @@ -204,19 +204,19 @@ getStrutValues r@(Rectangle x y w h) p rwh = nx = fi x nw = fi (x + fi w - 1) --- get some reaonable strut values for static placement. +-- get some reaonable strut values for static placement. getStaticStrutValues :: XPosition -> Int -> [Int] getStaticStrutValues (Static cx cy cw ch) rwh -- if the yPos is in the top half of the screen, then assume a Top -- placement, otherwise, it's a Bottom placement | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0] | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe] - where st = cy + ch + where st = cy + ch sb = rwh - cy xs = cx -- a simple calculation for horizontal (x) placement xe = xs + cw getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] - + updateWin :: TVar String -> X () updateWin v = do xc <- ask @@ -243,7 +243,7 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do let (c,d ) = (config &&& display) r (w,fs) = (window &&& fontS ) r strLn = io . mapM (\(s,cl) -> textWidth d fs s >>= \tw -> return (s,cl,fi tw)) - withColors d [bgColor c] $ \[bgcolor] -> do + withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do gc <- io $ createGC d w -- create a pixmap to write to and fill it with a rectangle p <- io $ createPixmap d w wid ht @@ -251,6 +251,8 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do -- the fgcolor of the rectangle will be the bgcolor of the window io $ setForeground d gc bgcolor io $ fillRectangle d p gc 0 0 wid ht + -- draw 1 pixel border if requested + io $ drawBorder (border c) d p gc bdcolor (wid - 1) (ht - 1) -- write to the pixmap the new string printStrings p gc fs 1 L =<< strLn left printStrings p gc fs 1 R =<< strLn right @@ -263,6 +265,15 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do -- resync io $ sync d True +drawBorder :: Border -> Display -> Drawable -> GC -> Pixel -> Dimension + -> Dimension -> IO () +drawBorder b d p gc c w h = case b of + NoBorder -> return () + TopB -> sf >> drawLine d p gc 0 0 (fi w) 0 + BottomB -> sf >> drawLine d p gc 0 (fi h) (fi w) (fi h) + FullB -> sf >> drawRectangle d p gc 0 0 w h + where sf = setForeground d gc c + -- | An easy way to print the stuff we need to print printStrings :: Drawable -> GC -> XFont -> Position -> Align -> [(String, String, Position)] -> X () |