diff options
| -rw-r--r-- | src/Xmobar/Draw/Cairo.hs | 5 | ||||
| -rw-r--r-- | src/Xmobar/Draw/Types.hs | 23 | ||||
| -rw-r--r-- | src/Xmobar/X11/Bitmap.hs | 26 | ||||
| -rw-r--r-- | 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 |