diff options
Diffstat (limited to 'src/Xmobar/X11')
| -rw-r--r-- | src/Xmobar/X11/CairoDraw.hs | 69 |
1 files changed, 44 insertions, 25 deletions
diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs index 25c4da3..5260c68 100644 --- a/src/Xmobar/X11/CairoDraw.hs +++ b/src/Xmobar/X11/CairoDraw.hs @@ -29,9 +29,9 @@ import qualified Graphics.Rendering.Pango as P import qualified Data.Colour.SRGB as SRGB import qualified Data.Colour.Names as CNames -import qualified Data.Colour.RGBSpace as RGBS -import Xmobar.Run.Parsers (Segment, Widget(..), colorComponents, tColorsString) +import Xmobar.Run.Parsers ( Segment, Widget(..), TextRenderInfo (..) + , colorComponents) import Xmobar.Config.Types import Xmobar.Text.Pango (fixXft) import Xmobar.X11.Types @@ -50,6 +50,8 @@ data DrawContext = DC { dcBitmapDrawer :: BitmapDrawer , dcSegments :: [[Segment]] } + + drawInPixmap :: GC -> Pixmap -> [[Segment]] -> X Actions drawInPixmap gc p s = do xconf <- ask @@ -110,38 +112,55 @@ withRenderinfo _ dctx seg@(Icon p, _, _, _) = do draw _ off mx = when (off + wd <= mx) $ dcBitmapDrawer dctx off vpos p return (seg, draw, wd) -renderSegment :: - Surface -> Double -> (Double, Actions) -> Renderinfo -> IO (Double, Actions) -renderSegment surface maxoff (off, acts) (segment, render, lwidth) = do +renderSegmentBackground :: + DrawContext -> Surface -> TextRenderInfo -> Double -> Double -> IO () +renderSegmentBackground dctx surf info xbeg xend = + 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.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 + 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 render surface off maxoff - let end = round $ off + lwidth - (_, _, _, a) = segment - acts' = case a of Just as -> (as, round off, end):acts; _ -> acts return (off + lwidth, acts') -setSourceColor :: RGBS.Colour Double -> C.Render () -setSourceColor = RGBS.uncurryRGB C.setSourceRGB . SRGB.toSRGB +setSourceColor :: (SRGB.Colour Double, Double) -> C.Render () +setSourceColor (colour, alph) = + C.setSourceRGBA r g b alph + where rgb = SRGB.toSRGB colour + r = SRGB.channelRed rgb + g = SRGB.channelGreen rgb + b = SRGB.channelBlue rgb -readColourName :: String -> IO (RGBS.Colour Double) +readColourName :: String -> (SRGB.Colour Double, Double) readColourName str = case CNames.readColourName str of - Just c -> return c - Nothing -> return $ SRGB.sRGB24read str - -background :: Config -> SRGB.Colour Double -> C.Render () -background conf colour = do - setSourceColor colour - C.paintWithAlpha $ fromIntegral (alpha conf) / 255.0 + Just c -> (c, 1.0) + Nothing -> case SRGB.sRGB24reads str of + [(c, "")] -> (c, 1.0) + [(c,d)] -> (c, read ("0x" ++ d)) + _ -> (CNames.white, 1.0) renderBackground :: Config -> Surface -> IO () renderBackground conf surface = - when (alpha conf >= 255) - (readColourName (bgColor conf) >>= C.renderWith surface . background conf) + let (c, a) = readColourName (bgColor conf) + a' = min a $ fromIntegral (alpha conf) / 255 :: Double + in when (a' >= 1) $ C.renderWith surface $ setSourceColor (c, a') >> C.paint drawRect :: String -> Double -> (Double, Double, Double, Double) -> C.Render() drawRect name wd (x0, y0, x1, y1) = do - col <- liftIO $ readColourName name - setSourceColor col + setSourceColor (readColourName name) C.setLineWidth wd C.rectangle x0 y0 x1 y1 C.strokePreserve @@ -179,13 +198,13 @@ renderSegments dctx surface = do rlyts <- mapM (withRenderinfo ctx dctx) right clyts <- mapM (withRenderinfo ctx dctx) center renderBackground conf surface - (lend, as) <- foldM (renderSegment surface dw) (0, []) llyts + (lend, as) <- foldM (renderSegment dctx 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 (renderSegment surface cmax) (cstart, as) clyts - (_, as'') <- foldM (renderSegment surface dw) (rstart, as') rlyts + (_, 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) return as'' |