From 55d15b73caa4b8d74cf7d678842da69302e600d9 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Thu, 14 Jul 2011 00:09:20 +0200 Subject: Restructured widget state --- lib/Phi/Border.hs | 20 +++++++++++------ lib/Phi/Panel.hs | 66 ++++-------------------------------------------------- lib/Phi/Types.hs | 8 +++++++ lib/Phi/Widget.hs | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/Phi/X11.hs | 52 ++++++++++++++++++++++++------------------ phi.cabal | 2 +- src/Phi.hs | 5 +++-- 7 files changed, 126 insertions(+), 94 deletions(-) create mode 100644 lib/Phi/Types.hs create mode 100644 lib/Phi/Widget.hs diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index 42a0e8e..a110f2d 100644 --- a/lib/Phi/Border.hs +++ b/lib/Phi/Border.hs @@ -1,9 +1,12 @@ +{-# LANGUAGE TypeFamilies #-} + module Phi.Border ( BorderWidth(..) , simpleBorderWidth , border ) where -import Phi.Panel +import Phi.Types +import Phi.Widget import Graphics.Rendering.Cairo @@ -30,11 +33,14 @@ data Border = Border { margin :: !BorderWidth , backgroundColor :: !Color , cornerRadius :: !Double , borderWeight :: !Float - , content :: !Panel + , content :: ![Widget] } -instance PanelClass Border where - minSize border = minSize c + borderH p + 2*bw + borderH m +instance WidgetClass Border where + type WidgetData Border = () + initialState _ = () + + minSize border = sum (map (\(Widget w) -> minSize w) c) + borderH p + 2*bw + borderH m where m = margin border bw = borderWidth border @@ -43,7 +49,7 @@ instance PanelClass Border where weight border = borderWeight border - render border w h = do + render border _ w h = do newPath arc (x + width - radius) (y + radius) radius (-pi/2) 0 arc (x + width - radius) (y + height - radius) radius 0 (pi/2) @@ -73,5 +79,5 @@ instance PanelClass Border where (fr, fg, fb, fa) = backgroundColor border -border :: BorderWidth -> Int -> BorderWidth -> Color -> Color -> Double -> Float -> Panel -> Panel -border m bw p border bc cr w c = Panel $ Border m bw p border bc cr w c \ No newline at end of file +border :: BorderWidth -> Int -> BorderWidth -> Color -> Color -> Double -> Float -> [Widget] -> Widget +border m bw p border bc cr w c = Widget $ Border m bw p border bc cr w c \ No newline at end of file diff --git a/lib/Phi/Panel.hs b/lib/Phi/Panel.hs index d54124f..a31ffad 100644 --- a/lib/Phi/Panel.hs +++ b/lib/Phi/Panel.hs @@ -1,73 +1,15 @@ -{-# LANGUAGE ExistentialQuantification #-} - -module Phi.Panel ( Position(..) - , Color - , Panel(..) - , PanelClass(..) - , (<~>) - , PanelConfig(..) +module Phi.Panel ( PanelConfig(..) , defaultPanelConfig - , separator ) where -import Data.Function -import Data.Monoid - -import Graphics.Rendering.Cairo - - -data Position = Top | Bottom - -type Color = (Double, Double, Double, Double) - -class PanelClass a where - minSize :: a -> Int - - weight :: a -> Float - weight _ = 0 - - render :: a -> Int -> Int -> Render () - -data Panel = forall a. PanelClass a => Panel a | CompoundPanel [Panel] - -instance Monoid Panel where - mempty = CompoundPanel [] - mappend a b = makePanel $ (toList a) ++ (toList b) - where - toList (Panel p) = [Panel p] - toList (CompoundPanel panels) = panels - - makePanel [p] = p - makePanel panels = CompoundPanel panels - -instance PanelClass Panel where - minSize (Panel p) = minSize p - minSize (CompoundPanel panels) = sum $ map minSize panels - - weight (Panel p) = weight p - weight (CompoundPanel panels) = sum $ map weight panels - - render (Panel p) w h = render p w h - render (CompoundPanel panels) _ _ = return () - -(<~>) :: Panel -> Panel -> Panel -(<~>) = mappend +import Phi.Types +import Phi.Widget data PanelConfig = PanelConfig { panelPosition :: Position , panelSize :: Int - , panelContent :: Panel } defaultPanelConfig :: PanelConfig -defaultPanelConfig = PanelConfig { panelPosition = Top, panelSize = 24, panelContent = mempty } - -data Separator = Separator Int Float - -instance PanelClass Separator where - minSize (Separator s _) = s - weight (Separator _ w) = w - render (Separator _ _) _ _ = return () +defaultPanelConfig = PanelConfig { panelPosition = Top, panelSize = 24 } -separator :: Int -> Float -> Panel -separator s w = Panel $ Separator s w diff --git a/lib/Phi/Types.hs b/lib/Phi/Types.hs new file mode 100644 index 0000000..6e03918 --- /dev/null +++ b/lib/Phi/Types.hs @@ -0,0 +1,8 @@ +module Phi.Types ( Position(..) + , Color + ) where + + +data Position = Top | Bottom + +type Color = (Double, Double, Double, Double) diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs new file mode 100644 index 0000000..a4850e7 --- /dev/null +++ b/lib/Phi/Widget.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE ExistentialQuantification, TypeFamilies #-} + +module Phi.Widget ( Widget(..) + , WidgetClass(..) + , WidgetState(..) + , separator + , createWidgetState + , layoutWidgets + , renderWidgets + ) where + +import Control.Monad + +import Graphics.Rendering.Cairo + + +class WidgetClass a where + type WidgetData a :: * + + initialState :: a -> WidgetData a + + minSize :: a -> Int + + weight :: a -> Float + weight _ = 0 + + layout :: a -> Int -> Int -> WidgetData a + layout widget _ _ = initialState widget + + render :: a -> WidgetData a -> Int -> Int -> Render () + +data Widget = forall a. WidgetClass a => Widget a + +data WidgetState = forall a. WidgetClass a => WidgetState { stateWidget :: a + , stateWidth :: Int + , stateHeight :: Int + , statePrivateData :: WidgetData a + } + +createWidgetState :: Widget -> WidgetState +createWidgetState (Widget w) = WidgetState { stateWidget = w + , stateWidth = 0 + , stateHeight = 0 + , statePrivateData = initialState w + } + +layoutWidgets :: [WidgetState] -> Int -> Int -> [WidgetState] +layoutWidgets widgets w h = map layoutWidget widgets + where + layoutWidget state = state { stateWidth = w, stateHeight = h } + +renderWidgets :: [WidgetState] -> Render () +renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget, stateWidth = w, stateHeight = h, statePrivateData = priv } -> render widget priv w h + + +data Separator = Separator Int Float + +instance WidgetClass Separator where + type WidgetData Separator = () + initialState _ = () + + minSize (Separator s _) = s + weight (Separator _ w) = w + render _ _ _ _ = return () + +separator :: Int -> Float -> Widget +separator s w = Widget $ Separator s w diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index d272cb9..057d1ee 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -20,7 +20,9 @@ import Control.Monad.State import Control.Monad.Reader import Control.Monad.Trans +import qualified Phi.Types as Phi import qualified Phi.Panel as Panel +import qualified Phi.Widget as Widget import Phi.X11.Atoms import qualified Phi.Bindings.Util as Util @@ -31,12 +33,13 @@ data PhiState = PhiState { phiRootPixmap :: Pixmap , phiPanels :: [PanelState] } -data PanelState = PanelState { panelWindow :: Window - , panelGC :: GC - , panelPixmap :: Pixmap - , panelSurface :: Surface - , panelArea :: Rectangle - , panelScreenArea :: Rectangle +data PanelState = PanelState { panelWindow :: Window + , panelGC :: GC + , panelPixmap :: Pixmap + , panelSurface :: Surface + , panelArea :: Rectangle + , panelScreenArea :: Rectangle + , panelWidgetStates :: [Widget.WidgetState] } data PhiConfig = PhiConfig { phiPanelConfig :: Panel.PanelConfig @@ -70,8 +73,8 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo } -initPhi :: XConfig -> Panel.PanelConfig -> IO () -initPhi xconfig config = do +initPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO () +initPhi xconfig config widgets = do disp <- openDisplay [] atoms <- initAtoms disp selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask @@ -80,7 +83,7 @@ initPhi xconfig config = do updateRootPixmap screens <- liftIO $ phiXScreenInfo xconfig disp - panels <- mapM createPanel screens + panels <- mapM (createPanel widgets) screens forM_ panels $ \panel -> do setPanelProperties panel liftIO $ mapWindow disp (panelWindow panel) @@ -104,28 +107,34 @@ initPhi xconfig config = do updatePanels :: Bool -> Phi () updatePanels redraw = do disp <- asks phiDisplay - panelConfig <- asks phiPanelConfig rootPixmap <- gets phiRootPixmap panels <- gets phiPanels - forM_ panels $ \panel -> do - when redraw $ do + panels' <- forM panels $ \panel -> do + newPanel <- if not redraw then return panel else do let surface = panelSurface panel area = panelArea panel + layoutedWidgets = Widget.layoutWidgets (panelWidgetStates panel) (fromIntegral $ rect_width area) (fromIntegral $ rect_height area) + panel' = panel { panelWidgetStates = layoutedWidgets } + -- draw background liftIO $ withRectangle (panelArea panel) (copyArea disp rootPixmap (panelPixmap panel) (panelGC panel)) 0 0 surfaceMarkDirty surface renderWith surface $ do save - Panel.render (Panel.panelContent panelConfig) (fromIntegral $ rect_width area) (fromIntegral $ rect_height area) + Widget.renderWidgets layoutedWidgets restore surfaceFlush surface - + return panel' + -- copy pixmap to window liftIO $ withDimension (panelArea panel) (copyArea disp (panelPixmap panel) (panelWindow panel) (panelGC panel) 0 0) 0 0 + return newPanel + + modify $ \state -> state { phiPanels = panels' } handlePropertyUpdate :: Event -> Phi () @@ -149,8 +158,8 @@ updateRootPixmap = do modify $ \state -> state { phiRootPixmap = pixmap } -createPanel :: Rectangle -> Phi PanelState -createPanel screenRect = do +createPanel :: [Widget.Widget] -> Rectangle -> Phi PanelState +createPanel widgets screenRect = do config <- asks phiPanelConfig disp <- asks phiDisplay let rect = panelBounds config screenRect @@ -165,8 +174,7 @@ createPanel screenRect = do pixmap <- liftIO $ withDimension rect (createPixmap disp win) depth surface <- liftIO $ withDimension rect $ Util.createXlibSurface disp pixmap visual - return PanelState { panelWindow = win, panelGC = gc, panelPixmap = pixmap, panelSurface = surface, panelArea = rect, panelScreenArea = screenRect } - + return PanelState { panelWindow = win, panelGC = gc, panelPixmap = pixmap, panelSurface = surface, panelArea = rect, panelScreenArea = screenRect, panelWidgetStates = map Widget.createWidgetState widgets } createPanelWindow :: Rectangle -> Phi Window createPanelWindow rect = do @@ -241,8 +249,8 @@ setStruts panel = do makeBottomStruts _ = 0 makeStruts = case position of - Panel.Top -> makeTopStruts - Panel.Bottom -> makeBottomStruts + Phi.Top -> makeTopStruts + Phi.Bottom -> makeBottomStruts liftIO $ do changeProperty32 disp (panelWindow panel) (atom_NET_WM_STRUT atoms) cARDINAL propModeReplace $ take 4 struts @@ -251,8 +259,8 @@ setStruts panel = do panelBounds :: Panel.PanelConfig -> Rectangle -> Rectangle panelBounds config screenBounds = case Panel.panelPosition config of - Panel.Top -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config } - Panel.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config, + Phi.Top -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config } + Phi.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config, rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ Panel.panelSize config) } withRectangle :: (Num x, Num y, Num w, Num h) => Rectangle -> (x -> y -> w -> h -> a) -> a diff --git a/phi.cabal b/phi.cabal index 46746c4..b0ea062 100644 --- a/phi.cabal +++ b/phi.cabal @@ -12,7 +12,7 @@ build-type: Simple library build-depends: base >= 4, template-haskell, mtl, cairo, X11 - exposed-modules: Phi.Panel, Phi.Border, Phi.X11 + exposed-modules: Phi.Types, Phi.Panel, Phi.Widget, Phi.Border, Phi.X11 other-modules: Phi.X11.Atoms, Phi.X11.AtomList, Phi.Bindings.Util hs-source-dirs: lib diff --git a/src/Phi.hs b/src/Phi.hs index a3d4762..73beba8 100644 --- a/src/Phi.hs +++ b/src/Phi.hs @@ -1,3 +1,4 @@ +import Phi.Types import Phi.Panel import Phi.Border import Phi.X11 @@ -6,5 +7,5 @@ import Data.Monoid main :: IO () main = do - initPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom, panelContent = border (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.25, 0.25, 0.25, 0.5) 7 1 mempty } - --initPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom, panelContent = border (simpleBorderWidth 0) 0 (simpleBorderWidth 2) (1, 1, 1, 1) (0.75, 0.75, 0.75, 1) 0 1 mempty } + initPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom} + [border (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.25, 0.25, 0.25, 0.5) 7 1 []] -- cgit v1.2.3