{-# LANGUAGE MultiParamTypeClasses #-} module Phi.Widgets.AlphaBox ( alphaBox ) where import Phi.Types import Phi.Widget import Control.Monad import Graphics.Rendering.Cairo data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Eq data AlphaBox = AlphaBox !Double ![Widget] deriving (Show, Eq) instance WidgetClass AlphaBox AlphaBoxState where initWidget (AlphaBox _ widgets) phi disp = liftM AlphaBoxState $ mapM (createWidgetState phi disp) widgets minSize (AlphaBox _ _) (AlphaBoxState widgetStates) height screen = sum (map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height screen) widgetStates) weight (AlphaBox _ widgets) = sum (map (\(Widget w) -> weight w) widgets) layout (AlphaBox _ _) (AlphaBoxState widgetStates) width height screen = AlphaBoxState $ layoutWidgets widgetStates 0 0 width height screen render (AlphaBox alpha _) (AlphaBoxState widgetStates) x y w h screen = do renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do renderWith surface $ do renderWidgets widgetStates screen x y 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