module BubbleF(bubbleF, bubblePopupF, bubbleRootPopupF) where
import Command
import XDraw
import CompOps((>=^<), (>^=<))
import Dlayout(groupF)
import Event
import Fudget(F)
import FRequest
import NullF()
import Gc
import Geometry(origin,pP,Point(..),psub,padd)
import LayoutRequest(LayoutResponse(..))
import Message(Message(..))
import PopupGroupF
import Spacer(sepF)
import ShapeK
import MapstateK
import EitherUtils(stripEither)
import Xtypes
default(Int)
F b2 d2
f =
forall {b1} {d1} {b2} {d2}.
(Size -> Size, [WindowAttributes], K b1 d1)
-> F b2 d2 -> F (PopupMsg b2) d2
popupGroupF (Size -> Size
bubbleOffset, [WindowAttributes]
wattrs, forall {hi} {ho}. K hi ho
bubbleShapeK) (forall a b. F a b -> F a b
bubbleF F b2 d2
f)
F b2 d2
f =
forall {b1} {d1} {b2} {d2}.
(Size -> Size, [WindowAttributes], K b1 d1)
-> F b2 d2 -> F (PopupMsg b2) d2
rootPopupF (Size -> Size
bubbleOffset, [WindowAttributes]
rwattrs, forall {hi} {ho}. K hi ho
bubbleShapeK) (forall a b. F a b -> F a b
bubbleF F b2 d2
f)
bubbleF :: (F a b) -> F a b
bubbleF :: forall a b. F a b -> F a b
bubbleF F a b
f =
let startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs]
in forall {a}. Either a a -> a
stripEither forall a b e. (a -> b) -> F e a -> F e b
>^=<
forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds forall {hi} {ho}. K hi ho
bubbleShapeK (forall {a} {b}. Size -> F a b -> F a b
sepF Size
sep F a b
f) forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. b -> Either a b
Right
wattrs :: [WindowAttributes]
wattrs = [[EventMask] -> WindowAttributes
CWEventMask [EventMask
ExposureMask]]
rwattrs :: [WindowAttributes]
rwattrs = Bool -> WindowAttributes
CWOverrideRedirect Bool
Trueforall a. a -> [a] -> [a]
:[WindowAttributes]
wattrs
bubbleShapeK :: K hi ho
bubbleShapeK =
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. Width -> GCAttributes a b
GCLineWidth Width
2] forall a b. (a -> b) -> a -> b
$
forall a b. (Size -> [DrawCommand]) -> K a b -> K a b
shapeK Size -> [DrawCommand]
fillBubble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {hi} {ho}. GCId -> K hi ho
bubbleK
bubbleK :: GCId -> K hi ho
bubbleK GCId
gc =
let bubbleT :: Size -> Message FResponse b -> (Size, [Message FRequest b])
bubbleT state :: Size
state@Size
size Message FResponse b
msg =
case Message FResponse b
msg of
Low (LEvt (LayoutSize Size
size')) -> (Size
size', [])
Low (XEvt (Expose Rect
_ Width
0)) ->
(Size
state, if Size
size forall a. Eq a => a -> a -> Bool
== Size
origin
then []
else [forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ GCId -> DrawCommand -> FRequest
wDraw GCId
gc (Size -> DrawCommand
drawBubble (Size
sizeforall a. Num a => a -> a -> a
-Size
1))])
Message FResponse b
_ -> (Size
state, [])
in forall {t} {hi} {ho}.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK forall {b} {b}.
Size -> Message FResponse b -> (Size, [Message FRequest b])
bubbleT Size
origin
drawBubble :: Size -> DrawCommand
drawBubble Size
size = CoordMode -> [Size] -> DrawCommand
DrawLines CoordMode
CoordModeOrigin (Size -> [Size]
bubblePoints Size
size)
fillBubble :: Size -> [DrawCommand]
fillBubble Size
size = [Shape -> CoordMode -> [Size] -> DrawCommand
FillPolygon Shape
Convex CoordMode
CoordModeOrigin (Size -> [Size]
bubblePoints Size
size)]
c :: Width
c = Width
4
ah :: Width
ah = Width
12
ax :: Width
ax = Width
12
aw :: Width
aw = Width
6
atx :: Width
atx = Width
6
bubbleBorder :: Width
bubbleBorder = Width
ah forall a. Num a => a -> a -> a
+ Width
c
sep :: Size
sep = Width -> Width -> Size
pP (Width
2 forall a. Num a => a -> a -> a
* Width
c) (Width
2 forall a. Num a => a -> a -> a
* Width
c forall a. Num a => a -> a -> a
+ Width
bubbleBorder)
bubbleOffset :: Size -> Size
bubbleOffset (Point Width
_ Width
h) = Width -> Width -> Size
Point Width
atx (Width
h forall a. Num a => a -> a -> a
- Width
c)
bubblePoints :: Size -> [Size]
bubblePoints Size
size =
let Point Width
w Width
h = Size -> Size -> Size
psub Size
size (Width -> Width -> Size
pP Width
0 (Width
2 forall a. Num a => a -> a -> a
* Width
bubbleBorder))
in forall a b. (a -> b) -> [a] -> [b]
map (Size -> Size -> Size
padd (Width -> Width -> Size
pP Width
0 Width
bubbleBorder))
[Width -> Width -> Size
pP Width
c Width
0,
Width -> Width -> Size
pP (Width
w forall a. Num a => a -> a -> a
- Width
c) Width
0,
Width -> Width -> Size
pP Width
w Width
c,
Width -> Width -> Size
pP Width
w (Width
h forall a. Num a => a -> a -> a
- Width
c),
Width -> Width -> Size
pP (Width
w forall a. Num a => a -> a -> a
- Width
c) Width
h,
Width -> Width -> Size
pP (Width
ax forall a. Num a => a -> a -> a
+ Width
aw) Width
h,
Width -> Width -> Size
pP Width
atx (Width
h forall a. Num a => a -> a -> a
+ Width
ah),
Width -> Width -> Size
pP Width
ax Width
h,
Width -> Width -> Size
pP Width
c Width
h,
Width -> Width -> Size
pP Width
0 (Width
h forall a. Num a => a -> a -> a
- Width
c),
Width -> Width -> Size
pP Width
0 Width
c,
Width -> Width -> Size
pP Width
c Width
0]