summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/X11
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/X11')
-rw-r--r--src/Xmobar/X11/CairoDraw.hs76
1 files changed, 50 insertions, 26 deletions
diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs
index 9784774..8adedda 100644
--- a/src/Xmobar/X11/CairoDraw.hs
+++ b/src/Xmobar/X11/CairoDraw.hs
@@ -48,49 +48,73 @@ drawInPixmap p w h s = do
render = (renderSegments c w h s)
liftIO $ withXlibSurface disp p vis (fi w) (fi h) render
-withMarkup :: Config -> Segment -> String
-withMarkup conf (Text txt, info, idx, _actions) =
+segmentMarkup :: Config -> Segment -> String
+segmentMarkup conf (Text txt, info, idx, _actions) =
let fnt = fixXft $ indexedFont conf idx
(fg, bg) = colorComponents conf (tColorsString info)
attrs = [P.FontDescr fnt, P.FontForeground fg, P.FontBackground bg]
in P.markSpan attrs $ P.escapeMarkup txt
-withMarkup _ _ = ""
+segmentMarkup _ _ = ""
-type FPair = (Position, Actions)
+type LayoutInfo = (Segment, P.PangoLayout, Double, Double)
-renderSegment ::
- Double -> Config -> Surface -> P.PangoLayout -> FPair -> Segment -> IO FPair
-renderSegment mh conf surface lyt (offset,actions) seg@(Text _, _, idx, a) = do
- _ <- (P.layoutSetMarkup lyt (withMarkup conf seg)) :: IO String
+withLayoutInfo :: P.PangoContext -> Double -> Config -> Segment -> IO LayoutInfo
+withLayoutInfo ctx maxh conf seg@(Text _, inf, idx, a) = do
+ lyt <- P.layoutEmpty ctx
+ mk <- (P.layoutSetMarkup lyt (segmentMarkup conf seg)) :: IO String
(_, P.PangoRectangle o u w h) <- P.layoutGetExtents lyt
let voff' = fromIntegral $ indexedOffset conf idx
- voff = voff' + (mh - h + u) / 2.0
- hoff = fromIntegral offset
- C.renderWith surface $ C.moveTo hoff voff >> P.showLayout lyt
- let end = round $ hoff + o + w
- actions' = case a of Just as -> (as, offset, end):actions; _ -> actions
- return (end, actions')
+ voff = voff' + (maxh - h + u) / 2.0
+ return ((Text mk, inf, idx, a), lyt, w - o, voff)
-renderSegment _ _ _ _ (offset,actions) (Hspace n, _, _, a) = do
- let end = offset + n
- actions' = case a of Just as -> (as, offset, end):actions; _ -> actions
- return (end, actions')
+withLayoutInfo ctx _ _ seg = do
+ lyt <- P.layoutEmpty ctx
+ let n = case seg of (Hspace w, _, _, _) -> w; _ -> 0
+ return (seg, lyt, fromIntegral n, 0)
-renderSegment _h _c _surface _lyt acc _segment = pure acc
+renderLayout :: Surface -> Double -> (Double, Actions)
+ -> LayoutInfo -> IO (Double, Actions)
+renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) = do
+ if off + lwidth > maxoff
+ then return (off, actions)
+ else do
+ C.renderWith surface $ C.moveTo off voff >> P.showLayout lyt
+ let end = round $ off + lwidth
+ (_, _, _, a) = segment
+ actions' = case a of Just as -> (as, round off, end):actions; _ -> actions
+ return (off + lwidth, actions')
background :: Config -> SRGB.Colour Double -> C.Render ()
background conf colour = do
RGBS.uncurryRGB C.setSourceRGB (SRGB.toSRGB colour)
C.paintWithAlpha $ (fromIntegral (alpha conf)) / 255.0
-renderSegments ::
- Config -> Dimension -> Dimension -> [[Segment]] -> Surface -> IO Actions
-renderSegments conf _w h segments surface = do
- ctx <- P.cairoCreateContext Nothing
- lyt <- P.layoutEmpty ctx
+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)
C.renderWith surface (background conf col)
- let dh = fromIntegral h
- snd `fmap` foldM (renderSegment dh conf surface lyt) (0, []) (concat segments)
+
+layoutsWidth :: [(Segment, P.PangoLayout, Double, Double)] -> Double
+layoutsWidth = foldl (\a (_,_,w,_) -> a + w) 0
+
+renderSegments ::
+ Config -> Dimension -> Dimension -> [[Segment]] -> Surface -> IO Actions
+renderSegments conf w h segments surface = do
+ let [left, center, right] = take 3 segments
+ dh = fromIntegral h
+ dw = fromIntegral w
+ ctx <- P.cairoCreateContext Nothing
+ llyts <- mapM (withLayoutInfo ctx dh conf) left
+ rlyts <- mapM (withLayoutInfo ctx dh conf) right
+ clyts <- mapM (withLayoutInfo ctx dh conf) center
+ renderBackground conf surface
+ (lend, as) <- foldM (renderLayout surface 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 (renderLayout surface cmax) (cstart, as) clyts
+ snd `fmap` foldM (renderLayout surface dw) (rstart, as') rlyts