summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/X11/Draw.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-09-19 01:36:14 +0100
committerjao <jao@gnu.org>2022-09-19 01:36:14 +0100
commit44e407836e1437bd1f78edc4980eeb9fe42399b6 (patch)
tree27b3338391ac1f3164c6998d10c7c577be91813f /src/Xmobar/X11/Draw.hs
parente8a8591201ce5d103e026b65430862e24b3b73be (diff)
downloadxmobar-44e407836e1437bd1f78edc4980eeb9fe42399b6.tar.gz
xmobar-44e407836e1437bd1f78edc4980eeb9fe42399b6.tar.bz2
cairo: non-cairo is not an option
Diffstat (limited to 'src/Xmobar/X11/Draw.hs')
-rw-r--r--src/Xmobar/X11/Draw.hs105
1 files changed, 67 insertions, 38 deletions
diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs
index 4f14d22..f11dd0e 100644
--- a/src/Xmobar/X11/Draw.hs
+++ b/src/Xmobar/X11/Draw.hs
@@ -1,61 +1,90 @@
{-# LANGUAGE CPP #-}
-
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.X11.Draw
--- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
--- Portability: portable
--- Created: Sat Nov 24, 2018 18:49
+-- Portability: unportable
+-- Created: Fri Sep 09, 2022 02:03
--
+-- Drawing the xmobar contents using Cairo and Pango
--
--- Drawing the xmobar contents
--
------------------------------------------------------------------------------
+module Xmobar.X11.Draw (draw) where
-module Xmobar.X11.Draw (drawInWin) where
-
-import Control.Monad.IO.Class
-import Control.Monad.Reader
+import qualified Data.Map as M
-import Graphics.X11.Xlib hiding (Segment)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ask)
+import Foreign.C.Types as FT
+import qualified Graphics.X11.Xlib as X11
-import Xmobar.Run.Parsers (Segment)
-import Xmobar.X11.Types
+import qualified Xmobar.Config.Types as C
+import qualified Xmobar.Run.Parsers as P
+import qualified Xmobar.X11.Bitmap as B
+import qualified Xmobar.X11.Types as X
+import qualified Xmobar.X11.CairoDraw as CD
+import qualified Xmobar.X11.CairoSurface as CS
-#ifdef CAIRO
-import Xmobar.X11.CairoDraw
-#else
-import Xmobar.X11.XlibDraw
+#ifdef XRENDER
+import qualified Xmobar.X11.XRender as XRender
#endif
--- | Draws in and updates the window
-drawInWin :: [[Segment]] -> X [ActionPos]
-drawInWin segments = do
- xconf <- ask
- let d = display xconf
- w = window xconf
- (Rectangle _ _ wid ht) = rect xconf
- depth = defaultDepthOfScreen (defaultScreenOfDisplay d)
- p <- liftIO $ createPixmap d w wid ht depth
- gc <- liftIO $ createGC d w
- liftIO $ setGraphicsExposures d gc False
-
-#ifdef CAIRO
- res <- drawInPixmap gc p segments
-#else
- res <- updateActions (rect xconf) segments
- drawInPixmap gc p wid ht segments
-#endif
+drawXBitmap :: X.XConf -> X11.GC -> X11.Pixmap -> CD.BitmapDrawer
+drawXBitmap xconf gc p h v path = do
+ let disp = X.display xconf
+ conf = X.config xconf
+ fc = C.fgColor conf
+ bc = C.bgColor conf
+ case lookupXBitmap xconf path of
+ Just bm -> liftIO $ B.drawBitmap disp p gc fc bc (round h) (round v) bm
+ Nothing -> return ()
+
+lookupXBitmap :: X.XConf -> String -> Maybe B.Bitmap
+lookupXBitmap xconf path = M.lookup path (X.iconCache xconf)
+
+withPixmap :: X11.Display -> X11.Drawable -> X11.Rectangle -> FT.CInt
+ -> (X11.GC -> X11.Pixmap -> IO a) -> IO a
+withPixmap disp win (X11.Rectangle _ _ w h) depth action = do
+ p <- X11.createPixmap disp win w h depth
+ gc <- X11.createGC disp win
+ X11.setGraphicsExposures disp gc False
+ res <- action gc p
-- copy the pixmap with the new string to the window
- liftIO $ copyArea d p w gc 0 0 wid ht 0 0
+ X11.copyArea disp p win gc 0 0 w h 0 0
-- free up everything (we do not want to leak memory!)
- liftIO $ freeGC d gc
- liftIO $ freePixmap d p
+ X11.freeGC disp gc
+ X11.freePixmap disp p
-- resync (discard events, we don't read/process events from this display conn)
- liftIO $ sync d True
+ X11.sync disp True
return res
+
+draw :: [[P.Segment]] -> X.X [X.ActionPos]
+draw segments = do
+ xconf <- ask
+ let disp = X.display xconf
+ win = X.window xconf
+ rect@(X11.Rectangle _ _ w h) = X.rect xconf
+ screen = X11.defaultScreenOfDisplay disp
+ depth = X11.defaultDepthOfScreen screen
+ vis = X11.defaultVisualOfScreen screen
+ conf = X.config xconf
+
+ liftIO $ withPixmap disp win rect depth $ \gc p -> do
+ let bdraw = drawXBitmap xconf gc p
+ blook = lookupXBitmap xconf
+ dctx = CD.DC bdraw blook conf (fromIntegral w) (fromIntegral h) segments
+ render = CD.drawSegments dctx
+
+#ifdef XRENDER
+ color = C.bgColor conf
+ alph = C.alpha conf
+ XRender.drawBackground disp p color alph (X11.Rectangle 0 0 w h)
+#endif
+
+ CS.withXlibSurface disp p vis (fromIntegral w) (fromIntegral h) render