Added widget layout functions

1 files changed, 47 insertions, 15 deletions

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 = ()