diff options
| -rw-r--r-- | doc/quick-start.org | 9 | ||||
| -rw-r--r-- | etc/xmobar.config | 2 | ||||
| -rw-r--r-- | src/Xmobar/Run/Parsers.hs | 24 | ||||
| -rw-r--r-- | src/Xmobar/X11/CairoDraw.hs | 123 |
4 files changed, 109 insertions, 49 deletions
diff --git a/doc/quick-start.org b/doc/quick-start.org index 55d3331..d711138 100644 --- a/doc/quick-start.org +++ b/doc/quick-start.org @@ -238,7 +238,8 @@ configuration language, see [[../etc/xmobar.config][etc/xmobar.config]], and you (red). =<fc=#FF0000,#000000>string</fc>= will print =string= in red with a black background (=#000000=). Background absolute offsets can be specified for fonts. =<fc=#FF0000,#000000:0>string</fc>= will have a background - matching the bar's height. + matching the bar's height. It is also possible to specify the colour's + opacity, with two additional hex digits (e.g. #FF00000aa). - =<fn=1>string</fn>= will print =string= with the first font from =additionalFonts=. The index =0= corresponds to the standard font. @@ -289,9 +290,9 @@ configuration language, see [[../etc/xmobar.config][etc/xmobar.config]], and you foreground color. The =box= tag accepts several optional arguments to tailor its looks: - - =type=: =Top=, =Bottom=, =VBoth= (a single line above or below - string, or both), =Left=, =Right=, =HBoth= (single vertical lines), - =Full= (a rectangle, the default). + - =type=: =Top=, =Bottom=, =VBoth= (a single line above or below string, or + both), =Left=, =Right=, =HBoth= (single vertical lines), =Full= (a rectangle, + the default). - =color=: the color of the box lines. - =width=: the width of the box lines. - =offset=: an alignment char (L, C or R) followed by the amount of diff --git a/etc/xmobar.config b/etc/xmobar.config index 5697e8c..232464f 100644 --- a/etc/xmobar.config +++ b/etc/xmobar.config @@ -34,6 +34,6 @@ Config { font = "DejaVu Sans Mono 9" ] , sepChar = "%" , alignSep = "}{" - , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }\ + , template = "%cpu% | <box>%memory% * %swap%</box> | %eth0% - %eth1% }\ \{ <fc=#ee9a00><fn=1>%date%</fn></fc>| %EGPF% | %uname%" } diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs index 982ef71..c0f3104 100644 --- a/src/Xmobar/Run/Parsers.hs +++ b/src/Xmobar/Run/Parsers.hs @@ -49,16 +49,20 @@ data BoxBorder = BBTop | BBRight | 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 + deriving (Read, Eq, Show) + +data Box = Box { bBorder :: BoxBorder + , bOffset :: BoxOffset + , bWidth :: CInt + , bColor :: String + , bMargins :: BoxMargins + } deriving (Eq, Show) + +data TextRenderInfo = TextRenderInfo { tColorsString :: String + , tBgTopOffset :: Int32 + , tBgBottomOffset :: Int32 + , tBoxes :: [Box] + } deriving Show type FontIndex = Int diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs index 04bc8ee..eb27e74 100644 --- a/src/Xmobar/X11/CairoDraw.hs +++ b/src/Xmobar/X11/CairoDraw.hs @@ -17,20 +17,27 @@ module Xmobar.X11.CairoDraw (drawInPixmap) where import Prelude hiding (lookup) + import Data.Map (lookup) +import Data.List (nub) +import qualified Data.Colour.SRGB as SRGB +import qualified Data.Colour.Names as CNames import Control.Monad.IO.Class import Control.Monad.Reader -import Graphics.X11.Xlib hiding (Segment) +import Graphics.X11.Xlib hiding (Segment, drawSegments) import Graphics.Rendering.Cairo.Types import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Pango as P -import qualified Data.Colour.SRGB as SRGB -import qualified Data.Colour.Names as CNames - -import Xmobar.Run.Parsers ( Segment, Widget(..), TextRenderInfo (..) +import Xmobar.Run.Parsers (Segment + , Widget(..) + , Box (..) + , BoxMargins (..) + , BoxBorder (..) + , BoxOffset (..) + , TextRenderInfo (..) , colorComponents) import Xmobar.Config.Types import Xmobar.Text.Pango (fixXft) @@ -75,9 +82,9 @@ drawInPixmap gc p s = do (Rectangle _ _ w h) = rect xconf dw = fromIntegral w dh = fromIntegral h - conf = (config xconf) + conf = config xconf dc = DC (drawXBitmap xconf gc p) (lookupXBitmap xconf) conf dw dh s - render = renderSegments dc + render = drawSegments dc liftIO $ renderBackground disp p conf w h liftIO $ withXlibSurface disp p vis (fromIntegral w) (fromIntegral h) render @@ -129,28 +136,67 @@ withRenderinfo _ dctx seg@(Icon p, _, _, _) = do draw _ off mx = when (off + wd <= mx) $ dcBitmapDrawer dctx off vpos p return (seg, draw, wd) -renderSegmentBackground :: +renderRects :: String -> Double -> [(Double, Double, Double, Double)] -> C.Render () +renderRects color wd rects = do + setSourceColor (readColourName color) + C.setLineWidth wd + mapM_ (\(x0, y0, w, h) -> C.rectangle x0 y0 w h >> C.stroke) rects + +boxRects :: Box -> Double -> Double -> Double -> [(Double, Double, Double, Double)] +boxRects (Box bd offset lw _ margins) ht x0 x1 = + case bd of + BBTop -> [rtop] + BBBottom -> [rbot] + BBVBoth -> [rtop, rbot] + BBLeft -> [rleft] + BBRight -> [rright] + BBHBoth -> [rleft, rright] + BBFull -> [rtop, rbot, rleft, rright] + where (BoxMargins top right bot left) = margins + (BoxOffset align m) = offset + ma = fromIntegral m + (p0, p1) = case align of + L -> (0, -ma) + C -> (ma, -ma) + R -> (ma, 0) + lc = fromIntegral (lw `div` 2) + [mt, mr, mb, ml] = map fromIntegral [top, right, bot, left] + rtop = (x0 + p0, mt + lc, x1 + p1 - x0 - p0, 0) + rbot = (x0 + p0, ht - mb - max lc 1, x1 + p1 - x0 - p0, 0) + rleft = (x0 - 1 + ml, p0, 0, ht + p1 - p0) + rright = (x1 + lc - 1 - mr, p0, 0, ht + p1 - p0) + +drawBox :: DrawContext -> Surface -> Double -> Double -> Box -> IO () +drawBox dctx surf x0 x1 box@(Box _ _ w color _) = + C.renderWith surf $ + renderRects color (fromIntegral w) (boxRects box (dcHeight dctx) x0 x1) + +drawSegmentBackground :: DrawContext -> Surface -> TextRenderInfo -> Double -> Double -> IO () -renderSegmentBackground dctx surf info xbeg xend = +drawSegmentBackground dctx surf info x0 x1 = when (bg /= bgColor conf && (top >= 0 || bot >= 0)) $ C.renderWith surf $ do setSourceColor (readColourName bg) - C.rectangle xbeg top (xend - xbeg) (dcHeight dctx - bot - top) + C.rectangle x0 top (x1 - x0) (dcHeight dctx - bot - top) C.fillPreserve where conf = dcConfig dctx (_, bg) = colorComponents conf (tColorsString info) top = fromIntegral $ tBgTopOffset info bot = fromIntegral $ tBgBottomOffset info -renderSegment :: DrawContext -> Surface -> Double - -> (Double, Actions) -> Renderinfo -> IO (Double, Actions) -renderSegment dctx surface maxoff (off, acts) (segment, render, lwidth) = do +type Boxes = [(Double, Double, [Box])] +type SegAcc = (Double, Actions, Boxes) + +drawSegment :: DrawContext -> Surface -> Double -> SegAcc -> Renderinfo -> IO SegAcc +drawSegment dctx surface maxoff (off, acts, boxs) (segment, render, lwidth) = do let end = min maxoff (off + lwidth) (_, info, _, a) = segment acts' = case a of Just as -> (as, round off, round end):acts; _ -> acts - renderSegmentBackground dctx surface info off end + bs = tBoxes info + boxs' = if null bs then boxs else (off, end, bs):boxs + drawSegmentBackground dctx surface info off end render surface off maxoff - return (off + lwidth, acts') + return (off + lwidth, acts', boxs') setSourceColor :: (SRGB.Colour Double, Double) -> C.Render () setSourceColor (colour, alph) = @@ -160,15 +206,8 @@ setSourceColor (colour, alph) = g = SRGB.channelGreen rgb b = SRGB.channelBlue rgb -drawRect :: String -> Double -> (Double, Double, Double, Double) -> C.Render() -drawRect name wd (x0, y0, x1, y1) = do - setSourceColor (readColourName name) - C.setLineWidth wd - C.rectangle x0 y0 x1 y1 - C.strokePreserve - -outerBorder :: Config -> Double -> Double -> C.Render () -outerBorder conf w h = do +renderOuterBorder :: Config -> Double -> Double -> C.Render () +renderOuterBorder conf w h = do let r = case border conf of TopB -> (0, 0, w - 1, 0) BottomB -> (0, h - 1, w - 1, h - 1) @@ -177,20 +216,34 @@ outerBorder conf w h = do 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 + renderRects (borderColor conf) (fi (borderWidth conf)) [r] where fi = fromIntegral -renderBorder :: Config -> Double -> Double -> Surface -> IO () -renderBorder conf w h surf = +drawBorder :: Config -> Double -> Double -> Surface -> IO () +drawBorder conf w h surf = case border conf of NoBorder -> return () - _ -> C.renderWith surf (outerBorder conf w h) + _ -> C.renderWith surf (renderOuterBorder conf w h) layoutsWidth :: [Renderinfo] -> Double layoutsWidth = foldl (\a (_,_,w) -> a + w) 0 -renderSegments :: DrawContext -> Surface -> IO Actions -renderSegments dctx surface = do +drawBoxes' :: DrawContext -> Surface -> (Double, Double, [Box]) -> IO () +drawBoxes' dctx surf (from, to, bs) = mapM_ (drawBox dctx surf from to) bs + +drawBoxes :: DrawContext -> Surface -> Boxes -> IO () +drawBoxes dctx surf ((from, to, b):(from', to', b'):bxs) = do + if to < from' + then do drawBoxes' dctx surf (from, to, b) + drawBoxes dctx surf $ (from', to', b'):bxs + else drawBoxes dctx surf $ (from, to', nub (b ++ b')):bxs + +drawBoxes dctx surf [bi] = drawBoxes' dctx surf bi + +drawBoxes _ _ [] = return () + +drawSegments :: DrawContext -> Surface -> IO Actions +drawSegments dctx surf = do let [left, center, right] = take 3 $ dcSegments dctx dh = dcHeight dctx dw = dcWidth dctx @@ -199,13 +252,15 @@ renderSegments dctx surface = do llyts <- mapM (withRenderinfo ctx dctx) left rlyts <- mapM (withRenderinfo ctx dctx) right clyts <- mapM (withRenderinfo ctx dctx) center - (lend, as) <- foldM (renderSegment dctx surface dw) (0, []) llyts + (lend, as, bx) <- foldM (drawSegment dctx surf dw) (0, [], []) llyts let rw = layoutsWidth rlyts rstart = max (lend + 1) (dw - rw - 1) cmax = rstart - 1 cw = layoutsWidth clyts cstart = lend + 1 + max 0 (dw - rw - lend - cw) / 2.0 - (_, as') <- foldM (renderSegment dctx surface cmax) (cstart, as) clyts - (_, as'') <- foldM (renderSegment dctx surface dw) (rstart, as') rlyts - when (borderWidth conf > 0) (renderBorder conf dw dh surface) + (_, as', bx') <- foldM (drawSegment dctx surf cmax) (cstart, as, bx) clyts + (_, as'', bx'') <- foldM (drawSegment dctx surf dw) (rstart, as', bx') rlyts + -- putStrLn $ show (reverse bx'') + drawBoxes dctx surf (reverse bx'') + when (borderWidth conf > 0) (drawBorder conf dw dh surf) return as'' |