blob: cfcf3e401c2d8bf0f55e597d425c14bab26af9fe (
plain)
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
|
module EventF where
import AllFudgets
-- The first string is the name of the key (e.g., "Down" for the down arrow key)
-- The modifiers list shift, control and alt keys that were active while the
-- key was pressed.
-- The last string is the text produced by the key (for keys that produce
-- printable characters, empty for control keys).
type KeyPress = ((String,[Modifiers]),String)
keyboardF :: F i o -> F i (Either KeyPress o)
keyboardF fud = idRightSP (concatMapSP post) >^^=< oeventF mask fud
where
post (KeyEvent {type'=Pressed,keySym=sym,state=mods,keyLookup=s}) =
[((sym,mods),s)]
post _ = []
mask = [KeyPressMask,
EnterWindowMask, LeaveWindowMask -- because of CTT implementation
]
-- Output events:
oeventF em fud = eventF em (idLeftF fud)
-- Feed events to argument fudget:
eventF eventmask = serCompLeftToRightF . groupF startcmds eventK
where
startcmds = [XCmd $ ChangeWindowAttributes [CWEventMask eventmask],
XCmd $ ConfigureWindow [CWBorderWidth 0]]
eventK = K $ mapFilterSP route
where route = message low high
low (XEvt event) = Just (High (Left event))
low _ = Nothing
high h = Just (High (Right h))
|
