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.hs85
1 files changed, 46 insertions, 39 deletions
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index b2b3c2c..110e9d4 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -38,21 +38,22 @@ import qualified Phi.Bindings.Util as Util
data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle])
}
-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 PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage :: !Surface
+ , phiPanels :: ![PanelState w s c]
+ , phiRepaint :: !Bool
+ , phiShutdown :: !Bool
+ , phiShutdownHold :: !Int
}
+data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow :: !Window
+ , panelPixmap :: !Pixmap
+ , panelArea :: !Rectangle
+ , panelScreenArea :: !Rectangle
+ , panelWidget :: !w
+ , panelWidgetState :: !s
+ , panelWidgetCache :: !(Maybe c)
+ }
+
data PhiConfig = PhiConfig { phiPhi :: !Phi
, phiPanelConfig :: !Panel.PanelConfig
, phiXConfig :: !XConfig
@@ -65,17 +66,16 @@ newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a)
runPhiReader :: PhiConfig -> PhiReader a -> IO a
runPhiReader config (PhiReader a) = runReaderT a config
-newtype PhiX w d a = PhiX (StateT (PhiState w d) PhiReader a)
- deriving (Monad, MonadState (PhiState w d), MonadReader PhiConfig, MonadIO)
+newtype PhiX w s c a = PhiX (StateT (PhiState w s c) PhiReader a)
+ deriving (Monad, MonadState (PhiState w s c), MonadReader PhiConfig, MonadIO)
-runPhiX :: PhiConfig -> PhiState w d -> PhiX w d a -> IO (a, PhiState w d)
+runPhiX :: PhiConfig -> PhiState w s c -> PhiX w s c a -> IO (a, PhiState w s c)
runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
}
-
-runPhi :: (Widget.Widget w d) => XConfig -> Panel.PanelConfig -> w -> IO ()
+runPhi :: (Widget.Widget w s c) => XConfig -> Panel.PanelConfig -> w -> IO ()
runPhi xconfig config widget = do
xSetErrorHandler
@@ -158,12 +158,12 @@ termHandler :: Phi -> Handler
termHandler phi = Catch $ sendMessage phi Shutdown
-handlePanel :: Message -> PanelState w d -> PanelState w d
+handlePanel :: Message -> PanelState w s c -> PanelState w s c
handlePanel message panel@PanelState {panelWidget = widget, panelWidgetState = state} = panel {panelWidgetState = state'}
where
state' = Widget.handleMessage widget state message
-handleMessage :: Widget.Display -> Message -> PhiX w d ()
+handleMessage :: Widget.Display -> Message -> PhiX w s c ()
handleMessage dispvar m = do
modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels}
@@ -195,7 +195,7 @@ receiveEvents phi dispvar = do
when (not handled) $ threadWaitRead connection
-updatePanels :: (Widget w d) => Widget.Display -> PhiX w d ()
+updatePanels :: (Widget w s c) => Widget.Display -> PhiX w s c ()
updatePanels dispvar = do
rootImage <- gets phiRootImage
panels <- gets phiPanels
@@ -205,7 +205,7 @@ updatePanels dispvar = do
area = panelArea panel
let layoutedWidget = (withDimension area $ Widget.layout (panelWidget panel) (panelWidgetState panel)) $ panelScreenArea panel
- panel' = panel { panelWidgetState = layoutedWidget }
+ panelSurfaces <- liftIO $ (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel)
Widget.withDisplay dispvar $ \disp -> do
let screen = defaultScreen disp
@@ -215,31 +215,37 @@ updatePanels dispvar = do
liftIO $ (withDimension area $ withSimilarSurface xbuffer ContentColor) $ \buffer -> do
renderWith buffer $ do
- withPatternForSurface rootImage $ \pattern -> do
+ save
+ translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
+ withPatternForSurface rootImage setSource
+ paint
+ restore
+
+ forM_ panelSurfaces $ \(updated, SurfaceSlice x surface) -> do
save
- translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
- setSource pattern
+ translate (fromIntegral x) 0
+ withPatternForSurface surface setSource
paint
restore
- (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel)
+
renderWith xbuffer $ do
- withPatternForSurface buffer $ \pattern -> do
- setSource pattern
- paint
+ withPatternForSurface buffer setSource
+ paint
surfaceFinish xbuffer
-- copy buffer to window
liftIO $ do
- (withDimension area $ clearArea disp (panelWindow panel') 0 0) True
+ (withDimension area $ clearArea disp (panelWindow panel) 0 0) True
sync disp False
- return panel'
+ return $ panel { panelWidgetState = layoutedWidget }
+
modify $ \state -> state { phiPanels = panels' }
-handlePropertyUpdate :: Display -> Event -> PhiX w d ()
+handlePropertyUpdate :: Display -> Event -> PhiX w s c ()
handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do
phi <- asks phiPhi
atoms <- asks phiAtoms
@@ -251,7 +257,7 @@ handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do
sendMessage phi Repaint
-updateRootImage :: Display -> PhiX w d ()
+updateRootImage :: Display -> PhiX w s c ()
updateRootImage disp = do
atoms <- asks phiAtoms
@@ -289,8 +295,8 @@ updateRootImage disp = do
surfaceFinish rootSurface
-createPanel :: (Widget w d) => Display -> Window -> w -> d -> Rectangle -> PhiX w d (PanelState w d)
-createPanel disp win w d screenRect = do
+createPanel :: (Widget w s c) => Display -> Window -> w -> s -> Rectangle -> PhiX w s c (PanelState w s c)
+createPanel disp win w s screenRect = do
config <- asks phiPanelConfig
let rect = panelBounds config screenRect
let screen = defaultScreen disp
@@ -304,10 +310,11 @@ createPanel disp win w d screenRect = do
, panelArea = rect
, panelScreenArea = screenRect
, panelWidget = w
- , panelWidgetState = d
+ , panelWidgetState = s
+ , panelWidgetCache = Nothing
}
-createPanelWindow :: Display -> Rectangle -> PhiX w d Window
+createPanelWindow :: Display -> Rectangle -> PhiX w s c Window
createPanelWindow disp screenRect = do
config <- asks phiPanelConfig
let rect = panelBounds config screenRect
@@ -326,7 +333,7 @@ createPanelWindow disp screenRect = do
withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr
-setPanelProperties :: Display -> PanelState w d -> PhiX w d ()
+setPanelProperties :: Display -> PanelState w s c -> PhiX w s c ()
setPanelProperties disp panel = do
atoms <- asks phiAtoms
liftIO $ do
@@ -357,7 +364,7 @@ setPanelProperties disp panel = do
setStruts disp panel
-setStruts :: Display -> PanelState w d -> PhiX w d ()
+setStruts :: Display -> PanelState w s c -> PhiX w s c ()
setStruts disp panel = do
atoms <- asks phiAtoms
config <- asks phiPanelConfig
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-27 17:00:17 +0200