Added widget layout functions

3 files changed, 51 insertions, 22 deletions

diff --git a/lib/Phi/Border.hs b/lib/Phi/Border.hs
index a110f2d..0e7fbdc 100644
--- a/lib/Phi/Border.hs
+++ b/lib/Phi/Border.hs
@@ -15,7 +15,7 @@ data BorderWidth = BorderWidth { borderTop    :: !Int
                                , borderRight  :: !Int
                                , borderBottom :: !Int
                                , borderLeft   :: !Int
-                               }
+                               } deriving Show
 
 simpleBorderWidth :: Int -> BorderWidth
 simpleBorderWidth w = BorderWidth w w w w
@@ -34,7 +34,7 @@ data Border = Border { margin          :: !BorderWidth
                      , cornerRadius    :: !Double
                      , borderWeight    :: !Float
                      , content         :: ![Widget]
-                     }
+                     } deriving Show
 
 instance WidgetClass Border where
   type WidgetData Border = ()
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index a4850e7..5d924eb 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, TypeFamilies #-}
+{-# LANGUAGE ExistentialQuantification, TypeFamilies, StandaloneDeriving, FlexibleContexts #-}
 
 module Phi.Widget ( Widget(..)
                   , WidgetClass(..)
@@ -10,11 +10,12 @@ module Phi.Widget ( Widget(..)
                   ) where
 
 import Control.Monad
+import Data.Traversable
 
 import Graphics.Rendering.Cairo
 
 
-class WidgetClass a where
+class Show a => WidgetClass a where
   type WidgetData a :: *
   
   initialState :: a -> WidgetData a
@@ -24,36 +25,67 @@ class WidgetClass a where
   weight :: a -> Float
   weight _ = 0
 
-  layout :: a -> Int -> Int -> WidgetData a
-  layout widget _ _ = initialState widget
+  layout :: a -> WidgetData a -> Int -> Int -> WidgetData a
+  layout widget priv _ _ = priv
   
   render :: a -> WidgetData a -> Int -> Int -> Render ()
 
-data Widget = forall a. WidgetClass a => Widget a
+data Widget = forall a. (WidgetClass a, Show (WidgetData a)) => Widget a
+deriving instance Show Widget
 
-data WidgetState = forall a. WidgetClass a => WidgetState { stateWidget      :: a
-                                                          , stateWidth       :: Int 
-                                                          , stateHeight      :: Int
-                                                          , statePrivateData :: WidgetData a
-                                                          }
+data WidgetState = forall a. (WidgetClass a, Show (WidgetData a)) => WidgetState { stateWidget      :: a
+                                                                                 , stateX           :: Int
+                                                                                 , stateY           :: Int
+                                                                                 , stateWidth       :: Int
+                                                                                 , stateHeight      :: Int
+                                                                                 , statePrivateData :: WidgetData a
+                                                                                 }
+deriving instance Show WidgetState
 
 createWidgetState :: Widget -> WidgetState
 createWidgetState (Widget w) = WidgetState { stateWidget = w
+                                           , stateX = 0
+                                           , stateY = 0
                                            , stateWidth = 0
                                            , stateHeight = 0
                                            , statePrivateData = initialState w
                                            }
 
-layoutWidgets :: [WidgetState] -> Int -> Int -> [WidgetState]
-layoutWidgets widgets w h = map layoutWidget widgets
+layoutWidgets :: [WidgetState] -> Int -> Int -> Int -> Int -> [WidgetState]
+layoutWidgets widgets x y width height = snd $ mapAccumL layoutWidgetAndX x widgets
   where
-    layoutWidget state = state { stateWidth = w, stateHeight = h }
+    sizesum = sum $ map (\(WidgetState {stateWidget = w} ) -> nneg . minSize $ w) widgets
+    wsum = let wsum = sum $ map (\(WidgetState {stateWidget = w} ) ->  nneg . weight $ w) widgets
+             in if wsum > 0 then wsum else 1
+    
+    surplus = width - sizesum
+    
+    layoutWidgetAndX wX state = let lw = layoutWidget wX state
+                                    in (wX + stateWidth lw, lw)
+    
+    layoutWidget wX state = case state of
+      WidgetState {stateWidget = w, statePrivateData = priv} ->
+        let wWidth = floor $ (fromIntegral $ minSize w) + (fromIntegral surplus)*(nneg $ weight w)/wsum
+            priv' = layout w priv wWidth height
+        in WidgetState { stateWidget = w, stateX = wX, stateY = y, stateWidth = wWidth, stateHeight = height, statePrivateData = priv' }
+    
+    nneg :: (Num a, Ord a) => a -> a
+    nneg x = max 0 x
 
 renderWidgets :: [WidgetState] -> Render ()
-renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget, stateWidth = w, stateHeight = h, statePrivateData = priv } -> render widget priv w h 
+renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget
+                                                     , stateX = x
+                                                     , stateY = y
+                                                     , stateWidth = w
+                                                     , stateHeight = h
+                                                     , statePrivateData = priv } -> do
+  save
+  translate (fromIntegral x) (fromIntegral y)
+  render widget priv w h
+  restore
 
 
-data Separator = Separator Int Float
+data Separator = Separator Int Float deriving Show
 
 instance WidgetClass Separator where
   type WidgetData Separator = ()
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 057d1ee..b79001c 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -115,17 +115,14 @@ updatePanels redraw = do
     newPanel <- if not redraw then return panel else do
       let surface = panelSurface panel
           area = panelArea panel
-          layoutedWidgets = Widget.layoutWidgets (panelWidgetStates panel) (fromIntegral $ rect_width area) (fromIntegral $ rect_height area)
+          layoutedWidgets = withDimension area $ Widget.layoutWidgets (panelWidgetStates panel) 0 0
           panel' = panel { panelWidgetStates = layoutedWidgets }
       
       -- draw background
       liftIO $ withRectangle (panelArea panel) (copyArea disp rootPixmap (panelPixmap panel) (panelGC panel)) 0 0
       surfaceMarkDirty surface
       
-      renderWith surface $ do
-        save
-        Widget.renderWidgets layoutedWidgets
-        restore
+      renderWith surface $ Widget.renderWidgets layoutedWidgets
       
       surfaceFlush surface
       return panel'