diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Phi/Border.hs | 2 | ||||
-rw-r--r-- | lib/Phi/Widgets/AlphaBox.hs | 49 |
2 files changed, 50 insertions, 1 deletions
diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index a025ab6..5a144df 100644 --- a/lib/Phi/Border.hs +++ b/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 diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs new file mode 100644 index 0000000..3ed31d0 --- /dev/null +++ b/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 + |