diff options
author | Alexander Polakov <plhk@sdf.org> | 2013-02-03 19:22:21 +0400 |
---|---|---|
committer | Alexander Polakov <plhk@sdf.org> | 2013-02-03 19:22:21 +0400 |
commit | a27d4b833b9492dc17a785709b33096a8f116dc0 (patch) | |
tree | 52d744d69552027a3249166339347ea1833947e9 | |
parent | 7160bbed9870247268469330c18a5e7708eb12a3 (diff) | |
download | xmobar-a27d4b833b9492dc17a785709b33096a8f116dc0.tar.gz xmobar-a27d4b833b9492dc17a785709b33096a8f116dc0.tar.bz2 |
Move bitmap functions into Bitmap module
-rw-r--r-- | src/Bitmap.hs | 50 | ||||
-rw-r--r-- | src/Types.hs | 9 |
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 - } |