1 files changed, 48 insertions, 77 deletions
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index e4a1e6a..2b031d9 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -7,13 +7,10 @@ module Phi.Widget ( Display(..)
                   , getScreens
                   , unionArea
                   , Widget(..)
-                  , WidgetClass(..)
-                  , WidgetState(..)
+                  , CompoundWidget
+                  , (<~>)
+                  , Separator
                   , separator
-                  , createWidgetState
-                  , layoutWidgets
-                  , renderWidgets
-                  , handleMessageWidgets
                   ) where
 
 import Control.Arrow
@@ -67,7 +64,7 @@ unionArea a b = fromIntegral $ uw*uh
     by2 = by1 + fromIntegral bh
 
 
-class (Show a, Eq a, Eq d) => WidgetClass a d | a -> d where
+class (Show a, Eq a, Eq d) => Widget a d | a -> d where
   initWidget :: a -> Phi -> Display -> IO d
   
   minSize :: a -> d -> Int -> Xlib.Rectangle -> Int
@@ -83,26 +80,7 @@ class (Show a, Eq a, Eq d) => WidgetClass a d | a -> d where
   handleMessage :: a -> d -> Message -> d
   handleMessage _ priv _ = priv
 
-data Widget = forall a d. WidgetClass a d => Widget !a
-deriving instance Show Widget
-
-instance Eq Widget where
-  _ == _ = False
-
-data WidgetState = forall a d. WidgetClass a d =>
-                   WidgetState { stateWidget      :: !a
-                               , stateX           :: !Int
-                               , stateY           :: !Int
-                               , stateWidth       :: !Int
-                               , stateHeight      :: !Int
-                               , statePrivateData :: !d
-                               , stateRender      :: !(CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface)
-                               }
-
-instance Eq WidgetState where
-  _ == _ = False
-
-createStateRender :: WidgetClass a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface
+{-createStateRender :: Widget a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface
 createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do
   surface <- createImageSurface FormatARGB32 w h
   renderWith surface $ do
@@ -110,66 +88,59 @@ createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do
     paint
     setOperator OperatorOver
     render widget state x y w h screen
-  return surface
-
-createWidgetState :: Phi -> Display -> Widget -> IO WidgetState
-createWidgetState phi disp (Widget w) = do
-  priv <- initWidget w phi disp
-  return WidgetState { stateWidget = w
-                     , stateX = 0
-                     , stateY = 0
-                     , stateWidth = 0
-                     , stateHeight = 0
-                     , statePrivateData = priv
-                     , stateRender = createStateRender
-                     }
-
-layoutWidgets :: [WidgetState] -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> [WidgetState]
-layoutWidgets widgets x y width height screen = snd $ mapAccumL layoutWidgetAndX x widgets
-  where
-    sizesum = sum $ map (\(WidgetState {stateWidget = w, statePrivateData = priv} ) -> nneg $ minSize w priv height screen) widgets
-    wsum = let wsum = sum $ map (\(WidgetState {stateWidget = w} ) ->  nneg . weight $ w) widgets
+  return surface-}
+
+data CompoundWidget a da b db = (Widget a da, Widget b db) => CompoundWidget !a !b
+deriving instance Eq (CompoundWidget a da b db)
+deriving instance Show (CompoundWidget a da b db)
+
+data CompoundState a da b db = (Widget a da, Widget b db) => CompoundState !da !db !Int
+deriving instance Eq (CompoundState a da b db)
+
+instance Widget (CompoundWidget a da b db) (CompoundState a da b db) where
+  initWidget (CompoundWidget a b) phi disp = liftM3 CompoundState (initWidget a phi disp) (initWidget b phi disp) (return 0)
+  
+  minSize (CompoundWidget a b) (CompoundState da db _) height screen = minSize a da height screen + minSize b db height screen
+  
+  weight (CompoundWidget a b) = weight' a + weight' b
+
+  layout c@(CompoundWidget a b) d@(CompoundState da db _) width height screen = CompoundState da' db' xb
+    where
+      sizesum = minSize c d height screen
+      wsum = let wsum = weight c
              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, stateRender = render} ->
-        let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(nneg $ weight w)/wsum
-            priv' = layout w priv wWidth height screen
-        in WidgetState w wX y wWidth height priv' render
+      surplus = width - sizesum
+      
+      (xb, da') = layoutWidget a da
+      (_, db') = layoutWidget b db
+      
+      layoutWidget w priv = let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(weight' w)/wsum
+                            in (wWidth, layout w priv wWidth height screen)
+  
+  render (CompoundWidget a b) (CompoundState da db xb) x y w h screen = do
+    save
+    render a da x y xb h screen
+    restore
+    translate (fromIntegral xb) 0
+    render b db (x+xb) y (w-xb) h screen
     
-    nneg :: (Num a, Ord a) => a -> a
-    nneg x = max 0 x
+  handleMessage (CompoundWidget a b) (CompoundState da db xb) message = CompoundState (handleMessage a da message) (handleMessage b db message) xb
 
-renderWidgets :: [WidgetState] -> Xlib.Rectangle -> Int -> Int -> Render [WidgetState]
-renderWidgets widgets screen winX winY = forM widgets $ \(WidgetState widget x y w h priv render) -> do
-  (surface, render') <- liftIO $ runKleisli (runCache render) (widget, priv, winX+x, winY+y, w, h, screen)
-  
-  save
-  translate (fromIntegral x) (fromIntegral y)
-  withPatternForSurface surface setSource
-  paint
-  restore
-  
-  return $ WidgetState widget x y w h priv render'
+weight' :: (Widget a da) => a -> Float
+weight' = max 0 . weight
 
-handleMessageWidgets :: Message -> [WidgetState] -> [WidgetState]
-handleMessageWidgets message = map handleMessageWidget
-  where
-    handleMessageWidget (WidgetState w x y width height priv render) = WidgetState w x y width height (handleMessage w priv message) render
+(<~>) :: (Widget a da, Widget b db) => a -> b -> CompoundWidget a da b db
+a <~> b = CompoundWidget a b
 
-data Separator = Separator Int Float deriving (Show, Eq)
+data Separator = Separator !Int !Float deriving (Show, Eq)
 
-instance WidgetClass Separator () where
+instance Widget Separator () where
   initWidget _ _ _ = return ()
   
   minSize (Separator s _) _ _ _ = s
   weight (Separator _ w) = w
   render _ _ _ _ _ _ _ = return ()
 
-separator :: Int -> Float -> Widget
-separator s w = Widget $ Separator s w
+separator :: Int -> Float -> Separator
+separator = Separator