From d0f547be5380ec14cc334b15a530ba869668581a Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 11 Sep 2022 02:27:56 +0100 Subject: cairo: alpha (still pseudo, via xrender) --- src/Xmobar/X11/CairoDraw.hs | 19 +++--- src/Xmobar/X11/Draw.hs | 11 ++++ src/Xmobar/X11/MinXft.hsc | 113 +----------------------------------- src/Xmobar/X11/XRender.hsc | 138 ++++++++++++++++++++++++++++++++++++++++++++ src/Xmobar/X11/XlibDraw.hs | 5 -- xmobar.cabal | 12 ++-- 6 files changed, 167 insertions(+), 131 deletions(-) create mode 100644 src/Xmobar/X11/XRender.hsc diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs index 464dfa3..32adac2 100644 --- a/src/Xmobar/X11/CairoDraw.hs +++ b/src/Xmobar/X11/CairoDraw.hs @@ -53,8 +53,9 @@ 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 + attrs = [P.FontDescr fnt, P.FontForeground fg] + attrs' = if bg == bgColor conf then attrs else P.FontBackground bg:attrs + in P.markSpan attrs' $ P.escapeMarkup txt segmentMarkup _ _ = "" withLayoutInfo :: P.PangoContext -> Double -> Config -> Segment -> IO LayoutInfo @@ -86,21 +87,21 @@ renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) = setSourceColor :: RGBS.Colour Double -> C.Render () setSourceColor = RGBS.uncurryRGB C.setSourceRGB . SRGB.toSRGB -background :: Config -> SRGB.Colour Double -> C.Render () -background conf colour = do - setSourceColor colour - C.paintWithAlpha $ (fromIntegral (alpha conf)) / 255.0 - readColourName :: String -> IO (RGBS.Colour Double) readColourName str = do 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 + renderBackground :: Config -> Surface -> IO () renderBackground conf surface = do - col <- readColourName (bgColor conf) - C.renderWith surface (background conf col) + when (alpha conf >= 255) + (readColourName (bgColor conf) >>= C.renderWith surface . background conf) drawRect :: String -> Double -> (Double, Double, Double, Double) -> C.Render() drawRect name wd (x0, y0, x1, y1) = do diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs index ea7fa95..643ec13 100644 --- a/src/Xmobar/X11/Draw.hs +++ b/src/Xmobar/X11/Draw.hs @@ -24,9 +24,11 @@ import Control.Monad.Reader import Graphics.X11.Xlib hiding (Segment) +import Xmobar.Config.Types import Xmobar.Run.Parsers (Segment) import Xmobar.Run.Actions (Action) import Xmobar.X11.Types +import Xmobar.X11.XRender (drawBackground) #ifdef CAIRO import Xmobar.X11.CairoDraw @@ -45,10 +47,19 @@ drawInWin conf bound@(Rectangle _ _ wid ht) segments = do r <- ask let d = display r w = window r + depth = defaultDepthOfScreen (defaultScreenOfDisplay d) p <- liftIO $ createPixmap d w wid ht depth gc <- liftIO $ createGC d w liftIO $ setGraphicsExposures d gc False + +#if defined(XFT) || defined(CAIRO) + let conf = config r + alph = alpha conf + when (alph < 255) + (liftIO $ drawBackground d p (bgColor conf) alph (Rectangle 0 0 wid ht)) +#endif + #ifdef CAIRO res <- drawInPixmap p wid ht segments #else diff --git a/src/Xmobar/X11/MinXft.hsc b/src/Xmobar/X11/MinXft.hsc index e593da0..e485488 100644 --- a/src/Xmobar/X11/MinXft.hsc +++ b/src/Xmobar/X11/MinXft.hsc @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: MinXft --- Copyright: (c) 2012, 2014, 2015, 2017 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2012, 2014, 2015, 2017, 2022 Jose Antonio Ortega Ruiz -- (c) Clemens Fruhwirth 2007 -- License: BSD3-style (see LICENSE) -- @@ -28,7 +28,6 @@ module Xmobar.X11.MinXft ( AXftColor , withAXftDraw , drawXftString , drawXftString' - , drawBackground , drawXftRect , openAXftFont , closeAXftFont @@ -47,7 +46,6 @@ where import Graphics.X11 import Graphics.X11.Xlib.Types import Graphics.X11.Xrender -import Graphics.X11.Xlib.Extras (xGetWindowProperty, xFree) import Foreign import Foreign.C.Types @@ -55,8 +53,6 @@ import Foreign.C.String import Codec.Binary.UTF8.String as UTF8 import Data.Char (ord) -import Control.Monad (when) - #include -- Color Handling @@ -224,110 +220,3 @@ drawXftRect :: (Integral a3, Integral a2, Integral a1, Integral a) => AXftDraw -> AXftColor -> a -> a1 -> a2 -> a3 -> IO () drawXftRect draw color x y width height = cXftDrawRect draw color (fi x) (fi y) (fi width) (fi height) - -#include - -type Picture = XID -type PictOp = CInt - -data XRenderPictFormat -data XRenderPictureAttributes = XRenderPictureAttributes - --- foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFillRectangle" - -- xRenderFillRectangle :: Display -> PictOp -> Picture -> Ptr XRenderColor -> CInt -> CInt -> CUInt -> CUInt -> IO () -foreign import ccall unsafe "X11/extensions/Xrender.h XRenderComposite" - xRenderComposite :: Display -> PictOp -> Picture -> Picture -> Picture -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CUInt -> CUInt -> IO () -foreign import ccall unsafe "X11/extensions/Xrender.h XRenderCreateSolidFill" - xRenderCreateSolidFill :: Display -> Ptr XRenderColor -> IO Picture -foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFreePicture" - xRenderFreePicture :: Display -> Picture -> IO () -foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () -foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFindStandardFormat" - xRenderFindStandardFormat :: Display -> CInt -> IO (Ptr XRenderPictFormat) -foreign import ccall unsafe "X11/extensions/Xrender.h XRenderCreatePicture" - xRenderCreatePicture :: Display -> Drawable -> Ptr XRenderPictFormat -> CULong -> Ptr XRenderPictureAttributes -> IO Picture - - --- Attributes not supported -instance Storable XRenderPictureAttributes where - sizeOf _ = #{size XRenderPictureAttributes} - alignment _ = alignment (undefined :: CInt) - peek _ = return XRenderPictureAttributes - poke p XRenderPictureAttributes = - memset p 0 #{size XRenderPictureAttributes} - --- | Convenience function, gives us an XRender handle to a traditional --- Pixmap. Don't let it escape. -withRenderPicture :: Display -> Drawable -> (Picture -> IO a) -> IO () -withRenderPicture d p f = do - format <- xRenderFindStandardFormat d 1 -- PictStandardRGB24 - alloca $ \attr -> do - pic <- xRenderCreatePicture d p format 0 attr - f pic - xRenderFreePicture d pic - --- | Convenience function, gives us an XRender picture that is a solid --- fill of color 'c'. Don't let it escape. -withRenderFill :: Display -> XRenderColor -> (Picture -> IO a) -> IO () -withRenderFill d c f = do - pic <- with c (xRenderCreateSolidFill d) - f pic - xRenderFreePicture d pic - --- | Drawing the background to a pixmap and taking into account --- transparency -drawBackground :: Display -> Drawable -> String -> Int -> Rectangle -> IO () -drawBackground d p bgc alpha (Rectangle x y wid ht) = do - let render opt bg pic m = - xRenderComposite d opt bg m pic - (fromIntegral x) (fromIntegral y) 0 0 - 0 0 (fromIntegral wid) (fromIntegral ht) - withRenderPicture d p $ \pic -> do - -- Handle background color - bgcolor <- parseRenderColor d bgc - withRenderFill d bgcolor $ \bgfill -> - withRenderFill d - (XRenderColor 0 0 0 (257 * alpha)) - (render pictOpSrc bgfill pic) - -- Handle transparency - internAtom d "_XROOTPMAP_ID" False >>= \xid -> - let xroot = defaultRootWindow d in - alloca $ \x1 -> - alloca $ \x2 -> - alloca $ \x3 -> - alloca $ \x4 -> - alloca $ \pprop -> do - xGetWindowProperty d xroot xid 0 1 False 20 x1 x2 x3 x4 pprop - prop <- peek pprop - when (prop /= nullPtr) $ do - rootbg <- peek (castPtr prop) :: IO Pixmap - xFree prop - withRenderPicture d rootbg $ \bgpic -> - withRenderFill d (XRenderColor 0 0 0 (0xFFFF - 257 * alpha)) - (render pictOpAdd bgpic pic) - --- | Parses color into XRender color (allocation not necessary!) -parseRenderColor :: Display -> String -> IO XRenderColor -parseRenderColor d c = do - let colormap = defaultColormap d (defaultScreen d) - Color _ red green blue _ <- parseColor d colormap c - return $ XRenderColor (fromIntegral red) (fromIntegral green) (fromIntegral blue) 0xFFFF - -pictOpSrc, pictOpAdd :: PictOp -pictOpSrc = 1 -pictOpAdd = 12 - --- pictOpMinimum = 0 --- pictOpClear = 0 --- pictOpDst = 2 --- pictOpOver = 3 --- pictOpOverReverse = 4 --- pictOpIn = 5 --- pictOpInReverse = 6 --- pictOpOut = 7 --- pictOpOutReverse = 8 --- pictOpAtop = 9 --- pictOpAtopReverse = 10 --- pictOpXor = 11 --- pictOpSaturate = 13 --- pictOpMaximum = 13 diff --git a/src/Xmobar/X11/XRender.hsc b/src/Xmobar/X11/XRender.hsc new file mode 100644 index 0000000..5ad0391 --- /dev/null +++ b/src/Xmobar/X11/XRender.hsc @@ -0,0 +1,138 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.X11.XRender +-- Copyright: (c) 2012, 2014, 2015, 2017, 2022 Jose Antonio Ortega Ruiz +-- (c) Clemens Fruhwirth 2007 +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: unportable +-- Created: Sun Sep 11, 2022 01:27 +-- +-- +-- A couple of utilities imported from libxrender to allow alpha blending of +-- an image backgrond. +-- +------------------------------------------------------------------------------ + +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module Xmobar.X11.XRender (drawBackground) where + +import Graphics.X11 +import Graphics.X11.Xrender +import Graphics.X11.Xlib.Extras (xGetWindowProperty, xFree) +import Control.Monad (when) + +import Foreign +import Foreign.C.Types + +#include + +type Picture = XID +type PictOp = CInt + +data XRenderPictFormat +data XRenderPictureAttributes = XRenderPictureAttributes + +-- foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFillRectangle" +-- xRenderFillRectangle :: Display -> PictOp -> Picture -> Ptr XRenderColor -> CInt -> CInt -> CUInt -> CUInt -> IO () +foreign import ccall unsafe "X11/extensions/Xrender.h XRenderComposite" + xRenderComposite :: Display -> PictOp -> Picture -> Picture -> Picture -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CUInt -> CUInt -> IO () +foreign import ccall unsafe "X11/extensions/Xrender.h XRenderCreateSolidFill" + xRenderCreateSolidFill :: Display -> Ptr XRenderColor -> IO Picture +foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFreePicture" + xRenderFreePicture :: Display -> Picture -> IO () +foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () +foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFindStandardFormat" + xRenderFindStandardFormat :: Display -> CInt -> IO (Ptr XRenderPictFormat) +foreign import ccall unsafe "X11/extensions/Xrender.h XRenderCreatePicture" + xRenderCreatePicture :: Display -> Drawable -> Ptr XRenderPictFormat -> CULong -> Ptr XRenderPictureAttributes -> IO Picture + +-- Attributes not supported +instance Storable XRenderPictureAttributes where + sizeOf _ = #{size XRenderPictureAttributes} + alignment _ = alignment (undefined :: CInt) + peek _ = return XRenderPictureAttributes + poke p XRenderPictureAttributes = + memset p 0 #{size XRenderPictureAttributes} + +-- | Convenience function, gives us an XRender handle to a traditional +-- Pixmap. Don't let it escape. +withRenderPicture :: Display -> Drawable -> (Picture -> IO a) -> IO () +withRenderPicture d p f = do + format <- xRenderFindStandardFormat d 1 -- PictStandardRGB24 + alloca $ \attr -> do + pic <- xRenderCreatePicture d p format 0 attr + f pic + xRenderFreePicture d pic + +-- | Convenience function, gives us an XRender picture that is a solid +-- fill of color 'c'. Don't let it escape. +withRenderFill :: Display -> XRenderColor -> (Picture -> IO a) -> IO () +withRenderFill d c f = do + pic <- with c (xRenderCreateSolidFill d) + f pic + xRenderFreePicture d pic + +-- | Drawing the background to a pixmap and taking into account +-- transparency +drawBackground :: Display -> Drawable -> String -> Int -> Rectangle -> IO () +drawBackground d p bgc alpha (Rectangle x y wid ht) = do + let render opt bg pic m = + xRenderComposite d opt bg m pic + (fromIntegral x) (fromIntegral y) 0 0 + 0 0 (fromIntegral wid) (fromIntegral ht) + withRenderPicture d p $ \pic -> do + -- Handle background color + bgcolor <- parseRenderColor d bgc + withRenderFill d bgcolor $ \bgfill -> + withRenderFill d + (XRenderColor 0 0 0 (257 * alpha)) + (render pictOpSrc bgfill pic) + -- Handle transparency + internAtom d "_XROOTPMAP_ID" False >>= \xid -> + let xroot = defaultRootWindow d in + alloca $ \x1 -> + alloca $ \x2 -> + alloca $ \x3 -> + alloca $ \x4 -> + alloca $ \pprop -> do + xGetWindowProperty d xroot xid 0 1 False 20 x1 x2 x3 x4 pprop + prop <- peek pprop + when (prop /= nullPtr) $ do + rootbg <- peek (castPtr prop) :: IO Pixmap + xFree prop + withRenderPicture d rootbg $ \bgpic -> + withRenderFill d (XRenderColor 0 0 0 (0xFFFF - 257 * alpha)) + (render pictOpAdd bgpic pic) + +-- | Parses color into XRender color (allocation not necessary!) +parseRenderColor :: Display -> String -> IO XRenderColor +parseRenderColor d c = do + let colormap = defaultColormap d (defaultScreen d) + Color _ red green blue _ <- parseColor d colormap c + return $ XRenderColor (fromIntegral red) + (fromIntegral green) + (fromIntegral blue) + 0xFFFF + +pictOpSrc, pictOpAdd :: PictOp +pictOpSrc = 1 +pictOpAdd = 12 + +-- pictOpMinimum = 0 +-- pictOpClear = 0 +-- pictOpDst = 2 +-- pictOpOver = 3 +-- pictOpOverReverse = 4 +-- pictOpIn = 5 +-- pictOpInReverse = 6 +-- pictOpOut = 7 +-- pictOpOutReverse = 8 +-- pictOpAtop = 9 +-- pictOpAtopReverse = 10 +-- pictOpXor = 11 +-- pictOpSaturate = 13 +-- pictOpMaximum = 13 diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs index 5525b70..9483c16 100644 --- a/src/Xmobar/X11/XlibDraw.hs +++ b/src/Xmobar/X11/XlibDraw.hs @@ -63,11 +63,6 @@ drawInPixmap gc p wid ht ~[left,center,right] = do getWidth (Hspace s,cl,i,_) = return (Hspace s,cl,i,fi s) fillBackground clr = setForeground d gc clr >> fillRectangle d p gc 0 0 wid ht -#if XFT - when (alpha c /= 255) - (liftIO $ drawBackground d p (bgColor c) (alpha c) (Rectangle 0 0 wid ht)) -#endif - withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do #if XFT when (alpha c == 255) $ liftIO (fillBackground bgcolor) diff --git a/xmobar.cabal b/xmobar.cabal index 9a078c8..31a36b4 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -137,14 +137,15 @@ library Xmobar.Text.Swaybar, Xmobar.Text.SwaybarClicks, Xmobar.Text.Output, + Xmobar.X11.Bitmap, + Xmobar.X11.ColorCache, + Xmobar.X11.Draw, Xmobar.X11.Events, Xmobar.X11.Loop, - Xmobar.X11.Types, Xmobar.X11.Text, - Xmobar.X11.Bitmap, - Xmobar.X11.ColorCache, + Xmobar.X11.Types, Xmobar.X11.Window, - Xmobar.X11.Draw, + Xmobar.X11.XRender, Xmobar.X11.XlibDraw, Xmobar.Plugins.Command, Xmobar.Plugins.BufferedPipeReader, @@ -239,7 +240,8 @@ library build-depends: cairo >= 0.13 && < 0.14, pango >= 0.13 && < 0.14, colour >= 2.3.6 - other-modules: Xmobar.X11.CairoSurface, Xmobar.X11.CairoDraw + other-modules: Xmobar.X11.CairoSurface, + Xmobar.X11.CairoDraw x-c2hs-header: xmobar-gtk2hs.h cpp-options: -DCAIRO -- cgit v1.2.3