diff options
author | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-08-29 15:10:55 +0200 |
---|---|---|
committer | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-08-29 15:10:55 +0200 |
commit | 7a87ba6f2e3e864fb1c487c097e2cf17bfca2df6 (patch) | |
tree | 2bf7bbce179721b7e932b9ca7fe3d2c2b74ba5eb /lib/Phi/X11.hs | |
parent | e48e3a6fe01b63d693eb33260c26505f891f21a6 (diff) | |
download | phi-7a87ba6f2e3e864fb1c487c097e2cf17bfca2df6.tar phi-7a87ba6f2e3e864fb1c487c097e2cf17bfca2df6.zip |
Get rid of layout function
Diffstat (limited to 'lib/Phi/X11.hs')
-rw-r--r-- | lib/Phi/X11.hs | 115 |
1 files changed, 59 insertions, 56 deletions
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 971be37..dbaaf28 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -43,33 +43,33 @@ data PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage :: !Su , phiRepaint :: !Bool , phiShutdown :: !Bool , phiShutdownHold :: !Int + , phiWidgetState :: !s } data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow :: !Window , panelPixmap :: !Pixmap , panelArea :: !Rectangle , panelScreenArea :: !Rectangle - , panelWidget :: !w - , panelWidgetState :: !s , panelWidgetCache :: !c } -data PhiConfig = PhiConfig { phiPhi :: !Phi - , phiPanelConfig :: !Panel.PanelConfig - , phiXConfig :: !XConfig - , phiAtoms :: !Atoms - } +data PhiConfig w s c = PhiConfig { phiPhi :: !Phi + , phiPanelConfig :: !Panel.PanelConfig + , phiXConfig :: !XConfig + , phiAtoms :: !Atoms + , phiWidget :: !w + } -newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a) - deriving (Monad, MonadReader PhiConfig, MonadIO) +newtype PhiReader w s c a = PhiReader (ReaderT (PhiConfig w s c) IO a) + deriving (Monad, MonadReader (PhiConfig w s c), MonadIO) -runPhiReader :: PhiConfig -> PhiReader a -> IO a +runPhiReader :: PhiConfig w s c -> PhiReader w s c a -> IO a runPhiReader config (PhiReader a) = runReaderT a config -newtype PhiX w s c a = PhiX (StateT (PhiState w s c) PhiReader a) - deriving (Monad, MonadState (PhiState w s c), MonadReader PhiConfig, MonadIO) +newtype PhiX w s c a = PhiX (StateT (PhiState w s c) (PhiReader w s c) a) + deriving (Monad, MonadState (PhiState w s c), MonadReader (PhiConfig w s c), MonadIO) -runPhiX :: PhiConfig -> PhiState w s c -> PhiX w s c a -> IO (a, PhiState w s c) +runPhiX :: PhiConfig w s c -> 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 @@ -91,30 +91,34 @@ runPhi xconfig config widget = do selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask bg <- createImageSurface FormatRGB24 1 1 - runPhiX PhiConfig { phiPhi = phi - , phiXConfig = xconfig - , phiPanelConfig = config - , phiAtoms = atoms - } PhiState { phiRootImage = bg - , phiPanels = [] - , phiRepaint = True - , phiShutdown = False - , phiShutdownHold = 0 - } $ do + + dispmvar <- newMVar disp + screens <- liftIO $ phiXScreenInfo xconfig disp + panelWindows <- mapM (createPanelWindow disp config) screens + let dispvar = Widget.Display dispmvar atoms + widget' = widget <~> separator 0 (if weight widget > 0 then 0 else 1) + screenPanels = zip screens panelWindows + + initialState <- Widget.initWidget widget' phi dispvar screenPanels + + runPhiX + PhiConfig { phiPhi = phi + , phiXConfig = xconfig + , phiPanelConfig = config + , phiAtoms = atoms + , phiWidget = widget' + } + PhiState { phiRootImage = bg + , phiPanels = [] + , phiRepaint = True + , phiShutdown = False + , phiShutdownHold = 0 + , phiWidgetState = initialState + } $ do updateRootImage disp - screens <- liftIO $ phiXScreenInfo xconfig disp - - panelWindows <- mapM (createPanelWindow disp) screens - - dispmvar <- liftIO $ newMVar disp - let screenPanels = zip screens panelWindows - dispvar = Widget.Display dispmvar atoms screenPanels - widget' = widget <~> separator 0 (if weight widget > 0 then 0 else 1) - widgetState <- liftIO $ Widget.initWidget widget' phi dispvar - Widget.withDisplay dispvar $ \disp -> do - panels <- mapM (\(screen, window) -> createPanel disp window widget' widgetState screen) screenPanels + panels <- mapM (\(screen, window) -> createPanel disp window screen) screenPanels forM_ panels $ \panel -> do setPanelProperties disp panel @@ -158,14 +162,10 @@ termHandler :: Phi -> Handler termHandler phi = Catch $ sendMessage phi Shutdown -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 s c () +handleMessage :: (Widget w s c) => Widget.Display -> Message -> PhiX w s c () handleMessage dispvar m = do - modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels} + w <- asks phiWidget + modify $ \state -> state {phiWidgetState = Widget.handleMessage w (phiWidgetState state) m} case (fromMessage m) of Just Repaint -> @@ -193,10 +193,13 @@ receiveEvents phi dispvar = do return True else return False - when (not handled) $ threadWaitRead connection + --when (not handled) $ threadWaitRead connection + when (not handled) $ threadDelay 40000 updatePanels :: (Widget w s c) => Widget.Display -> PhiX w s c () updatePanels dispvar = do + w <- asks phiWidget + s <- gets phiWidgetState rootImage <- gets phiRootImage panels <- gets phiPanels @@ -204,9 +207,8 @@ updatePanels dispvar = do let pixmap = panelPixmap panel area = panelArea panel - let layoutedWidget = (withDimension area $ Widget.layout (panelWidget panel) (panelWidgetState panel)) $ panelScreenArea panel (panelSurfaces, cache') <- liftIO $ flip runStateT (panelWidgetCache panel) $ - (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel) + (withDimension area $ Widget.render w s 0 0) (panelScreenArea panel) Widget.withDisplay dispvar $ \disp -> do let screen = defaultScreen disp @@ -237,14 +239,13 @@ updatePanels dispvar = do surfaceFinish xbuffer - -- copy buffer to window + -- update window liftIO $ do (withDimension area $ clearArea disp (panelWindow panel) 0 0) True --(withDimension area $ copyArea disp (panelPixmap panel) (panelWindow panel) (defaultGC disp $ defaultScreen disp) 0 0) 0 0 sync disp False - return $ panel { panelWidgetState = layoutedWidget, panelWidgetCache = cache' } - + return $ panel { panelWidgetCache = cache' } modify $ \state -> state { phiPanels = panels' } @@ -271,7 +272,11 @@ updateRootImage disp = do pixmap <- liftM (fromIntegral . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $ \atom -> liftIO $ getWindowProperty32 disp atom rootwin - (_, _, _, pixmapWidth, pixmapHeight, _, _) <- liftIO $ getGeometry disp pixmap + (pixmapWidth, pixmapHeight) <- case pixmap of + 0 -> return (1, 1) + _ -> do + (_, _, _, pixmapWidth, pixmapHeight, _, _) <- liftIO $ getGeometry disp pixmap + return (pixmapWidth, pixmapHeight) -- update surface size oldBg <- gets phiRootImage @@ -299,11 +304,12 @@ updateRootImage disp = do surfaceFinish rootSurface -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 +createPanel :: (Widget w s c) => Display -> Window -> Rectangle -> PhiX w s c (PanelState w s c) +createPanel disp win screenRect = do config <- asks phiPanelConfig + w <- asks phiWidget let rect = panelBounds config screenRect - let screen = defaultScreen disp + screen = defaultScreen disp depth = defaultDepth disp screen pixmap <- liftIO $ (withDimension rect $ createPixmap disp win) depth @@ -313,14 +319,11 @@ createPanel disp win w s screenRect = do , panelPixmap = pixmap , panelArea = rect , panelScreenArea = screenRect - , panelWidget = w - , panelWidgetState = s , panelWidgetCache = initCache w } -createPanelWindow :: Display -> Rectangle -> PhiX w s c Window -createPanelWindow disp screenRect = do - config <- asks phiPanelConfig +createPanelWindow :: Display -> Panel.PanelConfig -> Rectangle -> IO Window +createPanelWindow disp config screenRect = do let rect = panelBounds config screenRect screen = defaultScreen disp depth = defaultDepth disp screen |