Implemented border sub-layout and rendering

This commit is contained in:
Matthias Schiffer 2011-07-14 02:21:26 +02:00
parent 222ba3fe0b
commit d519f67816
3 changed files with 60 additions and 31 deletions

View file

@ -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
border :: BorderConfig -> [Widget] -> Widget
border config widgets = Widget $ Border config widgets

View file

@ -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 ()

View file

@ -9,7 +9,8 @@ import Data.Monoid
main :: IO ()
main = do
initPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom}
[border1, border2]
[border border1 [border border3 [], border border3 []], border border2 []]
where
border1 = border (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.25, 0.25, 0.25, 0.5) 7 2 []
border2 = border (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.5, 0.0, 0.25, 0.5) 7 1 []
border1 = BorderConfig (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.25, 0.25, 0.25, 0.5) 7 2
border2 = BorderConfig (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.5, 0.0, 0.25, 0.5) 7 1
border3 = BorderConfig (simpleBorderWidth 0) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.0, 0.0, 0.5, 0.5) 3 1