Some more restructuring, WIP

3 files changed, 66 insertions, 21 deletions

diff --git a/lib/Phi/Phi.hs b/lib/Phi/Phi.hs
new file mode 100644
index 0000000..9df36f3
--- /dev/null
+++ b/lib/Phi/Phi.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Phi.Phi ( Phi
+               , MessageBus
+               , Message(..)
+               , initPhi
+               , runPhi
+               , sendMessage
+               , getMessageBus
+               , receiveMessage
+               ) where
+
+import Control.Concurrent.Chan
+import Control.Monad
+
+data Phi = Phi (Chan Message)
+data MessageBus = MessageBus (Chan Message)
+
+data Message = forall a. Show a => Message a
+
+initPhi :: IO Phi
+initPhi = liftM Phi newChan
+
+runPhi :: Phi -> IO ()
+runPhi (Phi chan) = forever $ readChan chan
+
+sendMessage :: Phi -> Message -> IO ()
+sendMessage (Phi chan) = writeChan chan
+
+getMessageBus :: Phi -> IO MessageBus
+getMessageBus (Phi chan) = liftM MessageBus $ dupChan chan
+
+receiveMessage :: MessageBus -> IO Message
+receiveMessage (MessageBus chan) = readChan chan
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index 9262aba..3f00508 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ExistentialQuantification, TypeFamilies, StandaloneDeriving, FlexibleContexts #-}
 
