Pure bestIcon function

This commit is contained in:
Matthias Schiffer 2011-07-16 01:28:47 +02:00
parent 4419a111fd
commit 9945e23251

View file

@ -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 []