1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
{-# LANGUAGE ExistentialQuantification, TypeFamilies, StandaloneDeriving, FlexibleContexts #-}
module Phi.Widget ( Widget(..)
, WidgetClass(..)
, WidgetState(..)
, separator
, createWidgetState
, layoutWidgets
, renderWidgets
) where
import Control.Monad
import Data.Traversable
import Graphics.Rendering.Cairo
class Show a => WidgetClass a where
type WidgetData a :: *
initialState :: a -> WidgetData a
minSize :: a -> Int
weight :: a -> Float
weight _ = 0
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, Show (WidgetData a)) => Widget a
deriving instance Show Widget
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 -> Int -> Int -> [WidgetState]
layoutWidgets widgets x y width height = snd $ mapAccumL layoutWidgetAndX x widgets
where
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
, 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 deriving Show
instance WidgetClass Separator where
type WidgetData Separator = ()
initialState _ = ()
minSize (Separator s _) = s
weight (Separator _ w) = w
render _ _ _ _ = return ()
separator :: Int -> Float -> Widget
separator s w = Widget $ Separator s w
|
