diff options
| author | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-07-14 20:21:30 +0200 |
|---|---|---|
| committer | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-07-14 20:21:30 +0200 |
| commit | 861fa81d8503b64023777ec815845361bbcc2885 (patch) | |
| tree | c194a5bbd4c839eb4ccf5b933d5abebcb3368385 /lib/Phi/Border.hs | |
| parent | 7c0f602343e84823d370c8742716ce6b7a8b9850 (diff) | |
| download | phi-861fa81d8503b64023777ec815845361bbcc2885.tar phi-861fa81d8503b64023777ec815845361bbcc2885.zip | |
Added clock widget
Diffstat (limited to 'lib/Phi/Border.hs')
| -rw-r--r-- | lib/Phi/Border.hs | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index 53f31a2..1994724 100644 --- a/lib/Phi/Border.hs +++ b/lib/Phi/Border.hs @@ -10,6 +10,8 @@ module Phi.Border ( BorderWidth(..) import Phi.Types import Phi.Widget +import Control.Monad + import Graphics.Rendering.Cairo @@ -52,7 +54,7 @@ data Border = Border BorderConfig [Widget] deriving Show instance WidgetClass Border where type WidgetData Border = BorderState - initialState (Border _ widgets) = BorderState $ map createWidgetState widgets + initWidget (Border _ widgets) phi disp = liftM BorderState $ mapM (createWidgetState phi disp) widgets minSize (Border config widgets) = sum (map (\(Widget w) -> minSize w) widgets) + borderH p + 2*bw + borderH m where @@ -74,7 +76,6 @@ instance WidgetClass Border where height' = height - borderV m - 2*bw - borderV p render (Border config _) (BorderState widgetStates) w h = do - save newPath arc (x + width - radius) (y + radius) radius (-pi/2) 0 arc (x + width - radius) (y + height - radius) radius 0 (pi/2) @@ -82,14 +83,16 @@ instance WidgetClass Border where arc (x + radius) (y + radius) radius pi (pi*3/2) closePath + save setSourceRGBA fr fg fb fa fillPreserve setSourceRGBA br bg bb ba setLineWidth $ fromIntegral bw - stroke + strokePreserve restore + clip renderWidgets widgetStates where @@ -105,6 +108,8 @@ instance WidgetClass Border where (br, bg, bb, ba) = borderColor config (fr, fg, fb, fa) = backgroundColor config + + handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates border :: BorderConfig -> [Widget] -> Widget |