From 1af9aa0016ec0f233cfeaae1869def4d4c513194 Mon Sep 17 00:00:00 2001
From: Jose A Ortega Ruiz <jao@gnu.org>
Date: Thu, 24 Jun 2010 19:47:23 +0200
Subject: Configurable borders

Ignore-this: 6e1e943633b2fdf0859a082fafdd2e44

darcs-hash:20100624174723-748be-024ca29986170fb46fa9d921d7ea274797dcb523.gz
---
 Config.hs  |  8 +++++++-
 Parsers.hs |  6 +++++-
 Xmobar.hs  | 19 +++++++++++++++----
 3 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/Config.hs b/Config.hs
index 3807711..621d590 100644
--- a/Config.hs
+++ b/Config.hs
@@ -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]
diff --git a/Parsers.hs b/Parsers.hs
index 88b25f1..462c35d 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -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"
diff --git a/Xmobar.hs b/Xmobar.hs
index 7dd51c0..167198b 100644
--- a/Xmobar.hs
+++ b/Xmobar.hs
@@ -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 ()
-- 
cgit v1.2.3