Added clock widget

1 files changed, 58 insertions, 37 deletions

diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 806986d..3fc08e6 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Phi.X11 ( XConfig(..)
                , defaultXConfig
-               , initPhiX
+               , runPhi
                ) where
 
 import Graphics.X11.Xlib
@@ -31,25 +31,26 @@ import qualified Phi.Widget as Widget
 import Phi.X11.Atoms
 import qualified Phi.Bindings.Util as Util
 
-data XConfig = XConfig { phiXScreenInfo :: Display -> IO [Rectangle]
+data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle])
                        }
 
-data PhiState = PhiState { phiRootPixmap :: Pixmap
-                         , phiPanels     :: [PanelState]
+data PhiState = PhiState { phiPhi        :: !Phi
+                         , phiRootPixmap :: !Pixmap
+                         , phiPanels     :: ![PanelState]
                          }
 
-data PanelState = PanelState { panelWindow       :: Window
-                             , panelGC           :: GC
-                             , panelPixmap       :: Pixmap
-                             , panelSurface      :: Surface
-                             , panelArea         :: Rectangle
-                             , panelScreenArea   :: Rectangle
-                             , panelWidgetStates :: [Widget.WidgetState]
+data PanelState = PanelState { panelWindow       :: !Window
+                             , panelGC           :: !GC
+                             , panelPixmap       :: !Pixmap
+                             , panelSurface      :: !Surface
+                             , panelArea         :: !Rectangle
+                             , panelScreenArea   :: !Rectangle
+                             , panelWidgetStates :: ![Widget.WidgetState]
                              }
 
-data PhiConfig = PhiConfig { phiPanelConfig :: Panel.PanelConfig
-                           , phiXConfig     :: XConfig
-                           , phiAtoms       :: Atoms
+data PhiConfig = PhiConfig { phiPanelConfig :: !Panel.PanelConfig
+                           , phiXConfig     :: !XConfig
+                           , phiAtoms       :: !Atoms
                            }
 
 newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a)
@@ -64,12 +65,6 @@ newtype PhiX a = PhiX (StateT PhiState PhiReader a)
 runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState)
 runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
 
-forkPhiX :: PhiX () -> PhiX ThreadId
-forkPhiX f = do
-  config <- ask
-  state <- get
-  liftIO $ forkIO $ (runPhiX config state f >> return ())
-
 withMVarX :: MVar a -> (a -> PhiX b) -> PhiX b
 withMVarX m f = do
   a <- liftIO $ takeMVar m
@@ -81,18 +76,23 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
                          }
 
 
-initPhiX :: Phi -> XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
-initPhiX phi xconfig config widgets = do
+runPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
+runPhi xconfig config widgets = do
+  phi <- initPhi
   disp <- openDisplay []
 
   atoms <- initAtoms disp
   selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask
   
-  runPhiX PhiConfig { phiXConfig = xconfig, phiPanelConfig = config, phiAtoms = atoms } PhiState { phiRootPixmap = 0, phiPanels = [] } $ do
+  runPhiX PhiConfig { phiXConfig = xconfig, phiPanelConfig = config, phiAtoms = atoms } PhiState { phiPhi = phi, phiRootPixmap = 0, phiPanels = [] } $ do
     updateRootPixmap disp
     
     screens <- liftIO $ phiXScreenInfo xconfig disp
-    panels <- mapM (createPanel disp widgets) screens
+    
+    dispvar <- liftIO $ newEmptyMVar
+    widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets
+    panels <- mapM (createPanel disp widgetStates) screens
+    
     forM_ panels $ \panel -> do
       setPanelProperties disp panel
       liftIO $ mapWindow disp (panelWindow panel)
@@ -101,23 +101,36 @@ initPhiX phi xconfig config widgets = do
     
     updatePanels disp True
     
-    dispvar <- liftIO $ newMVar disp
+    liftIO $ putMVar dispvar disp
+    
     liftIO $ forkIO $ receiveEvents phi dispvar
 
-    messagebus <- liftIO $ getMessageBus phi
-    forkPhiX $ forever $ do
-      message <- liftIO $ receiveMessage messagebus
+    forever $ do
+      message <- liftIO $ receiveMessage phi
       handleMessage dispvar message
   return ()
 
 
+handlePanel :: Message -> PanelState -> PanelState
+handlePanel message panel@PanelState {panelWidgetStates = widgets} = panel {panelWidgetStates = widgets'}
+  where
+    widgets' = Widget.handleMessageWidgets message widgets
+
 handleMessage :: MVar Display -> Message -> PhiX ()
-handleMessage dispvar m
-  | Just ExposeEvent {} <- fromMessage m = withMVarX dispvar $ \disp -> do
-    updatePanels disp False
-  | Just event@PropertyEvent {} <- fromMessage m = withMVarX dispvar $ \disp -> do
-    handlePropertyUpdate disp event
-handleMessage _ _ = return ()
+handleMessage dispvar m = do
+  modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels}
+  
+  case (fromMessage m) of
+    Just Repaint -> withMVarX dispvar $ \disp ->
+      updatePanels disp True
+    _ ->
+      case (fromMessage m) of
+        Just ExposeEvent {} -> withMVarX dispvar $ \disp ->
+          updatePanels disp False
+        Just event@PropertyEvent {} -> withMVarX dispvar $ \disp ->
+          handlePropertyUpdate disp event
+        _ ->
+          return ()
 
 receiveEvents :: Phi -> MVar Display -> IO ()
 receiveEvents phi dispvar = do
@@ -186,8 +199,9 @@ updateRootPixmap disp = do
   modify $ \state -> state { phiRootPixmap = pixmap }
 
 
-createPanel :: Display -> [Widget.Widget] -> Rectangle -> PhiX PanelState
+createPanel :: Display -> [Widget.WidgetState] -> Rectangle -> PhiX PanelState
 createPanel disp widgets screenRect = do
+  phi <- gets phiPhi
   config <- asks phiPanelConfig
   let rect = panelBounds config screenRect
       
@@ -201,7 +215,14 @@ createPanel disp widgets screenRect = do
   pixmap <- liftIO $ withDimension rect (createPixmap disp win) depth
   surface <- liftIO $ withDimension rect $ Util.createXlibSurface disp pixmap visual
   
-  return PanelState { panelWindow = win, panelGC = gc, panelPixmap = pixmap, panelSurface = surface, panelArea = rect, panelScreenArea = screenRect, panelWidgetStates = map Widget.createWidgetState widgets }
+  return PanelState { panelWindow = win
+                    , panelGC = gc
+                    , panelPixmap = pixmap
+                    , panelSurface = surface
+                    , panelArea = rect
+                    , panelScreenArea = screenRect
+                    , panelWidgetStates = widgets
+                    }
 
 createPanelWindow :: Display -> Rectangle -> PhiX Window
 createPanelWindow disp rect = do