From d519f6781677aae2217aa895b25cbff61e1d0dbb Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Thu, 14 Jul 2011 02:21:26 +0200
Subject: Implemented border sub-layout and rendering

---
 lib/Phi/Border.hs | 82 +++++++++++++++++++++++++++++++++++++------------------
 lib/Phi/Widget.hs |  2 +-
 2 files changed, 56 insertions(+), 28 deletions(-)

(limited to 'lib')

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 ()
 
-- 
cgit v1.2.3