neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added widget layout functions

Browse source
This commit is contained in:
Matthias Schiffer 2011-07-14 01:47:10 +02:00
parent 55d15b73ca
commit 222ba3fe0b
4 changed files with 56 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lib/Phi/Border.hs
View file

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

62
lib/Phi/Widget.hs
View file

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

7
lib/Phi/X11.hs
View file

@ -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'

6
src/Phi.hs
View file

@ -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 []