diff options
-rw-r--r-- | src/Xmobar/X11/CairoDraw.hs | 48 | ||||
-rw-r--r-- | src/Xmobar/X11/CairoSurface.hsc | 59 | ||||
-rw-r--r-- | xmobar.cabal | 11 |
3 files changed, 118 insertions, 0 deletions
diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs new file mode 100644 index 0000000..424ea90 --- /dev/null +++ b/src/Xmobar/X11/CairoDraw.hs @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.X11.CairoDraw +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: unportable +-- Created: Fri Sep 09, 2022 02:03 +-- +-- Drawing the xmobar contents using Cairo and Pango +-- +-- +------------------------------------------------------------------------------ + +module Xmobar.X11.CairoDraw (drawInPixmap) where + +import Control.Monad.IO.Class +import Control.Monad.Reader + +import Graphics.X11.Xlib hiding (Segment) +import GI.Cairo.Render.Types + +import Xmobar.Run.Parsers (Segment) +import Xmobar.X11.Types +import Xmobar.X11.CairoSurface +-- import Xmobar.Text.Pango +import Xmobar.Config.Types + +drawInPixmap :: Pixmap -> Dimension -> Dimension -> [[Segment]] -> X () +drawInPixmap p w h s = do + xconf <- ask + let disp = display xconf + scr = screenOfDisplay disp 0 + c = config xconf + fi = fromIntegral + liftIO $ withBitmapSurface disp p scr (fi w) (fi h) (renderSegments c s) + + +renderSegment :: String -> String -> Surface -> Segment -> IO () +renderSegment _fg _bg _surface _segment = undefined + +renderSegments :: Config -> [[Segment]] -> Surface -> IO () +renderSegments conf segments surface = do + let bg = bgColor conf + fg = fgColor conf + mapM_ (renderSegment fg bg surface) (concat segments) diff --git a/src/Xmobar/X11/CairoSurface.hsc b/src/Xmobar/X11/CairoSurface.hsc new file mode 100644 index 0000000..af2e7ae --- /dev/null +++ b/src/Xmobar/X11/CairoSurface.hsc @@ -0,0 +1,59 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} + +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.X11.Cairo +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: unportable +-- Created: Thu Sep 08, 2022 01:25 +-- +-- +-- Xlib Cairo Surface creation +-- +------------------------------------------------------------------------------ + +module Xmobar.X11.CairoSurface (withXlibSurface, withBitmapSurface) where + +import Graphics.X11.Xlib.Types +import Graphics.X11.Types +import GI.Cairo.Render.Types +import qualified GI.Cairo.Render.Internal as Internal + +import Foreign +import Foreign.C + +#include <cairo/cairo-xlib.h> + +foreign import ccall "cairo_xlib_surface_create" + cSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> Ptr Surface + +foreign import ccall "cairo_xlib_surface_create_for_bitmap" + cBitmapCreate :: Display -> Pixmap -> Screen -> CInt -> CInt -> Ptr Surface + +createXlibSurface :: Display -> Drawable -> Visual -> Int -> Int -> IO Surface +createXlibSurface d dr v w h = + mkSurface $ cSurfaceCreate d dr v (fromIntegral w) (fromIntegral h) + +withXlibSurface :: + Display -> Drawable -> Visual -> Int -> Int -> (Surface -> IO a) -> IO a +withXlibSurface d dr v w h f = do + surface <- createXlibSurface d dr v w h + ret <- f surface + Internal.surfaceDestroy surface + return ret + +createBitmapSurface :: Display -> Pixmap -> Screen -> Int -> Int -> IO Surface +createBitmapSurface d p s w h = + mkSurface $ cBitmapCreate d p s (fromIntegral w) (fromIntegral h) + +withBitmapSurface :: + Display -> Pixmap -> Screen -> Int -> Int -> (Surface -> IO a) -> IO a +withBitmapSurface d p s w h f = do + surface <- createBitmapSurface d p s w h + ret <- f surface + Internal.surfaceDestroy surface + return ret diff --git a/xmobar.cabal b/xmobar.cabal index 55c27e8..6601a97 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -36,6 +36,10 @@ flag with_xft description: Use Xft to render text. UTF-8 support included. default: False +flag with_cairo + description: Use Cairo and Pango to render text, instead of Xft. UTF-8 support included. + default: False + flag with_inotify description: inotify support (modern Linux only). Required for the Mail and MBox plugins. default: False @@ -141,6 +145,7 @@ library Xmobar.X11.ColorCache, Xmobar.X11.Window, Xmobar.X11.Draw, + Xmobar.X11.XlibDraw, Xmobar.Plugins.Command, Xmobar.Plugins.BufferedPipeReader, Xmobar.Plugins.CommandReader, @@ -230,6 +235,12 @@ library other-modules: Xmobar.X11.MinXft cpp-options: -DXFT + if flag(with_cairo) + build-depends: gi-cairo-render >= 0.1.1 && < 0.2 + other-modules: Xmobar.X11.CairoSurface, Xmobar.X11.CairoDraw + x-c2hs-header: xmobar-gtk2hs.h + cpp-options: -DCAIRO + if flag(with_inotify) || flag(all_extensions) build-depends: hinotify >= 0.3 && < 0.5 other-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox |