summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorAlexander Polakov <plhk@sdf.org>2013-02-03 19:22:21 +0400
committerAlexander Polakov <plhk@sdf.org>2013-02-03 19:22:21 +0400
commita27d4b833b9492dc17a785709b33096a8f116dc0 (patch)
tree52d744d69552027a3249166339347ea1833947e9
parent7160bbed9870247268469330c18a5e7708eb12a3 (diff)
downloadxmobar-a27d4b833b9492dc17a785709b33096a8f116dc0.tar.gz
xmobar-a27d4b833b9492dc17a785709b33096a8f116dc0.tar.bz2
Move bitmap functions into Bitmap module
-rw-r--r--src/Bitmap.hs50
-rw-r--r--src/Types.hs9
2 files changed, 50 insertions, 9 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
diff --git a/src/Types.hs b/src/Types.hs
deleted file mode 100644
index 94f2373..0000000
--- a/src/Types.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Types where
-import Graphics.X11.Xlib
-
-data Widget = Text String | Icon String
-
-data Bitmap = Bitmap { width :: Dimension
- , height :: Dimension
- , pixmap :: Pixmap
- }