From b1402e8bd6a68a891b00a214d6cf184d66defe19 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Mon, 22 Sep 2003 13:16:55 +0000
Subject: Founding the newly structured GF2.0 cvs archive.

---
 src/GF/Fudgets/EventF.hs | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 src/GF/Fudgets/EventF.hs

(limited to 'src/GF/Fudgets/EventF.hs')

diff --git a/src/GF/Fudgets/EventF.hs b/src/GF/Fudgets/EventF.hs
new file mode 100644
index 000000000..cfcf3e401
--- /dev/null
+++ b/src/GF/Fudgets/EventF.hs
@@ -0,0 +1,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))
+
-- 
cgit v1.2.3