summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/MinXft.hsc116
-rw-r--r--src/XUtil.hsc112
-rw-r--r--src/Xmobar.hs7
3 files changed, 122 insertions, 113 deletions
diff --git a/src/MinXft.hsc b/src/MinXft.hsc
index b2299af..148efe7 100644
--- a/src/MinXft.hsc
+++ b/src/MinXft.hsc
@@ -1,8 +1,7 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
------------------------------------------------------------------------------
-- |
-- Module: MinXft
--- Copyright: (c) 2012, 2014 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2012, 2014, 2015 Jose Antonio Ortega Ruiz
-- (c) Clemens Fruhwirth <clemens@endorphin.org> 2007
-- License: BSD3-style (see LICENSE)
--
@@ -19,6 +18,8 @@
--
------------------------------------------------------------------------------
+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
+
module MinXft ( AXftColor
, AXftDraw (..)
, AXftFont
@@ -27,6 +28,7 @@ module MinXft ( AXftColor
, withAXftDraw
, drawXftString
, drawXftString'
+ , drawBackground
, drawXftRect
, openAXftFont
, closeAXftFont
@@ -45,6 +47,7 @@ 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
@@ -52,6 +55,8 @@ import Foreign.C.String
import Codec.Binary.UTF8.String as UTF8
import Data.Char (ord)
+import Control.Monad (when)
+
#include <X11/Xft/Xft.h>
-- Color Handling
@@ -219,3 +224,110 @@ 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 <X11/extensions/Xrender.h>
+
+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 = do
+ 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/XUtil.hsc b/src/XUtil.hsc
index 8a174f1..54eb843 100644
--- a/src/XUtil.hsc
+++ b/src/XUtil.hsc
@@ -21,7 +21,6 @@ module XUtil
, textExtents
, textWidth
, printString
- , drawBackground
, newWindow
, nextEvent'
, readFileSafe
@@ -38,11 +37,9 @@ import Foreign
import Graphics.X11.Xlib hiding (textExtents, textWidth)
import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)
import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xrender
import System.Mem.Weak ( addFinalizer )
import System.Posix.Types (Fd(..))
import System.IO
-import Foreign.C
#if defined XFT || defined UTF8
# if __GLASGOW_HASKELL__ < 612
@@ -54,6 +51,7 @@ import qualified System.IO as UTF8 (readFile,hGetLine)
#if defined XFT
import Data.List
import MinXft
+import Graphics.X11.Xrender
#endif
import ColorCache
@@ -233,111 +231,3 @@ setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return ()
setupLocale :: IO ()
setupLocale = return ()
#endif
-
--- More XRender nonsense
-#include <X11/extensions/Xrender.h>
-
-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 = do
- 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 tacking 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.hs b/src/Xmobar.hs
index 0d63b31..36f6cbb 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -59,6 +59,7 @@ import ColorCache
#ifdef XFT
import Graphics.X11.Xft
+import MinXft (drawBackground)
#endif
#ifdef DBUS
@@ -289,10 +290,16 @@ drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do
p <- io $ createPixmap d w wid ht
(defaultDepthOfScreen (defaultScreenOfDisplay d))
+#if XFT
when (alpha c /= 255) (io $ drawBackground d p (bgColor c) (alpha c) wr)
+#endif
withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do
gc <- io $ createGC d w
+#if XFT
when (alpha c == 255) $ do
+#else
+ do
+#endif
io $ setForeground d gc bgcolor
io $ fillRectangle d p gc 0 0 wid ht
-- write to the pixmap the new string
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-26 07:06:46 +0000