neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Some cleanup in taskbar render function

Browse source
This commit is contained in:
Matthias Schiffer 2011-07-18 17:17:07 +02:00
parent cc55ee7678
commit fcb645e610
1 changed files with 63 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

120
lib/Phi/Widgets/Taskbar.hs
View file

@ -214,66 +214,16 @@ instance WidgetClass Taskbar where
forM_ (zip [0..] desktopWindows) $ \(i, window) -> do
let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config
(r, g, b, a) = taskColor style
leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style)
rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style)
hd = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
h' = hd - (borderV $ margin $ taskBorder style)
h' = h - (borderV $ margin $ desktopBorder ds) - 2*(borderWidth $ desktopBorder ds) - (borderV $ padding $ desktopBorder ds)
mstate = M.lookup window windowStates
micons = M.lookup window windowIcons
mscaledIconRef = M.lookup window windowScaledIcons
x = dx + i*windowWidth
y = (borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds)
case (mstate, micons, mscaledIconRef) of
(Just state, Just icons, Just scaledIconRef) -> do
save
translate 0 $ fromIntegral $ ((borderTop $ margin $ desktopBorder ds) + (borderWidth $ desktopBorder ds) + (borderTop $ padding $ desktopBorder ds))
save
drawBorder (taskBorder style) x 0 windowWidth hd
clip
setSourceRGBA r g b a
renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) hd $ windowTitle state
restore
mscaledIcon <- liftIO $ readIORef scaledIconRef
scaledIcon <- case mscaledIcon of
Just (size, icon) | size == h' -> do
return $ Just icon
_ -> do
case bestIcon icons of
Just icon -> do
scaledIcon <- liftIO $ createSimilarSurface icon ContentColorAlpha h' h'
renderWith scaledIcon $ do
imageW <- imageSurfaceGetWidth icon
imageH <- imageSurfaceGetHeight icon
let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH)
case True of
_ | imageH < imageW -> translate 0 (fromIntegral (imageW-imageH)*scalef/2)
| otherwise -> translate (fromIntegral (imageH-imageW)*scalef/2) 0
downscaled scalef icon
paint
liftIO $ writeIORef scaledIconRef $ Just (h', scaledIcon)
return $ Just scaledIcon
Nothing -> return Nothing
case scaledIcon of
Just icon -> do
save
translate (fromIntegral $ x + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style)
taskIconStyle style icon
paint
restore
Nothing ->
return ()
restore
(Just state, Just icons, Just scaledIconRef) ->
renderTask state icons scaledIconRef style x y windowWidth h'
_ -> return ()
@ -283,7 +233,7 @@ instance WidgetClass Taskbar where
handleMessage _ priv m = case (fromMessage m) of
Just (WindowListUpdate windows windowStates icons scaledIcons screens) -> priv {taskbarWindows = windows
Just (WindowListUpdate windows windowStates icons scaledIcons screens) -> priv { taskbarWindows = windows
, taskbarWindowStates = windowStates
, taskbarWindowIcons = icons
, taskbarWindowScaledIcons = scaledIcons
@ -309,9 +259,65 @@ renderText font x y w h text = do
moveTo ((fromIntegral x) + ((fromIntegral w) - textWidth)/2) ((fromIntegral y) + ((fromIntegral h) - textHeight)/2)
showLayout layout
bestIcon :: [(Int, Surface)] -> Maybe Surface
bestIcon icons = fmap snd . listToMaybe $ sortBy compareIcons icons
renderTask :: WindowState -> [(Int, Surface)] -> IORef (Maybe (Int, Surface)) -> TaskStyle -> Int -> Int -> Int -> Int -> Render ()
renderTask state icons scaledIconRef style x y w h = do
let (r, g, b, a) = taskColor style
leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style)
rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style)
h' = h - (borderV $ margin $ taskBorder style)
save
drawBorder (taskBorder style) x y w h
clip
setSourceRGBA r g b a
renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) y (w - leftBorder - h' - 3 - rightBorder) h $ windowTitle state
restore
mscaledIcon <- liftIO $ readIORef scaledIconRef
scaledIcon <- case mscaledIcon of
Just (size, icon) | size == h' -> do
return $ Just icon
_ -> do
scaledIcon <- createScaledIcon icons h'
liftIO $ writeIORef scaledIconRef $ fmap ((,) h') scaledIcon
return scaledIcon
case scaledIcon of
Just icon -> do
save
translate (fromIntegral $ x + leftBorder) (fromIntegral $ y + (borderTop $ margin $ taskBorder style))
taskIconStyle style icon
paint
restore
_ -> return ()
createScaledIcon :: [(Int, Surface)] -> Int -> Render (Maybe Surface)
createScaledIcon icons h = do
case bestIcon of
Just icon -> do
scaledIcon <- liftIO $ createSimilarSurface icon ContentColorAlpha h h
renderWith scaledIcon $ do
imageW <- imageSurfaceGetWidth icon
imageH <- imageSurfaceGetHeight icon
let scalef = (fromIntegral h)/(fromIntegral $ max imageW imageH)
case True of
_ | imageH < imageW -> translate 0 (fromIntegral (imageW-imageH)*scalef/2)
| otherwise -> translate (fromIntegral (imageH-imageW)*scalef/2) 0
downscaled scalef icon
paint
return $ Just scaledIcon
_ -> return Nothing
where
bestIcon = fmap snd . listToMaybe $ sortBy compareIcons icons
compareIcons = flip (compare `on` fst)