diff options
| -rw-r--r-- | src/Bitmap.hs | 22 |
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 |