-module Phi.Widget ( Widget(..)
+module Phi.Widget ( Message(..)
+                  , Widget(..)
                   , WidgetClass(..)
                   , WidgetState(..)
                   , separator
@@ -14,6 +15,8 @@ import Data.Traversable
 
 import Graphics.Rendering.Cairo
 
+import Phi.Phi
+
 
 class Show a => WidgetClass a where
   type WidgetData a :: *
@@ -29,6 +32,9 @@ class Show a => WidgetClass a where
   layout _ priv _ _ = priv
   
   render :: a -> WidgetData a -> Int -> Int -> Render ()
+  
+  handleMessage :: a -> WidgetData a -> Message -> WidgetData a
+  handleMessage _ priv _ = priv
 
 data Widget = forall a. (WidgetClass a, Show (WidgetData a)) => Widget a
 deriving instance Show Widget
@@ -67,7 +73,7 @@ layoutWidgets widgets x y width height = snd $ mapAccumL layoutWidgetAndX x widg
       WidgetState {stateWidget = w, statePrivateData = priv} ->
         let wWidth = floor $ (fromIntegral $ minSize w) + (fromIntegral surplus)*(nneg $ weight w)/wsum
             priv' = layout w priv wWidth height
-        in WidgetState { stateWidget = w, stateX = wX, stateY = y, stateWidth = wWidth, stateHeight = height, statePrivateData = priv' }
+        in WidgetState w wX y wWidth height priv'
     
     nneg :: (Num a, Ord a) => a -> a
     nneg x = max 0 x
@@ -84,6 +90,10 @@ renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget
   render widget priv w h
   restore
 
+handleMessageWidgets :: Message -> [WidgetState] -> [WidgetState]
+handleMessageWidgets message = map handleMessageWidget
+  where
+    handleMessageWidget (WidgetState w x y width height priv) = WidgetState w x y width height $ handleMessage w priv message
 
 data Separator = Separator Int Float deriving Show
 
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index b79001c..548027c 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -2,7 +2,7 @@
 
 module Phi.X11 ( XConfig(..)
                , defaultXConfig
-               , initPhi
+               , initPhiX
                ) where
 
 import Graphics.X11.Xlib
@@ -20,6 +20,7 @@ import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Trans
 
+import Phi.Phi
 import qualified Phi.Types as Phi
 import qualified Phi.Panel as Panel
 import qualified Phi.Widget as Widget
@@ -54,17 +55,17 @@ newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a)
 runPhiReader :: PhiConfig -> PhiReader a -> IO a
 runPhiReader config (PhiReader a) = runReaderT a config
 
-newtype Phi a = Phi (StateT PhiState PhiReader a)
-              deriving (Monad, MonadState PhiState, MonadReader PhiConfig, MonadIO)
+newtype PhiX a = PhiX (StateT PhiState PhiReader a)
+               deriving (Monad, MonadState PhiState, MonadReader PhiConfig, MonadIO)
 
-runPhi :: PhiConfig -> PhiState -> Phi a -> IO (a, PhiState)
-runPhi config st (Phi a) = runPhiReader config $ runStateT a st
+runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState)
+runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
 
-liftIOContToPhi :: ((a -> IO (b, PhiState)) -> IO (b, PhiState)) -> (a -> Phi b) -> Phi b
-liftIOContToPhi f c = do
+liftIOContToPhiX :: ((a -> IO (b, PhiState)) -> IO (b, PhiState)) -> (a -> PhiX b) -> PhiX b
+liftIOContToPhiX f c = do
   config <- ask
   state <- get
-  (a, state') <- liftIO $ f $ runPhi config state . c
+  (a, state') <- liftIO $ f $ runPhiX config state . c
   put state'
   return a
 
@@ -73,13 +74,13 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
                          }
 
 
-initPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
-initPhi xconfig config widgets = do
+initPhiX :: Phi -> XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
+initPhiX phi xconfig config widgets = do
   disp <- openDisplay []
   atoms <- initAtoms disp
   selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask
   
-  runPhi PhiConfig { phiXConfig = xconfig, phiPanelConfig = config, phiDisplay = disp, phiAtoms = atoms } PhiState { phiRootPixmap = 0, phiPanels = [] } $ do
+  runPhiX PhiConfig { phiXConfig = xconfig, phiPanelConfig = config, phiDisplay = disp, phiAtoms = atoms } PhiState { phiRootPixmap = 0, phiPanels = [] } $ do
     updateRootPixmap
     
     screens <- liftIO $ phiXScreenInfo xconfig disp
@@ -92,7 +93,7 @@ initPhi xconfig config widgets = do
     
     updatePanels True
 
-    liftIOContToPhi allocaXEvent $ \xevent -> do
+    liftIOContToPhiX allocaXEvent $ \xevent -> do
       forever $ do
         liftIO $ nextEvent disp xevent
         event <- liftIO $ getEvent xevent
@@ -104,7 +105,7 @@ initPhi xconfig config widgets = do
   return ()
 
 
-updatePanels :: Bool -> Phi ()
+updatePanels :: Bool -> PhiX ()
 updatePanels redraw = do
   disp <- asks phiDisplay
   
@@ -134,7 +135,7 @@ updatePanels redraw = do
   modify $ \state -> state { phiPanels = panels' }
 
 
-handlePropertyUpdate :: Event -> Phi ()
+handlePropertyUpdate :: Event -> PhiX ()
 handlePropertyUpdate PropertyEvent { ev_atom = atom } = do
   atoms <- asks phiAtoms
   panels <- gets phiPanels
@@ -144,7 +145,7 @@ handlePropertyUpdate PropertyEvent { ev_atom = atom } = do
     updatePanels True
   
 
-updateRootPixmap :: Phi ()
+updateRootPixmap :: PhiX ()
 updateRootPixmap = do
   disp <- asks phiDisplay
   atoms <- asks phiAtoms
@@ -155,7 +156,7 @@ updateRootPixmap = do
   modify $ \state -> state { phiRootPixmap = pixmap }
 
 
-createPanel :: [Widget.Widget] -> Rectangle -> Phi PanelState
+createPanel :: [Widget.Widget] -> Rectangle -> PhiX PanelState
 createPanel widgets screenRect = do
   config <- asks phiPanelConfig
   disp <- asks phiDisplay
@@ -173,7 +174,7 @@ createPanel widgets screenRect = do
   
   return PanelState { panelWindow = win, panelGC = gc, panelPixmap = pixmap, panelSurface = surface, panelArea = rect, panelScreenArea = screenRect, panelWidgetStates = map Widget.createWidgetState widgets }
 
-createPanelWindow :: Rectangle -> Phi Window
+createPanelWindow :: Rectangle -> PhiX Window
 createPanelWindow rect = do
   disp <- asks phiDisplay
   let screen = defaultScreen disp
@@ -191,7 +192,7 @@ createPanelWindow rect = do
     withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr
 
 
-setPanelProperties :: PanelState -> Phi ()
+setPanelProperties :: PanelState -> PhiX ()
 setPanelProperties panel = do
   disp <- asks phiDisplay
   atoms <- asks phiAtoms
@@ -223,7 +224,7 @@ setPanelProperties panel = do
   setStruts panel
 
 
-setStruts :: PanelState -> Phi ()
+setStruts :: PanelState -> PhiX ()
 setStruts panel = do
   atoms <- asks phiAtoms
   disp <- asks phiDisplay