Pure bestIcon function
This commit is contained in:
parent
4419a111fd
commit
9945e23251
1 changed files with 22 additions and 20 deletions
|
@ -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
|
||||
bestIcon :: Int -> [(Int, Surface)] -> Maybe Surface
|
||||
bestIcon h icons = findBest $ sortBy compareIcons icons
|
||||
where
|
||||
compareIcons = flip (compare `on` fst)
|
||||
|
||||
findBest (a1:a2:ax) = if (snd a2) < h then Just $ fst a1 else findBest (a2:ax)
|
||||
findBest [a] = Just $ fst a
|
||||
findBest [] = Nothing
|
||||
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 []
|
||||
|
||||
|
|
Reference in a new issue