From 15d9304e052d2e5d4416e54a6fd24fbd0a252964 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Wed, 7 Sep 2011 16:38:36 +0200
Subject: Converted core to XHB/XCB

---
 lib/Phi/Widget.hs | 45 +++++++++++++++++++++++++--------------------
 1 file changed, 25 insertions(+), 20 deletions(-)

(limited to 'lib/Phi/Widget.hs')

diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index e3f8388..788abc2 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ExistentialQuantification, StandaloneDeriving, DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances #-}
 
-module Phi.Widget ( Display(..)
+module Phi.Widget ( XEvent(..)
+                  , Display(..)
                   , withDisplay
                   , getAtoms
                   , XMessage(..)
@@ -30,36 +31,38 @@ import Control.Monad.IO.Class
 import Data.Maybe
 import Data.Typeable
 
-import qualified Graphics.X11.Xlib as Xlib
+import Graphics.XHB
 import Graphics.Rendering.Cairo
 
 import Phi.Phi
 import Phi.X11.Atoms
 
 
-data Display = Display !(MVar Xlib.Display) !Atoms
+data Display = Display !Connection !Atoms
 
-withDisplay :: MonadIO m => Display -> (Xlib.Display -> m a) -> m a
-withDisplay (Display dispvar _) f = do
-  disp <- liftIO $ takeMVar dispvar
-  a <- f disp
-  liftIO $ putMVar dispvar disp
-  return a
+newtype XEvent = XEvent SomeEvent deriving Typeable
+
+instance Show XEvent where
+  show _ = "XEvent (..)"
+
+
+withDisplay :: MonadIO m => Display -> (Connection -> m a) -> m a
+withDisplay (Display conn _) f = f conn
 
 getAtoms :: Display -> Atoms
 getAtoms (Display _ atoms) = atoms
 
-data XMessage = UpdateScreens [(Xlib.Rectangle, Xlib.Window)] deriving (Show, Typeable)
+data XMessage = UpdateScreens [(RECTANGLE, WINDOW)] deriving (Show, Typeable)
 
 
-unionArea :: Xlib.Rectangle -> Xlib.Rectangle -> Int
+unionArea :: RECTANGLE -> RECTANGLE -> Int
 unionArea a b = fromIntegral $ uw*uh
   where
     uw = max 0 $ (min ax2 bx2) - (max ax1 bx1)
     uh = max 0 $ (min ay2 by2) - (max ay1 by1)
     
-    Xlib.Rectangle ax1 ay1 aw ah = a
-    Xlib.Rectangle bx1 by1 bw bh = b
+    MkRECTANGLE ax1 ay1 aw ah = a
+    MkRECTANGLE bx1 by1 bw bh = b
     
     ax2 = ax1 + fromIntegral aw
     ay2 = ay1 + fromIntegral ah
@@ -71,22 +74,24 @@ unionArea a b = fromIntegral $ uw*uh
 data SurfaceSlice = SurfaceSlice !Int !Surface
 
 class Eq s => Widget w s c | w -> s, w -> c where
-  initWidget :: w -> Phi -> Display -> [(Xlib.Rectangle, Xlib.Window)] -> IO s
+  initWidget :: w -> Phi -> Display -> [(RECTANGLE, WINDOW)] -> IO s
   
   initCache :: w -> c
   
-  minSize :: w -> s -> Int -> Xlib.Rectangle -> Int
+  minSize :: w -> s -> Int -> RECTANGLE -> Int
   
   weight :: w -> Float
   weight _ = 0
 
-  render :: w -> s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT c IO [(Bool, SurfaceSlice)]
+  render :: w -> s -> Int -> Int -> Int -> Int -> RECTANGLE -> StateT c IO [(Bool, SurfaceSlice)]
   
   handleMessage :: w -> s -> Message -> s
   handleMessage _ priv _ = priv
 
+deriving instance Eq RECTANGLE
+
 type IOCache = CacheArrow (Kleisli IO)
-type RenderCache s = IOCache (s, Int, Int, Int, Int, Xlib.Rectangle) Surface
+type RenderCache s = IOCache (s, Int, Int, Int, Int, RECTANGLE) Surface
 
 createIOCache :: Eq a => (a -> IO b) -> IOCache a b
 createIOCache = lift . Kleisli
@@ -98,8 +103,8 @@ runIOCache a = do
   put cache'
   return b
 
-createRenderCache :: (s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> Render ())
-                     -> CacheArrow (Kleisli IO) (s, Int, Int, Int, Int, Xlib.Rectangle) Surface
+createRenderCache :: (s -> Int -> Int -> Int -> Int -> RECTANGLE -> Render ())
+                     -> CacheArrow (Kleisli IO) (s, Int, Int, Int, Int, RECTANGLE) Surface
 createRenderCache f = lift . Kleisli $ \(state, x, y, w, h, screen) -> do
   surface <- createImageSurface FormatARGB32 w h
   renderWith surface $ do
@@ -109,7 +114,7 @@ createRenderCache f = lift . Kleisli $ \(state, x, y, w, h, screen) -> do
     f state x y w h screen
   return surface
 
-renderCached :: Eq s => s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT (RenderCache s) IO [(Bool, SurfaceSlice)]
+renderCached :: Eq s => s -> Int -> Int -> Int -> Int -> RECTANGLE -> StateT (RenderCache s) IO [(Bool, SurfaceSlice)]
 renderCached state x y w h screen = do
   cache <- get
   (surf, updated, cache') <- liftIO $ runKleisli (runCache' cache) (state, x, y, w, h, screen)
-- 
cgit v1.2.3