Add Gdk/Input-events

diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd
index 80ccca8..d01a233 100644 (file)
--- a/gdk/cl-gtk2-gdk.asd
+++ b/gdk/cl-gtk2-gdk.asd
@@ -25,5 +25,6 @@
                (:file "gdk.events")
                (:file "gdk.key-values")
                (:file "gdk.selections")
-               (:file "gdk.drag-and-drop"))
+               (:file "gdk.drag-and-drop")
+               (:file "gdk.input-devices"))
   :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango))
\ No newline at end of file

diff --git a/gdk/gdk.input-devices.lisp b/gdk/gdk.input-devices.lisp
new file mode 100644 (file)
index 0000000..38b20e6
--- /dev/null
+++ b/gdk/gdk.input-devices.lisp
@@ -0,0 +1,156 @@
+(in-package :gdk)
+
+(defcstruct %gdk-device
+  (parent-instance gobject.ffi::%g-object)
+  (name (:string :free-from-foreign nil))
+  (source gdk-input-source)
+  (mode gdk-input-mode)
+  (has-cursor :boolean)
+  (num-axes :int)
+  (axes :pointer)
+  (num-keys :int)
+  (keys :pointer))
+
+(define-g-boxed-cstruct gdk-device-key nil
+  (keyval :uint)
+  (modifiers modifier-type))
+
+(define-g-boxed-cstruct gdk-device-axis nil
+  (use axis-use)
+  (min :double)
+  (max :double))
+
+(defun %gdk-device-name (device)
+  (foreign-slot-value (pointer device) '%gdk-device 'name))
+
+(defun %gdk-device-source (device)
+  (foreign-slot-value (pointer device) '%gdk-device 'source))
+
+(defun %gdk-device-mode (device)
+  (foreign-slot-value (pointer device) '%gdk-device 'mode))
+
+(defun %gdk-device-has-cursor (device)
+  (foreign-slot-value (pointer device) '%gdk-device 'has-cursor))
+
+(defun %gdk-device-n-axes (device)
+  (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
+
+(defun %gdk-device-n-keys (device)
+  (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
+
+(defun %gdk-device-axes (device)
+  (let ((n (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
+        (axes (foreign-slot-value (pointer device) '%gdk-device 'axes)))
+    (iter (for i from 0 below n)
+          (for axis = (convert-from-foreign (inc-pointer axes (* i (foreign-type-size 'gdk-device-axis-cstruct)))
+                                            '(g-boxed-foreign gdk-device-axis)))
+          (collect axis))))
+
+(defun %gdk-device-keys (device)
+  (let ((n (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
+        (keys (foreign-slot-value (pointer device) '%gdk-device 'keys)))
+    (iter (for i from 0 below n)
+          (for key = (convert-from-foreign (inc-pointer keys (* i (foreign-type-size 'gdk-device-key-cstruct)))
+                                            '(g-boxed-foreign gdk-device-key)))
+          (collect key))))
+
+(defmethod print-object ((object gdk-device) stream)
+  (print-unreadable-object (object stream :type t :identity t)
+    (format stream "~A (~A, ~A)" (gdk-device-name object) (gdk-device-source object) (gdk-device-mode object))))
+
+(defcfun gdk-devices-list (glib:glist (g-object gdk-device) :free-from-foreign nil))
+
+(export 'gdk-devices-list)
+
+(defcfun gdk_device_set_mode :boolean
+  (device (g-object gdk-device))
+  (mode gdk-input-mode))
+
+(defcfun gdk-device-set-key :void
+  (device (g-object gdk-device))
+  (index :uint)
+  (keyval :uint)
+  (modifiers modifier-type))
+
+(export 'gdk-device-set-key)
+
+(defcfun gdk-device-set-axis-use :void
+  (device (g-object gdk-device))
+  (index :uint)
+  (use axis-use))
+
+(export 'gdk-device-set-axis-use)
+
+(defcfun gdk-device-get-core-pointer (g-object gdk-device))
+
+(export 'gdk-device-get-core-pointer)
+
+(defcfun gdk_device_get_state :void
+  (device (g-object gdk-device))
+  (window (g-object gdk-window))
+  (axes (:pointer :double))
+  (mask (:pointer modifier-type)))
+
+(defun gdk-device-get-state (device window)
+  (with-foreign-objects ((axes :double (%gdk-device-n-axes device)) (mask 'modifier-type))
+    (gdk_device_get_state device window axes mask)
+    (values (iter (for i from 0 below (%gdk-device-n-axes device))
+                  (collect (mem-aref axes :double i)))
+            (mem-ref mask 'modifier-type))))
+
+(export 'gdk-device-get-state)
+
+(define-g-boxed-cstruct gdk-time-coord nil
+  (time :uint32)
+  (axes :double :count 128))
+
+(defcfun gdk_device_get_history :boolean
+  (device (g-object gdk-device))
+  (window (g-object gdk-window))
+  (start :uint32)
+  (stop :uint32)
+  (events (:pointer (:pointer (:pointer gdk-time-coord-cstruct))))
+  (n-events (:pointer :int)))
+
+(defcfun gdk_device_free_history :void
+  (events (:pointer (:pointer gdk-time-coord-cstruct)))
+  (n-events :int))
+
+(defun gdk-device-get-history (device window start stop)
+  (with-foreign-objects ((events :pointer) (n-events :int))
+    (when (gdk_device_get_history device window start stop events n-events)
+      (prog1
+          (iter (with events-ar = (mem-ref events :pointer))
+                (for i from 0 below (mem-ref n-events :int))
+                (for coord = (mem-aref events-ar '(g-boxed-foreign gdk-time-coord) i))
+                (collect coord))
+        (gdk_device_free_history (mem-ref events :pointer) (mem-ref n-events :int))))))
+
+(export 'gdk-device-get-history)
+
+(defcfun gdk_device_get_axis :boolean
+  (device (g-object gdk-device))
+  (axes (:pointer :double))
+  (use axis-use)
+  (value (:pointer :double)))
+
+(defun gdk-device-get-axis (device axes axis-use)
+  (assert (= (%gdk-device-n-axes device) (length axes)))
+  (with-foreign-objects ((axes-ar :double (%gdk-device-n-axes device)) (value :double))
+    (let ((i 0))
+      (map nil
+           (lambda (v)
+             (setf (mem-aref axes-ar :double i) v)
+             (incf i))
+           axes))
+    (when (gdk_device_get_axis device axes-ar axis-use value)
+      (mem-ref value :double))))
+
+(export 'gdk-device-get-axis)
+
+(defcfun gdk-input-set-extension-events :void
+  (window (g-object gdk-window))
+  (mask :int)
+  (mode gdk-extension-mode))
+
+(export 'gdk-input-set-extension-events)

diff --git a/gdk/gdk.objects.lisp b/gdk/gdk.objects.lisp
index 19cf6e3..2f59777 100644 (file)
--- a/gdk/gdk.objects.lisp
+++ b/gdk/gdk.objects.lisp
@@ -471,6 +471,28 @@
   (:private 16)
   (:ask 32))
 
+(define-g-enum "GdkInputSource"
+    gdk-input-source
+    (:export t :type-initializer "gdk_input_source_get_type")
+  (:mouse 0)
+  (:pen 1)
+  (:eraser 2)
+  (:cursor 3))
+
+(define-g-enum "GdkInputMode"
+    gdk-input-mode
+    (:export t :type-initializer "gdk_input_mode_get_type")
+  (:disabled 0)
+  (:screen 1)
+  (:window 2))
+
+(define-g-enum "GdkExtensionMode"
+    gdk-extension-mode
+    (:export t :type-initializer "gdk_extension_mode_get_type")
+  (:none 0)
+  (:all 1)
+  (:cursor 2))
+
 (export 'cursor-type)
 
 (define-g-boxed-cstruct geometry nil
@@ -1017,3 +1039,24 @@
 
 (export (boxed-related-symbols 'gdk-window-attr))
 
+(define-g-object-class "GdkDevice" gdk-device
+  (:superclass g-object :export t :interfaces
+               nil :type-initializer
+               "gdk_device_get_type")
+  ((:cffi name gdk-device-name :string
+          %gdk-device-name nil)
+   (:cffi source gdk-device-source gdk-input-source
+          %gdk-device-source "gdk_device_set_source")
+   (:cffi mode gdk-device-mode gdk-input-mode
+          %gdk-device-mode gdk_device_set_mode)
+   (:cffi has-cursor gdk-device-has-cursor :boolean
+          %gdk-device-has-cursor nil)
+   (:cffi n-axes gdk-device-n-axes :int
+          %gdk-device-n-axes nil)
+   (:cffi axes gdk-device-axes nil
+          %gdk-device-axes nil)
+   (:cffi keys gdk-device-keys nil
+          %gdk-device-keys nil)
+   (:cffi n-keys gdk-device-n-keys nil
+          %gdk-device-n-keys nil)))
+