diff options
author | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-07-15 02:51:50 +0200 |
---|---|---|
committer | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-07-15 02:51:50 +0200 |
commit | c6e57070ab4ca1fdaddf816208aef24f38aecaba (patch) | |
tree | 778196ebcd31bbfd5c57c9acdfcfcd205a798920 /lib/Phi | |
parent | 7da8a9114eecc750a93087d0ec985641ca2a3165 (diff) | |
download | phi-c6e57070ab4ca1fdaddf816208aef24f38aecaba.tar phi-c6e57070ab4ca1fdaddf816208aef24f38aecaba.zip |
It's better not to lock in native code...
Diffstat (limited to 'lib/Phi')
-rw-r--r-- | lib/Phi/Phi.hs | 4 | ||||
-rw-r--r-- | lib/Phi/Widget.hs | 13 | ||||
-rw-r--r-- | lib/Phi/Widgets/Taskbar.hs | 3 | ||||
-rw-r--r-- | lib/Phi/X11.hs | 11 |
4 files changed, 16 insertions, 15 deletions
diff --git a/lib/Phi/Phi.hs b/lib/Phi/Phi.hs index 1fef39b..b517de6 100644 --- a/lib/Phi/Phi.hs +++ b/lib/Phi/Phi.hs @@ -5,6 +5,7 @@ module Phi.Phi ( Phi , DefaultMessage(..) , fromMessage , initPhi + , dupPhi , sendMessage , receiveMessage ) where @@ -26,6 +27,9 @@ fromMessage (Message m) = cast m initPhi :: IO Phi initPhi = liftM Phi newChan +dupPhi :: Phi -> IO Phi +dupPhi (Phi chan) = liftM Phi $ dupChan chan + sendMessage :: (Typeable a, Show a) => Phi -> a -> IO () sendMessage (Phi chan) = writeChan chan . Message diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs index e0d051b..9534c8c 100644 --- a/lib/Phi/Widget.hs +++ b/lib/Phi/Widget.hs @@ -12,24 +12,24 @@ module Phi.Widget ( Display(..) , handleMessageWidgets ) where +import Control.Concurrent.MVar import Control.Monad import Data.Traversable import qualified Graphics.X11.Xlib - import Graphics.Rendering.Cairo import Phi.Phi -newtype Display = Display Graphics.X11.Xlib.Display +newtype Display = Display (MVar Graphics.X11.Xlib.Display) withDisplay :: Display -> (Graphics.X11.Xlib.Display -> IO a) -> IO a -withDisplay (Display disp) f = do - Graphics.X11.Xlib.lockDisplay disp +withDisplay (Display dispvar) f = do + disp <- takeMVar dispvar a <- f disp - Graphics.X11.Xlib.unlockDisplay disp + putMVar dispvar disp return a @@ -65,7 +65,8 @@ deriving instance Show WidgetState createWidgetState :: Phi -> Display -> Widget -> IO WidgetState createWidgetState phi disp (Widget w) = do - priv <- initWidget w phi disp + phi' <- dupPhi phi + priv <- initWidget w phi' disp return WidgetState { stateWidget = w , stateX = 0 , stateY = 0 diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index 1b86ffd..a32c5d2 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -38,9 +38,6 @@ instance WidgetClass Taskbar where type WidgetData Taskbar = TaskbarState initWidget (Taskbar _) phi dispvar = do - --withMVar dispvar $ \disp -> - - -- return () return TaskbarState diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 56293ef..4332352 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -64,10 +64,10 @@ runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState) runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st withDisplayX :: Widget.Display -> (Display -> PhiX a) -> PhiX a -withDisplayX (Widget.Display disp) f = do - liftIO $ lockDisplay disp +withDisplayX (Widget.Display dispvar) f = do + disp <- liftIO $ takeMVar dispvar a <- f disp - liftIO $ unlockDisplay disp + liftIO $ putMVar dispvar disp return a defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo @@ -76,10 +76,9 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo runPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO () runPhi xconfig config widgets = do - initThreads phi <- initPhi disp <- openDisplay [] - + atoms <- initAtoms disp selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask @@ -89,7 +88,7 @@ runPhi xconfig config widgets = do screens <- liftIO $ phiXScreenInfo xconfig disp - let dispvar = Widget.Display disp + dispvar <- liftM Widget.Display $ liftIO $ newMVar disp widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets withDisplayX dispvar $ \disp -> do |