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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
{-# LANGUAGE ExistentialQuantification, StandaloneDeriving, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies #-}
module Phi.Widget ( Display(..)
, withDisplay
, getAtoms
, getScreenWindows
, getScreens
, unionArea
, Widget(..)
, CompoundWidget
, (<~>)
, Separator
, separator
) where
import Control.Arrow
import Control.Arrow.Transformer
import Control.CacheArrow
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.IO.Class
import Data.Traversable hiding (forM)
import qualified Graphics.X11.Xlib as Xlib
import Graphics.Rendering.Cairo
import Phi.Phi
import Phi.X11.Atoms
data Display = Display !(MVar Xlib.Display) !Atoms ![(Xlib.Rectangle, Xlib.Window)]
withDisplay :: MonadIO m => Display -> (Xlib.Display -> m a) -> m a
withDisplay (Display dispvar _ _) f = do
disp <- liftIO $ takeMVar dispvar
a <- f disp
liftIO $ putMVar dispvar disp
return a
getAtoms :: Display -> Atoms
getAtoms (Display _ atoms _) = atoms
getScreenWindows :: Display -> [(Xlib.Rectangle, Xlib.Window)]
getScreenWindows (Display _ _ screenWindows) = screenWindows
getScreens :: Display -> [Xlib.Rectangle]
getScreens = map fst . getScreenWindows
unionArea :: Xlib.Rectangle -> Xlib.Rectangle -> Int
unionArea a b = fromIntegral $ uw*uh
where
uw = max 0 $ (min ax2 bx2) - (max ax1 bx1)
uh = max 0 $ (min ay2 by2) - (max ay1 by1)
Xlib.Rectangle ax1 ay1 aw ah = a
Xlib.Rectangle bx1 by1 bw bh = b
ax2 = ax1 + fromIntegral aw
ay2 = ay1 + fromIntegral ah
bx2 = bx1 + fromIntegral bw
by2 = by1 + fromIntegral bh
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
weight :: a -> Float
weight _ = 0
layout :: a -> d -> Int -> Int -> Xlib.Rectangle -> d
layout _ priv _ _ _ = priv
render :: a -> d -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> Render ()
handleMessage :: a -> d -> Message -> d
handleMessage _ priv _ = priv
{-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
setOperator OperatorClear
paint
setOperator OperatorOver
render widget state x y w h screen
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
(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
handleMessage (CompoundWidget a b) (CompoundState da db xb) message = CompoundState (handleMessage a da message) (handleMessage b db message) xb
weight' :: (Widget a da) => a -> Float
weight' = max 0 . weight
(<~>) :: (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)
instance Widget Separator () where
initWidget _ _ _ = return ()
minSize (Separator s _) _ _ _ = s
weight (Separator _ w) = w
render _ _ _ _ _ _ _ = return ()
separator :: Int -> Float -> Separator
separator = Separator
|
