summaryrefslogtreecommitdiffstats
path: root/lib/Phi/X11.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/X11.hs')
-rw-r--r--lib/Phi/X11.hs76
1 files changed, 39 insertions, 37 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-05 12:21:01 +0200