From 9945e23251bf2efa236771ddc2191e046f0fb86d Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Sat, 16 Jul 2011 01:28:47 +0200
Subject: Pure bestIcon function

---
 lib/Phi/Widgets/Taskbar.hs | 42 ++++++++++++++++++++++--------------------
 1 file changed, 22 insertions(+), 20 deletions(-)

(limited to 'lib')

diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index c48321c..d7907a0 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -65,7 +65,7 @@ data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
                                  , taskbarDesktopCount :: !Int
                                  , taskbarWindows      :: ![Window]
                                  , taskbarWindowStates :: !(M.Map Window WindowState)
-                                 , taskbarWindowIcons ::  !(M.Map Window [Surface])
+                                 , taskbarWindowIcons ::  !(M.Map Window [(Int, Surface)])
                                  } deriving Show
 
 data WindowState = WindowState { windowTitle   :: !String
@@ -73,7 +73,7 @@ data WindowState = WindowState { windowTitle   :: !String
                                , windowVisible :: !Bool
                                } deriving (Show, Eq)
 
-data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [Surface])
+data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)])
                     | DesktopCountUpdate Int
                     | ActiveWindowUpdate Window
                     deriving (Show, Typeable)
@@ -115,15 +115,19 @@ instance WidgetClass Taskbar where
             
             restore
             
-            icon' <- liftIO $ bestIcon h' icons
-            case icon' of
+            case bestIcon h' icons of
               Just icon -> withPatternForSurface icon $ \pattern -> do
                 save
                 translate (fromIntegral $  i*windowWidth + leftBorder) (fromIntegral $ borderTop $ margin border)
                 imageW <- imageSurfaceGetWidth icon
                 imageH <- imageSurfaceGetHeight icon
+                
                 let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
                 scale scalef scalef
+                
+                when (imageH < imageW) $
+                  translate 0 $ (fromIntegral (imageW-imageH))/2
+
                 setSource pattern
                 paint
                 restore
@@ -154,17 +158,14 @@ renderText config x y w h text = do
   moveTo ((fromIntegral x) + ((fromIntegral w) - textWidth)/2) ((fromIntegral y) + ((fromIntegral h) - textHeight)/2)
   showLayout layout
 
-bestIcon :: Int -> [Surface] -> IO (Maybe Surface)
-bestIcon h icons = do
-  imageSizes <- forM icons $ \icon -> liftM2 (,) (return icon) $ liftM2 max (imageSurfaceGetWidth icon) (imageSurfaceGetHeight icon)
-  let sortedIcons = sortBy compareIcons imageSizes
-  return $ findBest sortedIcons
-    where
-      compareIcons a b = (compare `on` snd) b a
-      
-      findBest (a1:a2:ax) = if (snd a2) < h then Just $ fst a1 else findBest (a2:ax)
-      findBest [a] = Just $ fst a
-      findBest [] = Nothing
+bestIcon :: Int -> [(Int, Surface)] -> Maybe Surface
+bestIcon h icons = findBest $ sortBy compareIcons icons
+  where
+    compareIcons = flip (compare `on` fst)
+    
+    findBest (a1:a2:ax) = if (fst a2) < h then Just $ snd a1 else findBest (a2:ax)
+    findBest [a] = Just $ snd a
+    findBest [] = Nothing
 
 
 windowOnDesktop :: Int -> WindowState -> Bool
@@ -191,7 +192,7 @@ taskbarRunner phi dispvar = do
       _ ->
         return ()
 
-handlePropertyUpdate :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState, M.Map Window [Surface]) IO ()
+handlePropertyUpdate :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)]) IO ()
 handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do
   let atoms = getAtoms dispvar
   
@@ -252,7 +253,8 @@ getActiveWindow :: Xlib.Display -> Atoms -> IO Window
 getActiveWindow disp atoms =
   liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_ACTIVE_WINDOW atoms) $ Xlib.defaultRootWindow disp
 
-getWindowStates :: Xlib.Display -> Atoms -> [Window] -> M.Map Window WindowState -> M.Map Window [Surface] -> IO ([Window], M.Map Window WindowState, M.Map Window [Surface])
+getWindowStates :: Xlib.Display -> Atoms -> [Window] -> M.Map Window WindowState -> M.Map Window [(Int, Surface)]
+                   -> IO ([Window], M.Map Window WindowState, M.Map Window [(Int, Surface)])
 getWindowStates disp atoms oldWindows windowStates windowIcons = do
   windows <- getWindowList disp atoms oldWindows
   
@@ -290,10 +292,10 @@ getWindowState disp atoms window = do
     where
       unsignedChr = chr . fromIntegral . (fromIntegral :: (CChar -> CUChar))
 
-getWindowIcons :: Xlib.Display -> Atoms -> Window -> IO [Surface]
+getWindowIcons :: Xlib.Display -> Atoms -> Window -> IO [(Int, Surface)]
 getWindowIcons disp atoms window = XExtras.getWindowProperty32 disp (atom_NET_WM_ICON atoms) window >>= readIcons . fromMaybe []
 
-readIcons :: [CLong] -> IO [Surface]
+readIcons :: [CLong] -> IO [(Int, Surface)]
 readIcons (width:height:iconData) = do
   if ((fromIntegral $ length iconData) < (width*height)) then return [] else do
     let (thisIcon, rest) = splitAt (fromIntegral (width*height)) iconData
@@ -304,7 +306,7 @@ readIcons (width:height:iconData) = do
     surfaceMarkDirty icon
   
     moreIcons <- readIcons rest
-    return $ icon:moreIcons
+    return $ (fromIntegral $ max width height, icon):moreIcons
 
 readIcons _ = return []
 
-- 
cgit v1.2.3