summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/Phi/Border.hs4
-rw-r--r--lib/Phi/Widget.hs62
-rw-r--r--lib/Phi/X11.hs7
-rw-r--r--src/Phi.hs6
4 files changed, 56 insertions, 23 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'
diff --git a/src/Phi.hs b/src/Phi.hs
index 73beba8..2128d38 100644
--- a/src/Phi.hs
+++ b/src/Phi.hs
@@ -1,4 +1,5 @@
import Phi.Types
+import Phi.Widget
import Phi.Panel
import Phi.Border
import Phi.X11
@@ -8,4 +9,7 @@ import Data.Monoid
main :: IO ()
main = do
initPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom}
- [border (simpleBorderWidth 1) 1 (simpleBorderWidth 2) (1, 1, 1, 0.5) (0.25, 0.25, 0.25, 0.5) 7 1 []]
+ [border1, 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 []