diff options
Diffstat (limited to 'lib/Phi/Widget.hs')
| -rw-r--r-- | lib/Phi/Widget.hs | 54 |
1 files changed, 20 insertions, 34 deletions
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs index 68bed1b..791eff1 100644 --- a/lib/Phi/Widget.hs +++ b/lib/Phi/Widget.hs @@ -1,10 +1,9 @@ -{-# LANGUAGE ExistentialQuantification, StandaloneDeriving, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE ExistentialQuantification, StandaloneDeriving, DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances #-} module Phi.Widget ( Display(..) , withDisplay , getAtoms - , getScreenWindows - , getScreens + , XMessage(..) , unionArea , SurfaceSlice(..) , Widget(..) @@ -29,6 +28,7 @@ import Control.Monad.State.Strict hiding (lift) import Control.Monad.IO.Class import Data.Maybe +import Data.Typeable import qualified Graphics.X11.Xlib as Xlib import Graphics.Rendering.Cairo @@ -37,23 +37,19 @@ import Phi.Phi import Phi.X11.Atoms -data Display = Display !(MVar Xlib.Display) !Atoms ![(Xlib.Rectangle, Xlib.Window)] +data Display = Display !(MVar Xlib.Display) !Atoms withDisplay :: MonadIO m => Display -> (Xlib.Display -> m a) -> m a -withDisplay (Display dispvar _ _) f = do +withDisplay (Display dispvar _) f = do disp <- liftIO $ takeMVar dispvar a <- f disp liftIO $ putMVar dispvar disp return a getAtoms :: Display -> Atoms -getAtoms (Display _ atoms _) = atoms +getAtoms (Display _ atoms) = atoms -getScreenWindows :: Display -> [(Xlib.Rectangle, Xlib.Window)] -getScreenWindows (Display _ _ screenWindows) = screenWindows - -getScreens :: Display -> [Xlib.Rectangle] -getScreens = map fst . getScreenWindows +data XMessage = UpdateScreens [(Xlib.Rectangle, Xlib.Window)] deriving (Show, Typeable) unionArea :: Xlib.Rectangle -> Xlib.Rectangle -> Int @@ -75,7 +71,7 @@ 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 -> IO s + initWidget :: w -> Phi -> Display -> [(Xlib.Rectangle, Xlib.Window)] -> IO s initCache :: w -> c @@ -84,9 +80,6 @@ class Eq s => Widget w s c | w -> s, w -> c where weight :: w -> Float weight _ = 0 - layout :: w -> s -> Int -> Int -> Xlib.Rectangle -> s - layout _ priv _ _ _ = priv - render :: w -> s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT c IO [(Bool, SurfaceSlice)] handleMessage :: w -> s -> Message -> s @@ -125,43 +118,36 @@ renderCached widget state x y w h screen = do data CompoundWidget a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundWidget !a !b -data CompoundState a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundState !sa !sb !Int +data CompoundState a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundState !sa !sb deriving instance Eq (CompoundState a sa ca b sb cb) data CompoundCache a sa ca b sb cb = (Widget a sa ca, Widget b sb cb) => CompoundCache !ca !cb instance Widget (CompoundWidget a sa ca b sb cb) (CompoundState a sa ca b sb cb) (CompoundCache a sa ca b sb cb) where - initWidget (CompoundWidget a b) phi disp = liftM3 CompoundState (initWidget a phi disp) (initWidget b phi disp) (return 0) + initWidget (CompoundWidget a b) phi disp screens = liftM2 CompoundState (initWidget a phi disp screens) (initWidget b phi disp screens) initCache (CompoundWidget a b) = CompoundCache (initCache a) (initCache b) - minSize (CompoundWidget a b) (CompoundState da db _) height screen = minSize a da height screen + minSize b db height screen + minSize (CompoundWidget a b) (CompoundState da db) height screen = minSize a da height screen + minSize b db height screen weight (CompoundWidget a b) = weight' a + weight' b - layout c@(CompoundWidget a b) s@(CompoundState sa sb _) width height screen = CompoundState sa' sb' xb - where - sizesum = minSize c s height screen - wsum = let wsum = weight c - in if wsum > 0 then wsum else 1 + render c@(CompoundWidget a b) s@(CompoundState sa sb) x y w h screen = do + let sizesum = minSize c s h screen + wsum = let wsum = weight c + in if wsum > 0 then wsum else 1 + surplus = w - sizesum + xb = floor $ (fromIntegral $ minSize a sa h screen) + (fromIntegral surplus)*(weight' a)/wsum - surplus = width - sizesum - - (xb, sa') = layoutWidget a sa - (_, sb') = layoutWidget b sb - - layoutWidget w s = let wWidth = floor $ (fromIntegral $ minSize w s height screen) + (fromIntegral surplus)*(weight' w)/wsum - in (wWidth, layout w s wWidth height screen) - - render (CompoundWidget a b) (CompoundState sa sb xb) x y w h screen = do CompoundCache ca cb <- get + (surfacea, ca') <- liftIO $ flip runStateT ca $ render a sa x y xb h screen (surfaceb, cb') <- liftIO $ flip runStateT cb $ render b sb (x+xb) y (w-xb) h screen put $ CompoundCache ca' cb' return $ surfacea ++ map (\(updated, SurfaceSlice x surface) -> (updated, SurfaceSlice (x+xb) surface)) surfaceb - handleMessage (CompoundWidget a b) (CompoundState sa sb xb) message = CompoundState (handleMessage a sa message) (handleMessage b sb message) xb + handleMessage (CompoundWidget a b) (CompoundState sa sb) message = CompoundState (handleMessage a sa message) (handleMessage b sb message) weight' :: (Widget a sa ca) => a -> Float weight' = max 0 . weight @@ -172,7 +158,7 @@ a <~> b = CompoundWidget a b data Separator = Separator !Int !Float deriving (Show, Eq) instance Widget Separator () (RenderCache Separator ()) where - initWidget _ _ _ = return () + initWidget _ _ _ _ = return () initCache _ = createRenderCache $ \_ _ _ _ _ _ _ -> do setOperator OperatorClear paint |