diff options
Diffstat (limited to 'src/Bitmap.hs')
-rw-r--r-- | src/Bitmap.hs | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/src/Bitmap.hs b/src/Bitmap.hs new file mode 100644 index 0000000..8a86f92 --- /dev/null +++ b/src/Bitmap.hs @@ -0,0 +1,50 @@ +module Bitmap + ( updateCache + , drawBitmap + , Bitmap) where + +import Control.Monad +import Data.Map hiding (foldr, map, filter) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import System.Directory (doesFileExist) +import System.Mem.Weak ( addFinalizer ) +import XGraphic +import ColorCache +import Parsers (Widget(..)) + +data Bitmap = Bitmap { width :: Dimension + , height :: Dimension + , pixmap :: Pixmap + } + +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 + +loadBitmap :: Display -> Drawable -> FilePath -> IO (Maybe Bitmap) +loadBitmap d w p = do + exist <- doesFileExist p + if exist + then do + (bw, bh, bp, _, _) <- readBitmapFile d w p + addFinalizer bp (freePixmap d bp) + return $ Just $ Bitmap bw bh bp + else + return Nothing + +drawBitmap :: Display -> Drawable -> GC -> String -> String + -> Position -> Position -> Bitmap -> IO () +drawBitmap d p gc fc bc x y i = do + withColors d [fc, bc] $ \[fc', bc'] -> do + 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 |