diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Phi/Border.hs | 82 | ||||
| -rw-r--r-- | lib/Phi/Widget.hs | 2 |
2 files changed, 56 insertions, 28 deletions
diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs index 0e7fbdc..53f31a2 100644 --- a/lib/Phi/Border.hs +++ b/lib/Phi/Border.hs @@ -2,6 +2,8 @@ module Phi.Border ( BorderWidth(..) , simpleBorderWidth + , BorderConfig(..) + , defaultBorderConfig , border ) where @@ -26,30 +28,53 @@ borderH bw = borderLeft bw + borderRight bw borderV :: BorderWidth -> Int borderV bw = borderTop bw + borderBottom bw -data Border = Border { margin :: !BorderWidth - , borderWidth :: !Int - , padding :: !BorderWidth - , borderColor :: !Color - , backgroundColor :: !Color - , cornerRadius :: !Double - , borderWeight :: !Float - , content :: ![Widget] - } deriving Show +data BorderState = BorderState [WidgetState] deriving Show + +data BorderConfig = BorderConfig { margin :: !BorderWidth + , borderWidth :: !Int + , padding :: !BorderWidth + , borderColor :: !Color + , backgroundColor :: !Color + , cornerRadius :: !Double + , borderWeight :: !Float + } deriving Show + +defaultBorderConfig = BorderConfig { margin = simpleBorderWidth 0 + , borderWidth = 1 + , padding = simpleBorderWidth 1 + , borderColor = (0, 0, 0, 1) + , backgroundColor = (0, 0, 0, 0) + , cornerRadius = 0 + , borderWeight = 1 + } + +data Border = Border BorderConfig [Widget] deriving Show instance WidgetClass Border where - type WidgetData Border = () - initialState _ = () + type WidgetData Border = BorderState + initialState (Border _ widgets) = BorderState $ map createWidgetState widgets - minSize border = sum (map (\(Widget w) -> minSize w) c) + borderH p + 2*bw + borderH m + minSize (Border config widgets) = sum (map (\(Widget w) -> minSize w) widgets) + borderH p + 2*bw + borderH m where - m = margin border - bw = borderWidth border - p = padding border - c = content border + m = margin config + bw = borderWidth config + p = padding config - weight border = borderWeight border + weight (Border config _) = borderWeight config - render border _ w h = do + layout (Border config _) (BorderState widgetStates) width height = BorderState $ layoutWidgets widgetStates x y width' height' + 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) 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) @@ -63,21 +88,24 @@ instance WidgetClass Border where setSourceRGBA br bg bb ba setLineWidth $ fromIntegral bw stroke + restore + + renderWidgets widgetStates + where - m = margin border - bw = borderWidth border - p = padding border - c = content border - radius = cornerRadius border + m = margin config + bw = borderWidth config + p = padding config + radius = cornerRadius config x = (fromIntegral $ borderLeft m) + (fromIntegral bw)/2 y = (fromIntegral $ borderTop m) + (fromIntegral bw)/2 width = fromIntegral $ w - borderH m - bw height = fromIntegral $ h - borderV m - bw - (br, bg, bb, ba) = borderColor border - (fr, fg, fb, fa) = backgroundColor border + (br, bg, bb, ba) = borderColor config + (fr, fg, fb, fa) = backgroundColor config -border :: BorderWidth -> Int -> BorderWidth -> Color -> Color -> Double -> Float -> [Widget] -> Widget -border m bw p border bc cr w c = Widget $ Border m bw p border bc cr w c
\ No newline at end of file +border :: BorderConfig -> [Widget] -> Widget +border config widgets = Widget $ Border config widgets diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs index 5d924eb..9262aba 100644 --- a/lib/Phi/Widget.hs +++ b/lib/Phi/Widget.hs @@ -26,7 +26,7 @@ class Show a => WidgetClass a where weight _ = 0 layout :: a -> WidgetData a -> Int -> Int -> WidgetData a - layout widget priv _ _ = priv + layout _ priv _ _ = priv render :: a -> WidgetData a -> Int -> Int -> Render () |