From 832985aec801620baa08bc434def294da8ef3f44 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Wed, 21 Sep 2022 00:52:59 +0100
Subject: better abstracted icon drawing interface

---
 src/Xmobar/Draw/Cairo.hs |  5 ++---
 src/Xmobar/Draw/Types.hs | 23 ++++-------------------
 src/Xmobar/X11/Bitmap.hs | 26 ++++++++++++++++++--------
 src/Xmobar/X11/Draw.hs   | 11 +++++++----
 4 files changed, 31 insertions(+), 34 deletions(-)

diff --git a/src/Xmobar/Draw/Cairo.hs b/src/Xmobar/Draw/Cairo.hs
index a25cca0..7e22df4 100644
--- a/src/Xmobar/Draw/Cairo.hs
+++ b/src/Xmobar/Draw/Cairo.hs
@@ -94,11 +94,10 @@ withRenderinfo _ _ seg@(P.Hspace w, _, _, _) =
   return (seg, \_ _ _ -> return (), fromIntegral w)
 
 withRenderinfo _ dctx seg@(P.Icon p, _, _, _) = do
-  let bm = T.dcBitmapLookup dctx p
-      wd = maybe 0 (fromIntegral . T.bWidth) bm
+  let (wd, _) = T.dcIconLookup dctx p
       ioff = C.iconOffset (T.dcConfig dctx)
       vpos = T.dcHeight dctx / 2  + fromIntegral ioff
-      render _ off mx = when (off + wd <= mx) $ T.dcBitmapDrawer dctx off vpos p
+      render _ off mx = when (off + wd <= mx) $ T.dcIconDrawer dctx off vpos p
   return (seg, render, wd)
 
 drawBox :: T.DrawContext -> Surface -> Double -> Double -> P.Box -> IO ()
diff --git a/src/Xmobar/Draw/Types.hs b/src/Xmobar/Draw/Types.hs
index 219a64b..75dd714 100644
--- a/src/Xmobar/Draw/Types.hs
+++ b/src/Xmobar/Draw/Types.hs
@@ -17,10 +17,6 @@
 
 module Xmobar.Draw.Types where
 
-import GHC.Word (Word32, Word64)
-
-import Data.Map (Map)
-
 import Xmobar.Config.Types (Config)
 import Xmobar.Run.Actions (Action)
 import Xmobar.Run.Parsers (Segment)
@@ -29,22 +25,11 @@ type Position = Double
 type ActionPos = ([Action], Position, Position)
 type Actions = [ActionPos]
 
-type BitmapDrawer = Double -> Double -> String -> IO ()
-
-data BitmapType = Mono Word64 | Poly
-
-data Bitmap = Bitmap { bWidth  :: Word32
-                     , bHeight :: Word32
-                     , bPixmap :: Word64
-                     , bShapepixmap :: Maybe Word64
-                     , bBitmaptype :: BitmapType
-                     }
-
-type BitmapCache = Map FilePath Bitmap
-
+type IconLookup = String -> (Double, Double)
+type IconDrawer = Double -> Double -> String -> IO ()
 
-data DrawContext = DC { dcBitmapDrawer :: BitmapDrawer
-                      , dcBitmapLookup :: String -> Maybe Bitmap
+data DrawContext = DC { dcIconDrawer :: IconDrawer
+                      , dcIconLookup :: IconLookup
                       , dcConfig :: Config
                       , dcWidth :: Double
                       , dcHeight :: Double
diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs
index d6a818b..b14356f 100644
--- a/src/Xmobar/X11/Bitmap.hs
+++ b/src/Xmobar/X11/Bitmap.hs
@@ -27,7 +27,6 @@ import System.Directory (doesFileExist)
 import System.FilePath ((</>))
 import System.Mem.Weak ( addFinalizer )
 
-import Xmobar.Draw.Types (BitmapType(..), Bitmap(..), BitmapCache)
 import Xmobar.X11.ColorCache
 
 #ifdef XPM
@@ -47,7 +46,18 @@ runExceptT = runErrorT
 
 #endif
 
-updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath -> [FilePath]
+data BitmapType = Mono Pixel | Poly
+
+data Bitmap = Bitmap { width  :: Dimension
+                     , height :: Dimension
+                     , pixmap :: Pixmap
+                     , shapePixmap :: Maybe Pixmap
+                     , bitmapType :: BitmapType
+                     }
+
+type BitmapCache = Map FilePath Bitmap
+
+updateCache :: Display -> Window -> BitmapCache -> FilePath -> [FilePath]
             -> IO BitmapCache
 updateCache dpy win cache iconRoot paths = do
   let expandPath path@('/':_) = path
@@ -107,15 +117,15 @@ drawBitmap :: Display -> Drawable -> GC -> String -> String
               -> Position -> Position -> Bitmap -> IO ()
 drawBitmap d p gc fc bc x y i =
   withColors d [fc, bc] $ \[fc', bc'] -> do
-    let w = bWidth i
-        h = bHeight i
+    let w = width i
+        h = height i
         y' = 1 + y - fromIntegral h `div` 2
     setForeground d gc fc'
     setBackground d gc bc'
-    case bShapepixmap i of
+    case shapePixmap i of
          Nothing -> return ()
          Just mask -> setClipOrigin d gc x y' >> setClipMask d gc mask
-    case bBitmaptype i of
-         Poly -> copyArea d (bPixmap i) p gc 0 0 w h x y'
-         Mono pl -> copyPlane d (bPixmap i) p gc 0 0 w h x y' pl
+    case bitmapType i of
+         Poly -> copyArea d (pixmap i) p gc 0 0 w h x y'
+         Mono pl -> copyPlane d (pixmap i) p gc 0 0 w h x y' pl
     setClipMask d gc 0
diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs
index 7e0dfd1..a056136 100644
--- a/src/Xmobar/X11/Draw.hs
+++ b/src/Xmobar/X11/Draw.hs
@@ -37,18 +37,21 @@ import qualified Xmobar.X11.CairoSurface as CS
 import qualified Xmobar.X11.XRender as XRender
 #endif
 
-drawXBitmap :: T.XConf -> X11.GC -> X11.Pixmap -> D.BitmapDrawer
+drawXBitmap :: T.XConf -> X11.GC -> X11.Pixmap -> D.IconDrawer
 drawXBitmap xconf gc p h v path = do
   let disp = T.display xconf
       conf = T.config xconf
       fc = C.fgColor conf
       bc = C.bgColor conf
-  case lookupXBitmap xconf path of
+  case M.lookup path (T.iconCache xconf) of
     Just bm -> liftIO $ B.drawBitmap disp p gc fc bc (round h) (round v) bm
     Nothing -> return ()
 
-lookupXBitmap :: T.XConf -> String -> Maybe B.Bitmap
-lookupXBitmap xconf path = M.lookup path (T.iconCache xconf)
+lookupXBitmap :: T.XConf -> String -> (Double, Double)
+lookupXBitmap xconf path =
+  case M.lookup path (T.iconCache xconf) of
+    Just bm -> (fromIntegral (B.width bm), fromIntegral (B.height bm))
+    Nothing -> (0, 0)
 
 withPixmap :: X11.Display -> X11.Drawable -> X11.Rectangle -> FT.CInt
            -> (X11.GC -> X11.Pixmap -> IO a) -> IO a
-- 
cgit v1.2.3