Initial import.

darcs-hash:20070307013527-a5988-dc8444fae65e473dba691c38e2487cd2a3efe326

1 files changed, 48 insertions, 0 deletions

diff --git a/Thunk/Wm.hs b/Thunk/Wm.hs
new file mode 100644
index 0000000..69b1de1
--- /dev/null
+++ b/Thunk/Wm.hs
@@ -0,0 +1,48 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Thunk.Wm where
+
+import Data.Sequence
+import Control.Monad.State
+import System.IO (hFlush, hPutStrLn, stderr)
+import Graphics.X11.Xlib
+
+data WmState = WmState 
+                { display :: Display
+                , screenWidth :: Int
+                , screenHeight :: Int
+                , windows :: Seq Window
+                }
+
+newtype Wm a = Wm (StateT WmState IO a)
+    deriving (Monad, MonadIO{-, MonadState WmState-})
+
+runWm :: Wm a -> WmState -> IO (a, WmState)
+runWm (Wm m) = runStateT m
+
+l :: IO a -> Wm a
+l = liftIO
+
+trace msg = l $ do
+    hPutStrLn stderr msg
+    hFlush stderr
+
+withIO :: (forall b. (a -> IO b) -> IO b) -> (a -> Wm c) -> Wm c
+withIO f g = do
+    s <- Wm get
+    (y, s') <- l $ f $ \x -> runWm (g x) s
+    Wm (put s')
+    return y
+
+getDisplay = Wm (gets display)
+
+getWindows = Wm (gets windows)
+
+getScreenWidth = Wm (gets screenWidth)
+
+getScreenHeight = Wm (gets screenHeight)
+
+setWindows x = Wm (modify (\s -> s {windows = x}))
+
+modifyWindows :: (Seq Window -> Seq Window) -> Wm ()
+modifyWindows f = Wm (modify (\s -> s {windows = f (windows s)}))