summaryrefslogtreecommitdiffstats
path: root/lib/Phi
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-07-18 18:06:00 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-07-18 18:06:00 +0200
commit9d1415a2d35a10be828fac5c9534ba477233aa49 (patch)
tree414f188247778f8b8168ac0ced222f4dbccec264 /lib/Phi
parentfcb645e610d7e339ea23b9c719092c7fa77fbefb (diff)
downloadphi-9d1415a2d35a10be828fac5c9534ba477233aa49.tar
phi-9d1415a2d35a10be828fac5c9534ba477233aa49.zip
Added AlphaBox widget
Diffstat (limited to 'lib/Phi')
-rw-r--r--lib/Phi/Border.hs2
-rw-r--r--lib/Phi/Widgets/AlphaBox.hs49
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
+