diff options
| -rw-r--r-- | lib/Phi/Border.hs | 43 | ||||
| -rw-r--r-- | lib/Phi/Widget.hs | 125 | ||||
| -rw-r--r-- | lib/Phi/Widgets/AlphaBox.hs | 39 | ||||
| -rw-r--r-- | lib/Phi/Widgets/Clock.hs | 6 | ||||
| -rw-r--r-- | lib/Phi/Widgets/Systray.hs | 18 | ||||
| -rw-r--r-- | lib/Phi/Widgets/Taskbar.hs | 8 | ||||
| -rw-r--r-- | lib/Phi/X11.hs | 76 | ||||
| -rw-r--r-- | src/Phi.hs | 4 |
8 files changed, 142 insertions, 177 deletions
diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index 01dea44..c9b582e 100644 --- a/lib/Phi/Border.hs +++ b/lib/Phi/Border.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, ExistentialQuantification, FlexibleInstances #-} module Phi.Border ( BorderWidth(..) , simpleBorderWidth @@ -8,6 +8,7 @@ module Phi.Border ( BorderWidth(..) , defaultBorderConfig , drawBorder , roundRectangle + , Border , border ) where @@ -34,8 +35,6 @@ borderH bw = borderLeft bw + borderRight bw borderV :: BorderWidth -> Int borderV bw = borderTop bw + borderBottom bw -data BorderState = BorderState ![WidgetState] deriving Eq - data BorderConfig = BorderConfig { margin :: !BorderWidth , borderWidth :: !Int , padding :: !BorderWidth @@ -54,17 +53,19 @@ defaultBorderConfig = BorderConfig { margin = simpleBorderWidth 0 , borderWeight = 1 } -data Border = Border !BorderConfig ![Widget] deriving (Show, Eq) +data Border w d = (Widget w d) => Border !BorderConfig !w +deriving instance Show (Border w d) +deriving instance Eq (Border w d) -instance WidgetClass Border BorderState where - initWidget (Border _ widgets) phi disp = liftM BorderState $ mapM (createWidgetState phi disp) widgets +instance Eq d => Widget (Border w d) d where + initWidget (Border _ w) = initWidget w - minSize (Border config _) (BorderState widgetStates) height screen = + minSize (Border config w) d height screen = case True of _ | childSize == 0 -> 0 | otherwise -> max (borderH m+2*(bw+cr)) (childSize + borderH p + 2*bw + borderH m) where - childSize = sum $ map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height' screen) widgetStates + childSize = minSize w d height' screen m = margin config bw = borderWidth config @@ -74,30 +75,34 @@ instance WidgetClass Border BorderState where weight (Border config _) = borderWeight config - layout (Border config _) (BorderState widgetStates) width height screen = case True of - _ | width' > 0 -> BorderState $ layoutWidgets widgetStates x y width' height' screen - | otherwise -> BorderState widgetStates + layout (Border config w) d width height screen = case True of + _ | width' > 0 -> layout w d width' height' screen + | otherwise -> d where m = margin config bw = borderWidth config p = padding config - x = borderLeft m + bw + borderLeft p - y = borderTop m + bw + borderTop p width' = width - borderH m - 2*bw - borderH p height' = height - borderV m - 2*bw - borderV p - render (Border config _) (BorderState widgetStates) x y w h screen = when (w > borderH m - 2*bw - borderH p) $ do - drawBorder config 0 0 w h + render (Border config w) d x y width height screen = when (width > borderH m - 2*bw - borderH p) $ do + drawBorder config 0 0 width height clip - renderWidgets widgetStates screen x y + translate (fromIntegral dx) (fromIntegral dy) + render w d (x+dx) (y+dy) width' height' screen return () where m = margin config bw = borderWidth config p = padding config + + dx = borderLeft m + bw + borderLeft p + dy = borderTop m + bw + borderTop p + width' = width - borderH m - 2*bw - borderH p + height' = height - borderV m - 2*bw - borderV p - handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates + handleMessage (Border _ w) = handleMessage w drawBorder :: BorderConfig -> Int -> Int -> Int -> Int -> Render () drawBorder config dx dy w h = do @@ -134,5 +139,5 @@ roundRectangle x y width height radius = do arc (x + radius) (y + radius) radius pi (pi*3/2) closePath -border :: BorderConfig -> [Widget] -> Widget -border config = Widget . Border config +border :: (Widget w d) => BorderConfig -> w -> Border w d +border = Border diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs index e4a1e6a..2b031d9 100644 --- a/lib/Phi/Widget.hs +++ b/lib/Phi/Widget.hs @@ -7,13 +7,10 @@ module Phi.Widget ( Display(..) , getScreens , unionArea , Widget(..) - , WidgetClass(..) - , WidgetState(..) + , CompoundWidget + , (<~>) + , Separator , separator - , createWidgetState - , layoutWidgets - , renderWidgets - , handleMessageWidgets ) where import Control.Arrow @@ -67,7 +64,7 @@ unionArea a b = fromIntegral $ uw*uh by2 = by1 + fromIntegral bh -class (Show a, Eq a, Eq d) => WidgetClass a d | a -> d where +class (Show a, Eq a, Eq d) => Widget a d | a -> d where initWidget :: a -> Phi -> Display -> IO d minSize :: a -> d -> Int -> Xlib.Rectangle -> Int @@ -83,26 +80,7 @@ class (Show a, Eq a, Eq d) => WidgetClass a d | a -> d where handleMessage :: a -> d -> Message -> d handleMessage _ priv _ = priv -data Widget = forall a d. WidgetClass a d => Widget !a -deriving instance Show Widget - -instance Eq Widget where - _ == _ = False - -data WidgetState = forall a d. WidgetClass a d => - WidgetState { stateWidget :: !a - , stateX :: !Int - , stateY :: !Int - , stateWidth :: !Int - , stateHeight :: !Int - , statePrivateData :: !d - , stateRender :: !(CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface) - } - -instance Eq WidgetState where - _ == _ = False - -createStateRender :: WidgetClass a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface +{-createStateRender :: Widget a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do surface <- createImageSurface FormatARGB32 w h renderWith surface $ do @@ -110,66 +88,59 @@ createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do paint setOperator OperatorOver render widget state x y w h screen - return surface - -createWidgetState :: Phi -> Display -> Widget -> IO WidgetState -createWidgetState phi disp (Widget w) = do - priv <- initWidget w phi disp - return WidgetState { stateWidget = w - , stateX = 0 - , stateY = 0 - , stateWidth = 0 - , stateHeight = 0 - , statePrivateData = priv - , stateRender = createStateRender - } - -layoutWidgets :: [WidgetState] -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> [WidgetState] -layoutWidgets widgets x y width height screen = snd $ mapAccumL layoutWidgetAndX x widgets - where - sizesum = sum $ map (\(WidgetState {stateWidget = w, statePrivateData = priv} ) -> nneg $ minSize w priv height screen) widgets - wsum = let wsum = sum $ map (\(WidgetState {stateWidget = w} ) -> nneg . weight $ w) widgets + return surface-} + +data CompoundWidget a da b db = (Widget a da, Widget b db) => CompoundWidget !a !b +deriving instance Eq (CompoundWidget a da b db) +deriving instance Show (CompoundWidget a da b db) + +data CompoundState a da b db = (Widget a da, Widget b db) => CompoundState !da !db !Int +deriving instance Eq (CompoundState a da b db) + +instance Widget (CompoundWidget a da b db) (CompoundState a da b db) where + initWidget (CompoundWidget a b) phi disp = liftM3 CompoundState (initWidget a phi disp) (initWidget b phi disp) (return 0) + + minSize (CompoundWidget a b) (CompoundState da db _) height screen = minSize a da height screen + minSize b db height screen + + weight (CompoundWidget a b) = weight' a + weight' b + + layout c@(CompoundWidget a b) d@(CompoundState da db _) width height screen = CompoundState da' db' xb + where + sizesum = minSize c d height screen + wsum = let wsum = weight c in if wsum > 0 then wsum else 1 - surplus = width - sizesum - - layoutWidgetAndX wX state = let lw = layoutWidget wX state - in (wX + stateWidth lw, lw) - - layoutWidget wX state = case state of - WidgetState {stateWidget = w, statePrivateData = priv, stateRender = render} -> - let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(nneg $ weight w)/wsum - priv' = layout w priv wWidth height screen - in WidgetState w wX y wWidth height priv' render + surplus = width - sizesum + + (xb, da') = layoutWidget a da + (_, db') = layoutWidget b db + + layoutWidget w priv = let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(weight' w)/wsum + in (wWidth, layout w priv wWidth height screen) + + render (CompoundWidget a b) (CompoundState da db xb) x y w h screen = do + save + render a da x y xb h screen + restore + translate (fromIntegral xb) 0 + render b db (x+xb) y (w-xb) h screen - nneg :: (Num a, Ord a) => a -> a - nneg x = max 0 x + handleMessage (CompoundWidget a b) (CompoundState da db xb) message = CompoundState (handleMessage a da message) (handleMessage b db message) xb -renderWidgets :: [WidgetState] -> Xlib.Rectangle -> Int -> Int -> Render [WidgetState] -renderWidgets widgets screen winX winY = forM widgets $ \(WidgetState widget x y w h priv render) -> do - (surface, render') <- liftIO $ runKleisli (runCache render) (widget, priv, winX+x, winY+y, w, h, screen) - - save - translate (fromIntegral x) (fromIntegral y) - withPatternForSurface surface setSource - paint - restore - - return $ WidgetState widget x y w h priv render' +weight' :: (Widget a da) => a -> Float +weight' = max 0 . weight -handleMessageWidgets :: Message -> [WidgetState] -> [WidgetState] -handleMessageWidgets message = map handleMessageWidget - where - handleMessageWidget (WidgetState w x y width height priv render) = WidgetState w x y width height (handleMessage w priv message) render +(<~>) :: (Widget a da, Widget b db) => a -> b -> CompoundWidget a da b db +a <~> b = CompoundWidget a b -data Separator = Separator Int Float deriving (Show, Eq) +data Separator = Separator !Int !Float deriving (Show, Eq) -instance WidgetClass Separator () where +instance Widget Separator () where initWidget _ _ _ = return () minSize (Separator s _) _ _ _ = s weight (Separator _ w) = w render _ _ _ _ _ _ _ = return () -separator :: Int -> Float -> Widget -separator s w = Widget $ Separator s w +separator :: Int -> Float -> Separator +separator = Separator diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs index 2db17f4..eacda5a 100644 --- a/lib/Phi/Widgets/AlphaBox.hs +++ b/lib/Phi/Widgets/AlphaBox.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, ExistentialQuantification, FlexibleInstances #-} -module Phi.Widgets.AlphaBox ( alphaBox +module Phi.Widgets.AlphaBox ( AlphaBox + , alphaBox ) where import Phi.Types @@ -11,25 +12,23 @@ import Control.Monad import Graphics.Rendering.Cairo -data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Eq +data AlphaBox w d = (Widget w d) => AlphaBox !Double !w +deriving instance Show (AlphaBox w d) +deriving instance Eq (AlphaBox w d) -data AlphaBox = AlphaBox !Double ![Widget] deriving (Show, Eq) - - -instance WidgetClass AlphaBox AlphaBoxState where - initWidget (AlphaBox _ widgets) phi disp = liftM AlphaBoxState $ mapM (createWidgetState phi disp) widgets +instance Eq d => Widget (AlphaBox w d) d where + initWidget (AlphaBox _ w) = initWidget w - minSize (AlphaBox _ _) (AlphaBoxState widgetStates) height screen = - sum (map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height screen) widgetStates) + minSize (AlphaBox _ w) = minSize w - weight (AlphaBox _ widgets) = sum (map (\(Widget w) -> weight w) widgets) + weight (AlphaBox _ w) = weight w - layout (AlphaBox _ _) (AlphaBoxState widgetStates) width height screen = AlphaBoxState $ layoutWidgets widgetStates 0 0 width height screen + layout (AlphaBox _ w) = layout w - render (AlphaBox alpha _) (AlphaBoxState widgetStates) x y w h screen = do - renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do + render (AlphaBox alpha w) d x y width height screen = do + renderWithSimilarSurface ContentColorAlpha width height $ \surface -> do renderWith surface $ do - renderWidgets widgetStates screen x y + render w d x y width height screen setOperator OperatorDestIn setSourceRGBA 0 0 0 alpha @@ -37,12 +36,10 @@ instance WidgetClass AlphaBox AlphaBoxState where withPatternForSurface surface setSource paint - - - - handleMessage _ (AlphaBoxState widgetStates) m = AlphaBoxState $ handleMessageWidgets m widgetStates + + handleMessage (AlphaBox _ w) = handleMessage w -alphaBox :: Double -> [Widget] -> Widget -alphaBox alpha = Widget . AlphaBox alpha +alphaBox :: (Widget w d) => Double -> w -> AlphaBox w d +alphaBox = AlphaBox diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs index 2607288..bee8d39 100644 --- a/lib/Phi/Widgets/Clock.hs +++ b/lib/Phi/Widgets/Clock.hs @@ -43,7 +43,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq) data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable) -instance WidgetClass Clock ClockState where +instance Widget Clock ClockState where initWidget (Clock _) phi _ = do forkIO $ forever $ do time <- getZonedTime @@ -85,6 +85,6 @@ instance WidgetClass Clock ClockState where _ -> priv -clock :: ClockConfig -> Widget +clock :: ClockConfig -> Clock clock config = do - Widget $ Clock config
\ No newline at end of file + Clock config
\ No newline at end of file diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs index e9311de..6812018 100644 --- a/lib/Phi/Widgets/Systray.hs +++ b/lib/Phi/Widgets/Systray.hs @@ -35,19 +35,9 @@ import Phi.Widget import Phi.X11.Atoms -instance Show Display where - show _ = "Display <?>" - -instance Show Phi where - show _ = "Phi <?>" - -instance Show (IORef a) where - show _ = "IORef <?>" - - data SystrayIconState = SystrayIconState !Window !Window deriving Show -data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState] deriving Show +data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState] instance Eq SystrayState where _ == _ = False @@ -57,7 +47,7 @@ data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon deriving (Show, Typeable) -instance WidgetClass Systray SystrayState where +instance Widget Systray SystrayState where initWidget (Systray) phi dispvar = do phi' <- dupPhi phi forkIO $ systrayRunner phi' dispvar @@ -298,5 +288,5 @@ removeIcon phi disp reparent window = do return () -systray :: Widget -systray = Widget $ Systray +systray :: Systray +systray = Systray diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index feb7246..c17ac36 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -7,6 +7,7 @@ module Phi.Widgets.Taskbar ( IconStyle , DesktopStyle(..) , TaskbarConfig(..) , defaultTaskbarConfig + , Taskbar , taskbar ) where @@ -165,7 +166,7 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState instance Show (IORef a) where show _ = "IORef <?>" -instance WidgetClass Taskbar TaskbarState where +instance Widget Taskbar TaskbarState where initWidget (Taskbar _) phi dispvar = do phi' <- dupPhi phi forkIO $ taskbarRunner phi' dispvar @@ -566,6 +567,5 @@ showWindow disp atoms window = do getWindowList :: Xlib.Display -> Atoms -> IO [Window] getWindowList disp atoms = liftM (map fromIntegral . join . maybeToList) $ XExtras.getWindowProperty32 disp (atom_NET_CLIENT_LIST atoms) $ Xlib.defaultRootWindow disp -taskbar :: TaskbarConfig -> Widget -taskbar config = do - Widget $ Taskbar config +taskbar :: TaskbarConfig -> Taskbar +taskbar = Taskbar diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index afa8440..2e3cb8a 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, ExistentialQuantification #-} module Phi.X11 ( XConfig(..) , defaultXConfig @@ -30,6 +30,7 @@ import Phi.Phi import qualified Phi.Types as Phi import qualified Phi.Panel as Panel import qualified Phi.Widget as Widget +import Phi.Widget (Widget) import Phi.X11.Atoms import qualified Phi.Bindings.Util as Util @@ -37,20 +38,21 @@ import qualified Phi.Bindings.Util as Util data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle]) } -data PhiState = PhiState { phiRootImage :: !Surface - , phiPanels :: ![PanelState] - , phiRepaint :: !Bool - , phiShutdown :: !Bool - , phiShutdownHold :: !Int - } - -data PanelState = PanelState { panelWindow :: !Window - , panelPixmap :: !Pixmap - , panelArea :: !Rectangle - , panelScreenArea :: !Rectangle - , panelWidgetStates :: ![Widget.WidgetState] +data PhiState w d = (Widget.Widget w d) => PhiState { phiRootImage :: !Surface + , phiPanels :: ![PanelState w d] + , phiRepaint :: !Bool + , phiShutdown :: !Bool + , phiShutdownHold :: !Int } +data PanelState w d = (Widget.Widget w d) => PanelState { panelWindow :: !Window + , panelPixmap :: !Pixmap + , panelArea :: !Rectangle + , panelScreenArea :: !Rectangle + , panelWidget :: !w + , panelWidgetState :: !d + } + data PhiConfig = PhiConfig { phiPhi :: !Phi , phiPanelConfig :: !Panel.PanelConfig , phiXConfig :: !XConfig @@ -63,18 +65,18 @@ newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a) runPhiReader :: PhiConfig -> PhiReader a -> IO a runPhiReader config (PhiReader a) = runReaderT a config -newtype PhiX a = PhiX (StateT PhiState PhiReader a) - deriving (Monad, MonadState PhiState, MonadReader PhiConfig, MonadIO) +newtype PhiX w d a = PhiX (StateT (PhiState w d) PhiReader a) + deriving (Monad, MonadState (PhiState w d), MonadReader PhiConfig, MonadIO) -runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState) +runPhiX :: PhiConfig -> PhiState w d -> PhiX w d a -> IO (a, PhiState w d) runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo } -runPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO () -runPhi xconfig config widgets = do +runPhi :: (Widget.Widget w d) => XConfig -> Panel.PanelConfig -> w -> IO () +runPhi xconfig config widget = do xSetErrorHandler phi <- initPhi @@ -108,10 +110,10 @@ runPhi xconfig config widgets = do dispmvar <- liftIO $ newMVar disp let screenPanels = zip screens panelWindows dispvar = Widget.Display dispmvar atoms screenPanels - widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets + widgetState <- liftIO $ Widget.initWidget widget phi dispvar Widget.withDisplay dispvar $ \disp -> do - panels <- mapM (\(screen, window) -> createPanel disp window widgetStates screen) screenPanels + panels <- mapM (\(screen, window) -> createPanel disp window widget widgetState screen) screenPanels forM_ panels $ \panel -> do setPanelProperties disp panel @@ -155,12 +157,12 @@ termHandler :: Phi -> Handler termHandler phi = Catch $ sendMessage phi Shutdown -handlePanel :: Message -> PanelState -> PanelState -handlePanel message panel@PanelState {panelWidgetStates = widgets} = panel {panelWidgetStates = widgets'} +handlePanel :: Message -> PanelState w d -> PanelState w d +handlePanel message panel@PanelState {panelWidget = widget, panelWidgetState = state} = panel {panelWidgetState = state'} where - widgets' = Widget.handleMessageWidgets message widgets + state' = Widget.handleMessage widget state message -handleMessage :: Widget.Display -> Message -> PhiX () +handleMessage :: Widget.Display -> Message -> PhiX w d () handleMessage dispvar m = do modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels} @@ -192,7 +194,7 @@ receiveEvents phi dispvar = do when (not handled) $ threadWaitRead connection -updatePanels :: Widget.Display -> PhiX () +updatePanels :: (Widget w d) => Widget.Display -> PhiX w d () updatePanels dispvar = do rootImage <- gets phiRootImage panels <- gets phiPanels @@ -201,8 +203,8 @@ updatePanels dispvar = do let pixmap = panelPixmap panel area = panelArea panel - let layoutedWidgets = (withDimension area $ Widget.layoutWidgets (panelWidgetStates panel) 0 0) $ panelScreenArea panel - panel' = panel { panelWidgetStates = layoutedWidgets } + let layoutedWidget = (withDimension area $ Widget.layout (panelWidget panel) (panelWidgetState panel)) $ panelScreenArea panel + panel' = panel { panelWidgetState = layoutedWidget } Widget.withDisplay dispvar $ \disp -> do let screen = defaultScreen disp @@ -218,13 +220,12 @@ updatePanels dispvar = do setSource pattern paint restore - Widget.renderWidgets layoutedWidgets (panelScreenArea panel) 0 0 + (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel) renderWith xbuffer $ do withPatternForSurface buffer $ \pattern -> do setSource pattern paint - surfaceFlush xbuffer surfaceFinish xbuffer -- copy buffer to window @@ -237,7 +238,7 @@ updatePanels dispvar = do modify $ \state -> state { phiPanels = panels' } -handlePropertyUpdate :: Display -> Event -> PhiX () +handlePropertyUpdate :: Display -> Event -> PhiX w d () handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do phi <- asks phiPhi atoms <- asks phiAtoms @@ -249,7 +250,7 @@ handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do sendMessage phi Repaint -updateRootImage :: Display -> PhiX () +updateRootImage :: Display -> PhiX w d () updateRootImage disp = do atoms <- asks phiAtoms @@ -287,8 +288,8 @@ updateRootImage disp = do surfaceFinish rootSurface -createPanel :: Display -> Window -> [Widget.WidgetState] -> Rectangle -> PhiX PanelState -createPanel disp win widgets screenRect = do +createPanel :: (Widget w d) => Display -> Window -> w -> d -> Rectangle -> PhiX w d (PanelState w d) +createPanel disp win w d screenRect = do config <- asks phiPanelConfig let rect = panelBounds config screenRect let screen = defaultScreen disp @@ -301,10 +302,11 @@ createPanel disp win widgets screenRect = do , panelPixmap = pixmap , panelArea = rect , panelScreenArea = screenRect - , panelWidgetStates = widgets + , panelWidget = w + , panelWidgetState = d } -createPanelWindow :: Display -> Rectangle -> PhiX Window +createPanelWindow :: Display -> Rectangle -> PhiX w d Window createPanelWindow disp screenRect = do config <- asks phiPanelConfig let rect = panelBounds config screenRect @@ -323,7 +325,7 @@ createPanelWindow disp screenRect = do withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr -setPanelProperties :: Display -> PanelState -> PhiX () +setPanelProperties :: Display -> PanelState w d -> PhiX w d () setPanelProperties disp panel = do atoms <- asks phiAtoms liftIO $ do @@ -354,7 +356,7 @@ setPanelProperties disp panel = do setStruts disp panel -setStruts :: Display -> PanelState -> PhiX () +setStruts :: Display -> PanelState w d -> PhiX w d () setStruts disp panel = do atoms <- asks phiAtoms config <- asks phiPanelConfig @@ -12,8 +12,7 @@ import Phi.Widgets.Systray main :: IO () main = do - runPhi defaultXConfig defaultPanelConfig { panelPosition = Top } - [alphaBox 0.9 [theTaskbar, brightBorder [theSystray], brightBorder [theClock]]] + runPhi defaultXConfig defaultPanelConfig { panelPosition = Top } $ alphaBox 0.9 $ theTaskbar <~> brightBorder theSystray <~> brightBorder theClock where normalTaskBorder = BorderConfig (BorderWidth (-1) (-3) (-1) 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.8) (0.45, 0.45, 0.45, 0.8) 5 0 activeTaskBorder = normalTaskBorder { borderColor = (1, 1, 1, 0.8) @@ -53,4 +52,5 @@ main = do , lineSpacing = (-3) , clockSize = 75 } + brightBorder :: (Widget w d) => w -> Border w d brightBorder = border normalDesktopBorder |