summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-08-21 08:40:08 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-08-21 08:40:08 +0200
commit022783f4a7fd5b85afa5eedffd8a2e6a07432e1d (patch)
tree6c42cfcc9747a4e748d4456bf8bd704f0e42d9d5
parent028c4243a87e41e3b7e2c51eb752d4b089b30680 (diff)
downloadphi-022783f4a7fd5b85afa5eedffd8a2e6a07432e1d.tar
phi-022783f4a7fd5b85afa5eedffd8a2e6a07432e1d.zip
Get rid of existential Widget type and Widget lists
-rw-r--r--lib/Phi/Border.hs43
-rw-r--r--lib/Phi/Widget.hs125
-rw-r--r--lib/Phi/Widgets/AlphaBox.hs39
-rw-r--r--lib/Phi/Widgets/Clock.hs6
-rw-r--r--lib/Phi/Widgets/Systray.hs18
-rw-r--r--lib/Phi/Widgets/Taskbar.hs8
-rw-r--r--lib/Phi/X11.hs76
-rw-r--r--src/Phi.hs4
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
diff --git a/src/Phi.hs b/src/Phi.hs
index 9597955..6dc18fb 100644
--- a/src/Phi.hs
+++ b/src/Phi.hs
@@ -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