cairo: outer border

4 files changed, 86 insertions, 49 deletions

diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs
index 7c5e64c..8da7204 100644
--- a/src/Xmobar/Run/Parsers.hs
+++ b/src/Xmobar/Run/Parsers.hs
@@ -38,8 +38,10 @@ import Xmobar.Run.Actions
 data Widget = Icon String | Text String | Hspace Int32 deriving Show
 
 data BoxOffset = BoxOffset Align Int32 deriving (Eq, Show)
+
 -- margins: Top, Right, Bottom, Left
 data BoxMargins = BoxMargins Int32 Int32 Int32 Int32 deriving (Eq, Show)
+
 data BoxBorder = BBTop
                | BBBottom
                | BBVBoth
@@ -48,13 +50,16 @@ data BoxBorder = BBTop
                | BBHBoth
                | BBFull
                  deriving ( Read, Eq, Show )
+
 data Box = Box BoxBorder BoxOffset CInt String BoxMargins deriving (Eq, Show)
+
 data TextRenderInfo =
     TextRenderInfo { tColorsString   :: String
                    , tBgTopOffset    :: Int32
                    , tBgBottomOffset :: Int32
                    , tBoxes          :: [Box]
                    } deriving Show
+
 type FontIndex   = Int
 
 type Segment = (Widget, TextRenderInfo, FontIndex, Maybe [Action])
diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs
index 8adedda..464dfa3 100644
--- a/src/Xmobar/X11/CairoDraw.hs
+++ b/src/Xmobar/X11/CairoDraw.hs
@@ -37,6 +37,7 @@ import Xmobar.X11.CairoSurface
 
 type ActionPos = ([Action], Position, Position)
 type Actions = [ActionPos]
+type LayoutInfo = (Segment, P.PangoLayout, Double, Double)
 
 drawInPixmap :: Pixmap -> Dimension -> Dimension -> [[Segment]] -> X Actions
 drawInPixmap p w h s = do
@@ -56,8 +57,6 @@ segmentMarkup conf (Text txt, info, idx, _actions) =
   in P.markSpan attrs $ P.escapeMarkup txt
 segmentMarkup _ _ = ""
 
-type LayoutInfo = (Segment, P.PangoLayout, Double, Double)
-
 withLayoutInfo :: P.PangoContext -> Double -> Config -> Segment -> IO LayoutInfo
 withLayoutInfo ctx maxh conf seg@(Text _, inf, idx, a) = do
   lyt <- P.layoutEmpty ctx
@@ -74,9 +73,9 @@ withLayoutInfo ctx _ _ seg = do
 
 renderLayout :: Surface -> Double -> (Double, Actions)
              -> LayoutInfo -> IO (Double, Actions)
-renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) = do
+renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) =
   if off + lwidth > maxoff
-  then return (off, actions)
+  then pure (off, actions)
   else do
     C.renderWith surface $ C.moveTo off voff >> P.showLayout lyt
     let end = round $ off + lwidth
