summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/X11
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/X11')
-rw-r--r--src/Xmobar/X11/CairoDraw.hs69
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''