summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--src/Bitmap.hs22
1 files changed, 12 insertions, 10 deletions
diff --git a/src/Bitmap.hs b/src/Bitmap.hs
index 44dec5d..3479e28 100644
--- a/src/Bitmap.hs
+++ b/src/Bitmap.hs
@@ -29,17 +29,17 @@ data Bitmap = Bitmap { width :: Dimension
, pixmap :: Pixmap
}
-updateCache :: Display -> Window -> Map FilePath Bitmap -> [[(Widget, String)]] -> IO (Map FilePath Bitmap)
+updateCache :: Display -> Window -> Map FilePath Bitmap -> [[(Widget, String)]]
+ -> IO (Map FilePath Bitmap)
updateCache dpy win cache ps = do
let paths = map (\(Icon p, _) -> p) . concatMap (filter icons) $ ps
icons (Icon _, _) = True
icons _ = False
- foldM (\m path -> if member path m
- then return m
- else do bitmap <- loadBitmap dpy win path
- case bitmap of
- Nothing -> return m
- Just bmap -> return $ insert path bmap m) cache paths
+ go m path = if member path m
+ then return m
+ else do bitmap <- loadBitmap dpy win path
+ return $ maybe m (\b -> insert path b m) bitmap
+ foldM go cache paths
loadBitmap :: Display -> Drawable -> FilePath -> IO (Maybe Bitmap)
loadBitmap d w p = do
@@ -53,9 +53,11 @@ loadBitmap d w p = do
return Nothing
drawBitmap :: Display -> Drawable -> GC -> String -> String
- -> Position -> Position -> Bitmap -> IO ()
-drawBitmap d p gc fc bc x y i = do
+ -> Position -> Position -> Bitmap -> IO ()
+drawBitmap d p gc fc bc x y i =
withColors d [fc, bc] $ \[fc', bc'] -> do
+ let w = width i
+ h = height i
setForeground d gc fc'
setBackground d gc bc'
- copyPlane d (pixmap i) p gc 0 0 (width i) (height i) x (y - (fromIntegral $ height i)) 1
+ copyPlane d (pixmap i) p gc 0 0 w h x (y - (fromIntegral h)) 1