From a27d4b833b9492dc17a785709b33096a8f116dc0 Mon Sep 17 00:00:00 2001
From: Alexander Polakov <plhk@sdf.org>
Date: Sun, 3 Feb 2013 19:22:21 +0400
Subject: Move bitmap functions into Bitmap module

---
 src/Bitmap.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Types.hs  |  9 ---------
 2 files changed, 50 insertions(+), 9 deletions(-)
 create mode 100644 src/Bitmap.hs
 delete mode 100644 src/Types.hs

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
-                     }
-- 
cgit v1.2.3