diff options
Diffstat (limited to 'lib/Phi/Border.hs')
| -rw-r--r-- | lib/Phi/Border.hs | 43 |
1 files changed, 24 insertions, 19 deletions
diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index 01dea44..c9b582e 100644 --- a/lib/Phi/Border.hs +++ b/lib/Phi/Border.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, ExistentialQuantification, FlexibleInstances #-} module Phi.Border ( BorderWidth(..) , simpleBorderWidth @@ -8,6 +8,7 @@ module Phi.Border ( BorderWidth(..) , defaultBorderConfig , drawBorder , roundRectangle + , Border , border ) where @@ -34,8 +35,6 @@ borderH bw = borderLeft bw + borderRight bw borderV :: BorderWidth -> Int borderV bw = borderTop bw + borderBottom bw -data BorderState = BorderState ![WidgetState] deriving Eq - data BorderConfig = BorderConfig { margin :: !BorderWidth , borderWidth :: !Int , padding :: !BorderWidth @@ -54,17 +53,19 @@ defaultBorderConfig = BorderConfig { margin = simpleBorderWidth 0 , borderWeight = 1 } -data Border = Border !BorderConfig ![Widget] deriving (Show, Eq) +data Border w d = (Widget w d) => Border !BorderConfig !w +deriving instance Show (Border w d) +deriving instance Eq (Border w d) -instance WidgetClass Border BorderState where - initWidget (Border _ widgets) phi disp = liftM BorderState $ mapM (createWidgetState phi disp) widgets +instance Eq d => Widget (Border w d) d where + initWidget (Border _ w) = initWidget w - minSize (Border config _) (BorderState widgetStates) height screen = + minSize (Border config w) d height screen = case True of _ | childSize == 0 -> 0 | otherwise -> max (borderH m+2*(bw+cr)) (childSize + borderH p + 2*bw + borderH m) where - childSize = sum $ map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height' screen) widgetStates + childSize = minSize w d height' screen m = margin config bw = borderWidth config @@ -74,30 +75,34 @@ instance WidgetClass Border BorderState where weight (Border config _) = borderWeight config - layout (Border config _) (BorderState widgetStates) width height screen = case True of - _ | width' > 0 -> BorderState $ layoutWidgets widgetStates x y width' height' screen - | otherwise -> BorderState widgetStates + layout (Border config w) d width height screen = case True of + _ | width' > 0 -> layout w d width' height' screen + | otherwise -> d where m = margin config bw = borderWidth config p = padding config - x = borderLeft m + bw + borderLeft p - y = borderTop m + bw + borderTop p width' = width - borderH m - 2*bw - borderH p height' = height - borderV m - 2*bw - borderV p - render (Border config _) (BorderState widgetStates) x y w h screen = when (w > borderH m - 2*bw - borderH p) $ do - drawBorder config 0 0 w h + render (Border config w) d x y width height screen = when (width > borderH m - 2*bw - borderH p) $ do + drawBorder config 0 0 width height clip - renderWidgets widgetStates screen x y + translate (fromIntegral dx) (fromIntegral dy) + render w d (x+dx) (y+dy) width' height' screen return () where m = margin config bw = borderWidth config p = padding config + + dx = borderLeft m + bw + borderLeft p + dy = borderTop m + bw + borderTop p + width' = width - borderH m - 2*bw - borderH p + height' = height - borderV m - 2*bw - borderV p - handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates + handleMessage (Border _ w) = handleMessage w drawBorder :: BorderConfig -> Int -> Int -> Int -> Int -> Render () drawBorder config dx dy w h = do @@ -134,5 +139,5 @@ roundRectangle x y width height radius = do arc (x + radius) (y + radius) radius pi (pi*3/2) closePath -border :: BorderConfig -> [Widget] -> Widget -border config = Widget . Border config +border :: (Widget w d) => BorderConfig -> w -> Border w d +border = Border |