3 (defcstruct %gdk-device
4 (parent-instance gobject.ffi::%g-object)
5 (name (:string :free-from-foreign nil))
6 (source gdk-input-source)
13 (defctype %gdk-device (:struct %gdk-device))
15 (define-g-boxed-cstruct gdk-device-key nil
17 (modifiers modifier-type))
19 (define-g-boxed-cstruct gdk-device-axis nil
24 (defun %gdk-device-name (device)
25 (foreign-slot-value (pointer device) '%gdk-device 'name))
27 (defun %gdk-device-source (device)
28 (foreign-slot-value (pointer device) '%gdk-device 'source))
30 (defun %gdk-device-mode (device)
31 (foreign-slot-value (pointer device) '%gdk-device 'mode))
33 (defun %gdk-device-has-cursor (device)
34 (foreign-slot-value (pointer device) '%gdk-device 'has-cursor))
36 (defun %gdk-device-n-axes (device)
37 (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
39 (defun %gdk-device-n-keys (device)
40 (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
42 (defun %gdk-device-axes (device)
43 (let ((n (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
44 (axes (foreign-slot-value (pointer device) '%gdk-device 'axes)))
45 (iter (for i from 0 below n)
46 (for axis = (convert-from-foreign (inc-pointer axes (* i (foreign-type-size 'gdk-device-axis-cstruct)))
47 '(g-boxed-foreign gdk-device-axis)))
50 (defun %gdk-device-keys (device)
51 (let ((n (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
52 (keys (foreign-slot-value (pointer device) '%gdk-device 'keys)))
53 (iter (for i from 0 below n)
54 (for key = (convert-from-foreign (inc-pointer keys (* i (foreign-type-size 'gdk-device-key-cstruct)))
55 '(g-boxed-foreign gdk-device-key)))
58 (defmethod print-object ((object gdk-device) stream)
59 (print-unreadable-object (object stream :type t :identity t)
60 (format stream "~A (~A, ~A)" (gdk-device-name object) (gdk-device-source object) (gdk-device-mode object))))
62 (defcfun gdk-devices-list (glib:glist (g-object gdk-device) :free-from-foreign nil))
64 (export 'gdk-devices-list)
66 (defcfun gdk_device_set_mode :boolean
67 (device (g-object gdk-device))
68 (mode gdk-input-mode))
70 (defcfun gdk-device-set-key :void
71 (device (g-object gdk-device))
74 (modifiers modifier-type))
76 (export 'gdk-device-set-key)
78 (defcfun gdk-device-set-axis-use :void
79 (device (g-object gdk-device))
83 (export 'gdk-device-set-axis-use)
85 (defcfun gdk-device-get-core-pointer (g-object gdk-device))
87 (export 'gdk-device-get-core-pointer)
89 (defcfun gdk_device_get_state :void
90 (device (g-object gdk-device))
91 (window (g-object gdk-window))
92 (axes (:pointer :double))
93 (mask (:pointer modifier-type)))
95 (defun gdk-device-get-state (device window)
96 (with-foreign-objects ((axes :double (%gdk-device-n-axes device)) (mask 'modifier-type))
97 (gdk_device_get_state device window axes mask)
98 (values (iter (for i from 0 below (%gdk-device-n-axes device))
99 (collect (mem-aref axes :double i)))
100 (mem-ref mask 'modifier-type))))
102 (export 'gdk-device-get-state)
104 (define-g-boxed-cstruct gdk-time-coord nil
106 (axes :double :count 128))
108 (defcfun gdk_device_get_history :boolean
109 (device (g-object gdk-device))
110 (window (g-object gdk-window))
113 (events (:pointer (:pointer (:pointer gdk-time-coord-cstruct))))
114 (n-events (:pointer :int)))
116 (defcfun gdk_device_free_history :void
117 (events (:pointer (:pointer gdk-time-coord-cstruct)))
120 (defun gdk-device-get-history (device window start stop)
121 (with-foreign-objects ((events :pointer) (n-events :int))
122 (when (gdk_device_get_history device window start stop events n-events)
124 (iter (with events-ar = (mem-ref events :pointer))
125 (for i from 0 below (mem-ref n-events :int))
126 (for coord = (mem-aref events-ar '(g-boxed-foreign gdk-time-coord) i))
128 (gdk_device_free_history (mem-ref events :pointer) (mem-ref n-events :int))))))
130 (export 'gdk-device-get-history)
132 (defcfun gdk_device_get_axis :boolean
133 (device (g-object gdk-device))
134 (axes (:pointer :double))
136 (value (:pointer :double)))
138 (defun gdk-device-get-axis (device axes axis-use)
139 (assert (= (%gdk-device-n-axes device) (length axes)))
140 (with-foreign-objects ((axes-ar :double (%gdk-device-n-axes device)) (value :double))
144 (setf (mem-aref axes-ar :double i) v)
147 (when (gdk_device_get_axis device axes-ar axis-use value)
148 (mem-ref value :double))))
150 (export 'gdk-device-get-axis)
152 (defcfun gdk-input-set-extension-events :void
153 (window (g-object gdk-window))
155 (mode gdk-extension-mode))
157 (export 'gdk-input-set-extension-events)