summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-07-14 02:21:26 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-07-14 02:21:26 +0200
commitd519f6781677aae2217aa895b25cbff61e1d0dbb (patch)
treecd261900a6657280318b3559f694d954310288d9
parent222ba3fe0be82341d6cf31de2f9d3387869f1b1a (diff)
downloadphi-d519f6781677aae2217aa895b25cbff61e1d0dbb.tar
phi-d519f6781677aae2217aa895b25cbff61e1d0dbb.zip
Implemented border sub-layout and rendering
-rw-r--r--lib/Phi/Border.hs82
-rw-r--r--lib/Phi/Widget.hs2
-rw-r--r--src/Phi.hs7
3 files changed, 60 insertions, 31 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 ()
diff --git a/src/Phi.hs b/src/Phi.hs
index 2128d38..cea4ecf 100644
--- a/src/Phi.hs
+++ b/src/Phi.hs
@@ -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