diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar/X11/CairoDraw.hs | 76 |
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 |