summaryrefslogtreecommitdiffhomepage
path: root/src/Bitmap.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Bitmap.hs')
-rw-r--r--src/Bitmap.hs50
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