neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implemented border sub-layout and rendering

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

82
lib/Phi/Border.hs
View file

@ -2,6 +2,8 @@
module Phi.Border ( BorderWidth(..) module Phi.Border ( BorderWidth(..)
, simpleBorderWidth , simpleBorderWidth
, BorderConfig(..)
, defaultBorderConfig
, border , border
) where ) where
@ -26,30 +28,53 @@ borderH bw = borderLeft bw + borderRight bw
borderV :: BorderWidth -> Int borderV :: BorderWidth -> Int
borderV bw = borderTop bw + borderBottom bw borderV bw = borderTop bw + borderBottom bw
data Border = Border { margin :: !BorderWidth data BorderState = BorderState [WidgetState] deriving Show
, borderWidth :: !Int
, padding :: !BorderWidth data BorderConfig = BorderConfig { margin :: !BorderWidth
, borderColor :: !Color , borderWidth :: !Int
, backgroundColor :: !Color , padding :: !BorderWidth
, cornerRadius :: !Double , borderColor :: !Color
, borderWeight :: !Float , backgroundColor :: !Color
, content :: ![Widget] , cornerRadius :: !Double
} deriving Show , 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 instance WidgetClass Border where
type WidgetData Border = () type WidgetData Border = BorderState
initialState _ = () 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 where
m = margin border m = margin config
bw = borderWidth border bw = borderWidth config
p = padding border p = padding config
c = content border
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 newPath
arc (x + width - radius) (y + radius) radius (-pi/2) 0 arc (x + width - radius) (y + radius) radius (-pi/2) 0
arc (x + width - radius) (y + height - radius) radius 0 (pi/2) arc (x + width - radius) (y + height - radius) radius 0 (pi/2)
@ -63,21 +88,24 @@ instance WidgetClass Border where
setSourceRGBA br bg bb ba setSourceRGBA br bg bb ba
setLineWidth $ fromIntegral bw setLineWidth $ fromIntegral bw
stroke stroke
restore
renderWidgets widgetStates
where where
m = margin border m = margin config
bw = borderWidth border bw = borderWidth config
p = padding border p = padding config
c = content border radius = cornerRadius config
radius = cornerRadius border
x = (fromIntegral $ borderLeft m) + (fromIntegral bw)/2 x = (fromIntegral $ borderLeft m) + (fromIntegral bw)/2
y = (fromIntegral $ borderTop m) + (fromIntegral bw)/2 y = (fromIntegral $ borderTop m) + (fromIntegral bw)/2
width = fromIntegral $ w - borderH m - bw width = fromIntegral $ w - borderH m - bw
height = fromIntegral $ h - borderV m - bw height = fromIntegral $ h - borderV m - bw
(br, bg, bb, ba) = borderColor border (br, bg, bb, ba) = borderColor config
(fr, fg, fb, fa) = backgroundColor border (fr, fg, fb, fa) = backgroundColor config
border :: BorderWidth -> Int -> BorderWidth -> Color -> Color -> Double -> Float -> [Widget] -> Widget border :: BorderConfig -> [Widget] -> Widget
border m bw p border bc cr w c = Widget $ Border m bw p border bc cr w c border config widgets = Widget $ Border config widgets

2
lib/Phi/Widget.hs
View file

@ -26,7 +26,7 @@ class Show a => WidgetClass a where
weight _ = 0 weight _ = 0
layout :: a -> WidgetData a -> Int -> Int -> WidgetData a layout :: a -> WidgetData a -> Int -> Int -> WidgetData a
layout widget priv _ _ = priv layout _ priv _ _ = priv
render :: a -> WidgetData a -> Int -> Int -> Render () render :: a -> WidgetData a -> Int -> Int -> Render ()

7
src/Phi.hs
View file

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