From 42c14fa1ca9d47ae32766aaa2aa995c684b7e9cb Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sun, 21 Aug 2011 19:34:16 +0200 Subject: Make render function return cachable surface slices --- lib/Phi/X11.hs | 85 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 46 insertions(+), 39 deletions(-) (limited to 'lib/Phi/X11.hs') 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 -- cgit v1.2.3