blob: 9c2ba19eef5a0a3351c632d6e0a95ac19bfa43a2 (
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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date $
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------
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))
|
