diff options
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r-- | lib/Phi/Widgets/AlphaBox.hs | 13 | ||||
-rw-r--r-- | lib/Phi/Widgets/Clock.hs | 18 | ||||
-rw-r--r-- | lib/Phi/Widgets/Systray.hs | 18 | ||||
-rw-r--r-- | lib/Phi/Widgets/Taskbar.hs | 20 |
4 files changed, 34 insertions, 35 deletions
diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs index dd4bfba..2db17f4 100644 --- a/lib/Phi/Widgets/AlphaBox.hs +++ b/lib/Phi/Widgets/AlphaBox.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Phi.Widgets.AlphaBox ( alphaBox ) where @@ -11,13 +11,12 @@ import Control.Monad import Graphics.Rendering.Cairo -data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Show +data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Eq -data AlphaBox = AlphaBox !Double ![Widget] deriving Show +data AlphaBox = AlphaBox !Double ![Widget] deriving (Show, Eq) -instance WidgetClass AlphaBox where - type WidgetData AlphaBox = AlphaBoxState +instance WidgetClass AlphaBox AlphaBoxState where initWidget (AlphaBox _ widgets) phi disp = liftM AlphaBoxState $ mapM (createWidgetState phi disp) widgets minSize (AlphaBox _ _) (AlphaBoxState widgetStates) height screen = @@ -27,10 +26,10 @@ instance WidgetClass AlphaBox where layout (AlphaBox _ _) (AlphaBoxState widgetStates) width height screen = AlphaBoxState $ layoutWidgets widgetStates 0 0 width height screen - render (AlphaBox alpha _) (AlphaBoxState widgetStates) w h screen = do + render (AlphaBox alpha _) (AlphaBoxState widgetStates) x y w h screen = do renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do renderWith surface $ do - renderWidgets widgetStates screen + renderWidgets widgetStates screen x y setOperator OperatorDestIn setSourceRGBA 0 0 0 alpha diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs index d2ad134..2607288 100644 --- a/lib/Phi/Widgets/Clock.hs +++ b/lib/Phi/Widgets/Clock.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-} module Phi.Widgets.Clock ( ClockConfig(..) , defaultClockConfig @@ -29,20 +29,21 @@ data ClockConfig = ClockConfig { clockFormat :: !String , fontColor :: !Color , lineSpacing :: !Double , clockSize :: !Int - } deriving Show + } deriving (Show, Eq) defaultClockConfig :: ClockConfig defaultClockConfig = ClockConfig "%R" (0, 0, 0, 1) 0 50 -data Clock = Clock !ClockConfig deriving Show +data Clock = Clock !ClockConfig deriving (Show, Eq) -data ClockState = ClockState !ZonedTime deriving Show +instance Eq ZonedTime where + (ZonedTime localTime timezone) == (ZonedTime localTime' timezone') = (localTime == localTime') && (timezone == timezone') + +data ClockState = ClockState !ZonedTime deriving (Show, Eq) data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable) -instance WidgetClass Clock where - type WidgetData Clock = ClockState - +instance WidgetClass Clock ClockState where initWidget (Clock _) phi _ = do forkIO $ forever $ do time <- getZonedTime @@ -57,8 +58,7 @@ instance WidgetClass Clock where minSize (Clock config) _ _ _ = clockSize config - render (Clock config) (ClockState time) w h _ = do - time <- liftIO getZonedTime + render (Clock config) (ClockState time) _ _ w h _ = do let (r, g, b, a) = fontColor config str = formatTime defaultTimeLocale (clockFormat config) time setSourceRGBA r g b a diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs index 385a740..e9311de 100644 --- a/lib/Phi/Widgets/Systray.hs +++ b/lib/Phi/Widgets/Systray.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-} module Phi.Widgets.Systray ( systray ) where @@ -48,16 +48,16 @@ instance Show (IORef a) where data SystrayIconState = SystrayIconState !Window !Window deriving Show data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState] deriving Show +instance Eq SystrayState where + _ == _ = False -data Systray = Systray deriving Show +data Systray = Systray deriving (Show, Eq) data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon !Window !Window !Int !Int !Int !Int !Bool deriving (Show, Typeable) -instance WidgetClass Systray where - type WidgetData Systray = SystrayState - +instance WidgetClass Systray SystrayState where initWidget (Systray) phi dispvar = do phi' <- dupPhi phi forkIO $ systrayRunner phi' dispvar @@ -71,15 +71,13 @@ instance WidgetClass Systray where weight _ = 0 - render Systray (SystrayState phi systrayScreen reset lastResetRef icons) w h screen = case True of + render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = case True of _ | screen == systrayScreen -> do lastReset <- liftIO $ readIORef lastResetRef liftIO $ writeIORef lastResetRef reset - Matrix _ _ _ _ dx dy <- getMatrix forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do - let x = round dx + i*(h+2) - y = round dy - sendMessage phi $ RenderIcon midParent window x y h h (lastReset /= reset) + let x' = x + i*(h+2) + sendMessage phi $ RenderIcon midParent window x' y h h (lastReset /= reset) | otherwise -> return () diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index e1a4adc..feb7246 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-} module Phi.Widgets.Taskbar ( IconStyle , idIconStyle @@ -50,6 +50,8 @@ import Phi.X11.Atoms type IconStyle = Surface -> Render () instance Show IconStyle where show _ = "IconStyle <?>" +instance Eq IconStyle where + _ == _ = True idIconStyle :: IconStyle idIconStyle = flip withPatternForSurface setSource @@ -103,20 +105,20 @@ data TaskStyle = TaskStyle { taskFont :: !String , taskColor :: !Color , taskBorder :: !BorderConfig , taskIconStyle :: !IconStyle - } deriving Show + } deriving (Show, Eq) data DesktopStyle = DesktopStyle { desktopFont :: !String , desktopLabelWidth :: !Int , desktopLabelGap :: !Int , desktopColor :: !Color , desktopBorder :: !BorderConfig - } deriving Show + } deriving (Show, Eq) data TaskbarConfig = TaskbarConfig { taskMaxSize :: !Int , normalTaskStyle :: !TaskStyle , activeTaskStyle :: !TaskStyle , desktopStyle :: !(Maybe (DesktopStyle, DesktopStyle)) - } deriving Show + } deriving (Show, Eq) defaultStyle :: TaskStyle defaultStyle = TaskStyle { taskFont = "Sans 8" @@ -132,7 +134,7 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200 , desktopStyle = Nothing } -data Taskbar = Taskbar TaskbarConfig deriving Show +data Taskbar = Taskbar TaskbarConfig deriving (Show, Eq) instance Show Surface where show _ = "Surface <?>" @@ -146,6 +148,8 @@ data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window , taskbarWindowScaledIcons :: !(M.Map Window (IORef (Maybe (Int, Surface)))) , taskbarWindowScreens :: !(M.Map Window Xlib.Rectangle) } deriving Show +instance Eq TaskbarState where + _ == _ = False data WindowState = WindowState { windowTitle :: !String , windowDesktop :: !Int @@ -161,9 +165,7 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState instance Show (IORef a) where show _ = "IORef <?>" -instance WidgetClass Taskbar where - type WidgetData Taskbar = TaskbarState - +instance WidgetClass Taskbar TaskbarState where initWidget (Taskbar _) phi dispvar = do phi' <- dupPhi phi forkIO $ taskbarRunner phi' dispvar @@ -182,7 +184,7 @@ instance WidgetClass Taskbar where , taskbarWindowIcons = windowIcons , taskbarWindowScaledIcons = windowScaledIcons , taskbarWindowScreens = windowScreens - } w h screen = do + } _ _ w h screen = do let screenWindows = filter ((== Just screen) . flip M.lookup windowScreens) windows desktopNumbers = take desktopCount [0..] desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) desktopNumbers |