Implemented border sub-layout and rendering
This commit is contained in:
parent
222ba3fe0b
commit
d519f67816
3 changed files with 60 additions and 31 deletions
|
@ -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
|
||||
data BorderState = BorderState [WidgetState] deriving Show
|
||||
|
||||
data BorderConfig = BorderConfig { margin :: !BorderWidth
|
||||
, borderWidth :: !Int
|
||||
, padding :: !BorderWidth
|
||||
, borderColor :: !Color
|
||||
, backgroundColor :: !Color
|
||||
, cornerRadius :: !Double
|
||||
, borderWeight :: !Float
|
||||
, content :: ![Widget]
|
||||
} 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
|
||||
|
|
|
@ -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 ()
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Reference in a new issue