From 79915057437b92095ed44667c269c8650a77a298 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 30 Oct 2019 13:21:06 +0100
Subject: Add GdkEvent and KeyPressHandler

---
 src/Gdk/Events.dcl   |  9 +++++++++
 src/Gdk/Events.icl   | 13 +++++++++++++
 src/Gdk/Internal.dcl | 10 ++++++++++
 src/Gdk/Internal.icl | 44 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 76 insertions(+)
 create mode 100644 src/Gdk/Events.dcl
 create mode 100644 src/Gdk/Events.icl
 create mode 100644 src/Gdk/Internal.dcl
 create mode 100644 src/Gdk/Internal.icl

(limited to 'src/Gdk')

diff --git a/src/Gdk/Events.dcl b/src/Gdk/Events.dcl
new file mode 100644
index 0000000..e3d5bd7
--- /dev/null
+++ b/src/Gdk/Events.dcl
@@ -0,0 +1,9 @@
+definition module Gdk.Events
+
+from StdMaybe import :: Maybe
+
+from System._Pointer import :: Pointer
+
+:: GdkEvent =: GdkEvent Pointer
+
+getKeyvalName :: !GdkEvent -> Maybe String
diff --git a/src/Gdk/Events.icl b/src/Gdk/Events.icl
new file mode 100644
index 0000000..58ca045
--- /dev/null
+++ b/src/Gdk/Events.icl
@@ -0,0 +1,13 @@
+implementation module Gdk.Events
+
+import StdEnv
+import StdMaybe
+
+import Data.Functor
+import Data.Maybe
+import System._Pointer
+
+import Gdk.Internal
+
+getKeyvalName :: !GdkEvent -> Maybe String
+getKeyvalName (GdkEvent ev) = gdk_keyval_name <$> gdk_event_get_keyval ev
diff --git a/src/Gdk/Internal.dcl b/src/Gdk/Internal.dcl
new file mode 100644
index 0000000..ccc157e
--- /dev/null
+++ b/src/Gdk/Internal.dcl
@@ -0,0 +1,10 @@
+definition module Gdk.Internal
+
+from StdMaybe import :: Maybe
+
+from System._Pointer import :: Pointer
+
+gdk_event_get_keyval :: !Pointer -> Maybe Int
+
+gdk_keyval_from_name :: !String -> Int
+gdk_keyval_name :: !Int -> String
diff --git a/src/Gdk/Internal.icl b/src/Gdk/Internal.icl
new file mode 100644
index 0000000..a922d84
--- /dev/null
+++ b/src/Gdk/Internal.icl
@@ -0,0 +1,44 @@
+implementation module Gdk.Internal
+
+import StdEnv
+import StdMaybe
+
+import System._Pointer
+
+gdk_event_get_keyval :: !Pointer -> Maybe Int
+gdk_event_get_keyval event
+	# arr = {#0}
+	# ok = get event (get_array_pointer arr)
+	| ok
+		= Just (arr.[0])
+		= Nothing
+where
+	get :: !Pointer !Pointer -> Bool
+	get _ _ = code {
+		ccall gdk_event_get_keyval "pp:I"
+	}
+
+gdk_keyval_from_name :: !String -> Int
+gdk_keyval_from_name name = get (packString name)
+where
+	get :: !String -> Int
+	get _ = code {
+		ccall gdk_keyval_from_name "s:I"
+	}
+
+gdk_keyval_name :: !Int -> String
+gdk_keyval_name keyval = derefString (get keyval)
+where
+	get :: !Pointer -> Pointer
+	get _ = code {
+		ccall gdk_keyval_name "p:p"
+	}
+
+get_array_pointer :: !{#Int} -> Pointer
+get_array_pointer arr = get arr + IF_INT_64_OR_32 24 12
+where
+	get :: !{#Int} -> Pointer
+	get _ = code {
+		push_a_b 0
+		pop_a 1
+	}
-- 
cgit v1.2.3