@@ -84,18 +83,52 @@ renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) = do
         actions' = case a of Just as -> (as, round off, end):actions; _ -> actions
     return (off + lwidth, actions')
 
+setSourceColor :: RGBS.Colour Double -> C.Render ()
+setSourceColor = RGBS.uncurryRGB C.setSourceRGB . SRGB.toSRGB
+
 background :: Config -> SRGB.Colour Double -> C.Render ()
 background conf colour = do
-  RGBS.uncurryRGB C.setSourceRGB (SRGB.toSRGB colour)
+  setSourceColor colour
   C.paintWithAlpha $ (fromIntegral (alpha conf)) / 255.0
 
+readColourName :: String -> IO (RGBS.Colour Double)
+readColourName str = do
+  case CNames.readColourName str of
+    Just c -> return c
+    Nothing -> return $ SRGB.sRGB24read str
+
 renderBackground :: Config -> Surface -> IO ()
 renderBackground conf surface = do
-  col <- case CNames.readColourName (bgColor conf) of
-           Just c -> return c
-           Nothing -> return $ SRGB.sRGB24read (bgColor conf)
+  col <- readColourName (bgColor conf)
   C.renderWith surface (background conf col)
 
+drawRect :: String -> Double -> (Double, Double, Double, Double) -> C.Render()
+drawRect name wd (x0, y0, x1, y1) = do
+  col <- liftIO $ readColourName name
+  setSourceColor col
+  C.setLineWidth wd
+  C.rectangle x0 y0 x1 y1
+  C.strokePreserve
+
+outerBorder :: Config -> Double -> Double -> C.Render ()
+outerBorder conf w h =  do
+  let r = case border conf of
+            TopB -> (0, 0, w - 1, 0)
+            BottomB -> (0, h - 1, w - 1, h - 1)
+            FullB -> (0, 0, w - 1, h - 1)
+            TopBM m -> (0, fi m, w - 1, fi m)
+            BottomBM m -> (0, h - fi m, w - 1, h - fi m)
+            FullBM m -> (fi m, fi m, w - fi m - 1, h - fi m - 1)
+            NoBorder -> (-1, -1, -1, -1)
+  drawRect (borderColor conf) (fi (borderWidth conf)) r
+  where fi = fromIntegral
+
+renderBorder :: Config -> Double -> Double -> Surface -> IO ()
+renderBorder conf w h surf =
+  case border conf of
+    NoBorder -> return ()
+    _ -> C.renderWith surf (outerBorder conf w h)
+
 layoutsWidth :: [(Segment, P.PangoLayout, Double, Double)] -> Double
 layoutsWidth = foldl (\a (_,_,w,_) -> a + w) 0
 
@@ -117,4 +150,6 @@ renderSegments conf w h segments surface = do
       cw = layoutsWidth clyts
       cstart = lend + 1 + max 0 (dw - rw - lend - cw) / 2.0
   (_, as') <- foldM (renderLayout surface cmax) (cstart, as) clyts
-  snd `fmap` foldM (renderLayout surface dw) (rstart, as') rlyts
+  (_, as'') <- foldM (renderLayout surface dw) (rstart, as') rlyts
+  when (borderWidth conf > 0) (renderBorder conf dw dh surface)
+  return as''
diff --git a/src/Xmobar/X11/Window.hs b/src/Xmobar/X11/Window.hs
index 3612a19..d42d74a 100644
--- a/src/Xmobar/X11/Window.hs
+++ b/src/Xmobar/X11/Window.hs
@@ -183,26 +183,6 @@ getStaticStrutValues (Static cx cy cw ch) rwh
           xe = xs + cw - 1
 getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
 
-drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
-              -> Dimension -> Dimension -> IO ()
-drawBorder b lw d p gc c wi ht =  case b of
-  NoBorder -> return ()
-  TopB       -> drawBorder (TopBM 0) lw d p gc c wi ht
-  BottomB    -> drawBorder (BottomBM 0) lw d p gc c wi ht
-  FullB      -> drawBorder (FullBM 0) lw d p gc c wi ht
-  TopBM m    -> sf >> sla >>
-                 drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)
-  BottomBM m -> let rw = fi ht - fi m + boff in
-                 sf >> sla >> drawLine d p gc 0 rw (fi wi) rw
-  FullBM m   -> let mp = fi m
-                    pad = 2 * fi mp +  fi lw
-                in sf >> sla >>
-                     drawRectangle d p gc mp mp (wi - pad) (ht - pad)
-  where sf    = setForeground d gc c
-        sla   = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter
-        boff  = borderOffset b lw
---        boff' = calcBorderOffset lw :: Int
-
 hideWindow :: Display -> Window -> IO ()
 hideWindow d w = do
     setStruts' d w (replicate 12 0)
@@ -217,17 +197,3 @@ showWindow r c d w = do
 isMapped :: Display -> Window -> IO Bool
 isMapped d w = ism <$> getWindowAttributes d w
     where ism WindowAttributes { wa_map_state = wms } = wms /= waIsUnmapped
-
-borderOffset :: (Integral a) => Border -> Int -> a
-borderOffset b lw =
-  case b of
-    BottomB    -> negate boffs
-    BottomBM _ -> negate boffs
-    TopB       -> boffs
-    TopBM _    -> boffs
-    _          -> 0
-  where boffs = calcBorderOffset lw
-
-calcBorderOffset :: (Integral a) => Int -> a
-calcBorderOffset = ceiling . (/2) . toDouble
-  where toDouble = fi :: (Integral a) => a -> Double
diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs
index c0bdb36..5525b70 100644
--- a/src/Xmobar/X11/XlibDraw.hs
+++ b/src/Xmobar/X11/XlibDraw.hs
@@ -38,7 +38,6 @@ import qualified Xmobar.X11.Bitmap as B
 import Xmobar.X11.Types
 import Xmobar.X11.Text
 import Xmobar.X11.ColorCache
-import Xmobar.X11.Window (drawBorder)
 import Xmobar.System.Utils (safeIndex)
 
 #ifdef XFT
@@ -62,6 +61,7 @@ drawInPixmap gc p wid ht ~[left,center,right] = do
         textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw)
       getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s)
       getWidth (Hspace s,cl,i,_) = return (Hspace s,cl,i,fi s)
+      fillBackground clr = setForeground d gc clr >> fillRectangle d p gc 0 0 wid ht
 
 #if XFT
   when (alpha c /= 255)
@@ -70,12 +70,9 @@ drawInPixmap gc p wid ht ~[left,center,right] = do
 
   withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do
 #if XFT
-    when (alpha c == 255) $ do
-      liftIO $ setForeground d gc bgcolor
-      liftIO $ fillRectangle d p gc 0 0 wid ht
+    when (alpha c == 255) $ liftIO (fillBackground bgcolor)
 #else
-    liftIO $ setForeground d gc bgcolor
-    liftIO $ fillRectangle d p gc 0 0 wid ht
+    liftIO $ fillBackground bgcolor
 #endif
     -- write to the pixmap the new string
     printStrings p gc fs vs 1 L [] =<< strLn left
@@ -209,6 +206,40 @@ drawBoxes d dr gc ht (b:bs) = do
       _ -> drawBoxBorder d dr gc bb    offset ht xx lw mgs
   drawBoxes d dr gc ht bs
 
+drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
+              -> Dimension -> Dimension -> IO ()
+drawBorder b lw d p gc c wi ht =  case b of
+  NoBorder -> return ()
+  TopB       -> drawBorder (TopBM 0) lw d p gc c wi ht
+  BottomB    -> drawBorder (BottomBM 0) lw d p gc c wi ht
+  FullB      -> drawBorder (FullBM 0) lw d p gc c wi ht
+  TopBM m    -> sf >> sla >>
+                 drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)
+  BottomBM m -> let rw = fi ht - fi m + boff in
+                 sf >> sla >> drawLine d p gc 0 rw (fi wi) rw
+  FullBM m   -> let mp = fi m
+                    pad = 2 * fi mp +  fi lw
+                in sf >> sla >>
+                     drawRectangle d p gc mp mp (wi - pad) (ht - pad)
+  where sf    = setForeground d gc c
+        sla   = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter
+        boff  = borderOffset b lw
+
+borderOffset :: (Integral a) => Border -> Int -> a
+borderOffset b lw =
+  case b of
+    BottomB    -> negate boffs
+    BottomBM _ -> negate boffs
+    TopB       -> boffs
+    TopBM _    -> boffs
+    _          -> 0
+  where boffs = calcBorderOffset lw
+
+calcBorderOffset :: (Integral a) => Int -> a
+calcBorderOffset = ceiling . (/2) . toDouble
+  where toDouble = fi :: (Integral a) => a -> Double
+
+
 drawBoxBorder :: Display
               -> Drawable
               -> GC