Added AlphaBox widget

lib/Phi/Border.hs

@@ -125,4 +125,4 @@ roundRectangle x y width height radius = do
   closePath
 
 border :: BorderConfig -> [Widget] -> Widget
-border config widgets = Widget $ Border config widgets
+border config = Widget . Border config

lib/Phi/Widgets/AlphaBox.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Phi.Widgets.AlphaBox ( alphaBox
+                            ) where
+
+import Phi.Types
+import Phi.Widget
+
+import Control.Monad
+
+import Graphics.Rendering.Cairo
+
+
+data AlphaBoxState = AlphaBoxState [WidgetState] deriving Show
+
+data AlphaBox = AlphaBox Double [Widget] deriving Show
+
+
+instance WidgetClass AlphaBox where
+  type WidgetData AlphaBox = AlphaBoxState
+  initWidget (AlphaBox _ widgets) phi disp = liftM AlphaBoxState $ mapM (createWidgetState phi disp) widgets
+  
+  minSize (AlphaBox _ _) (AlphaBoxState widgetStates) height =
+    sum (map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height) widgetStates)
+  
+  weight (AlphaBox _ widgets) = sum (map (\(Widget w) -> weight w) widgets)
+  
+  layout (AlphaBox _ _) (AlphaBoxState widgetStates) width height = AlphaBoxState $ layoutWidgets widgetStates 0 0 width height
+
+  render (AlphaBox alpha _) (AlphaBoxState widgetStates) w h screen = do
+    renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do
+      renderWith surface $ do
+        renderWidgets widgetStates screen
+        
+        setOperator OperatorDestIn
+        setSourceRGBA 0 0 0 alpha
+        paint
+      
+      withPatternForSurface surface setSource
+      paint
+        
+        
+    
+  handleMessage _ (AlphaBoxState widgetStates) m = AlphaBoxState $ handleMessageWidgets m widgetStates
+
+
+alphaBox :: Double -> [Widget] -> Widget
+alphaBox alpha = Widget . AlphaBox alpha
+

phi.cabal

@@ -13,7 +13,7 @@ build-type:          Simple
 library
   build-depends:     base >= 4, template-haskell, stm, array, containers, transformers, mtl, utf8-string, time, old-locale, X11, cairo, pango
   exposed-modules:   Phi.Types, Phi.Phi, Phi.Panel, Phi.Widget, Phi.Border, Phi.X11,
-                     Phi.Widgets.Clock, Phi.Widgets.Taskbar, Phi.Widgets.Systray
+                     Phi.Widgets.AlphaBox, Phi.Widgets.Clock, Phi.Widgets.Taskbar, Phi.Widgets.Systray
   other-modules:     Phi.X11.Atoms, Phi.X11.AtomList, Phi.Bindings.Util
   hs-source-dirs:    lib
   extra-libraries:   X11

src/Phi.hs

@@ -4,6 +4,7 @@ import Phi.Panel
 import Phi.Border
 import Phi.X11
 
+import Phi.Widgets.AlphaBox
 import Phi.Widgets.Clock
 import Phi.Widgets.Taskbar
 import Phi.Widgets.Systray
@@ -12,18 +13,18 @@ import Phi.Widgets.Systray
 main :: IO ()
 main = do
   runPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom }
-    [theTaskbar, brightBorder [theSystray], brightBorder [theClock]]
+    [alphaBox 0.9 [theTaskbar, brightBorder [theSystray], brightBorder [theClock]]]
     where
-      normalTaskBorder = BorderConfig (BorderWidth (-1) (-3) (-1) 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.8) (0.45, 0.45, 0.45, 1) 5 0
+      normalTaskBorder = BorderConfig (BorderWidth (-1) (-3) (-1) 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.8) (0.45, 0.45, 0.45, 0.8) 5 0
       activeTaskBorder = normalTaskBorder { borderColor = (1, 1, 1, 0.8)
                                           , backgroundColor = (0, 0, 0, 1)
                                           }
       normalDesktopBorder = normalTaskBorder { margin = BorderWidth 2 3 2 3
                                              , padding = BorderWidth 0 2 0 2
                                              , borderColor = (0.7, 0.7, 0.7, 0.8)
-                                             , backgroundColor = (1, 1, 1, 0.8)
+                                             , backgroundColor = (1, 1, 1, 0.9)
                                              }
-      currentDesktopBorder = normalDesktopBorder { backgroundColor = (0.2, 0.2, 0.2, 0.8)
+      currentDesktopBorder = normalDesktopBorder { backgroundColor = (0.2, 0.2, 0.2, 0.9)
                                                  }
       taskStyle = TaskStyle { taskFont = "Sans 7"
                             , taskColor = (1, 1, 1, 1)