diff options
Diffstat (limited to 'lib/Phi/Widget.hs')
| -rw-r--r-- | lib/Phi/Widget.hs | 45 |
1 files changed, 25 insertions, 20 deletions
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) |