From 50b87487a2a859fb1958bca605f66b47ea381c30 Mon Sep 17 00:00:00 2001
From: Spencer Janssen <sjanssen@cse.unl.edu>
Date: Wed, 7 Mar 2007 02:35:27 +0100
Subject: Initial import.

darcs-hash:20070307013527-a5988-dc8444fae65e473dba691c38e2487cd2a3efe326
---
 Thunk/Wm.hs | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 Thunk/Wm.hs

(limited to 'Thunk/Wm.hs')

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)}))
-- 
cgit v1.2.3