3 (defcstruct %gdk-device
4 (parent-instance gobject.ffi::%g-object)
5 (name (:string :free-from-foreign nil))
6 (source gdk-input-source)
14 (define-g-boxed-cstruct gdk-device-key nil
16 (modifiers modifier-type))
18 (define-g-boxed-cstruct gdk-device-axis nil
23 (defun %gdk-device-name (device)
24 (foreign-slot-value (pointer device) '%gdk-device 'name))
26 (defun %gdk-device-source (device)
27 (foreign-slot-value (pointer device) '%gdk-device 'source))
29 (defun %gdk-device-mode (device)
30 (foreign-slot-value (pointer device) '%gdk-device 'mode))
32 (defun %gdk-device-has-cursor (device)
33 (foreign-slot-value (pointer device) '%gdk-device 'has-cursor))
35 (defun %gdk-device-n-axes (device)
36 (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
38 (defun %gdk-device-n-keys (device)
39 (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
41 (defun %gdk-device-axes (device)
42 (let ((n (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
43 (axes (foreign-slot-value (pointer device) '%gdk-device 'axes)))
44 (iter (for i from 0 below n)
45 (for axis = (convert-from-foreign (inc-pointer axes (* i (foreign-type-size 'gdk-device-axis-cstruct)))
46 '(g-boxed-foreign gdk-device-axis)))
49 (defun %gdk-device-keys (device)
50 (let ((n (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
51 (keys (foreign-slot-value (pointer device) '%gdk-device 'keys)))
52 (iter (for i from 0 below n)
53 (for key = (convert-from-foreign (inc-pointer keys (* i (foreign-type-size 'gdk-device-key-cstruct)))
54 '(g-boxed-foreign gdk-device-key)))
57 (defmethod print-object ((object gdk-device) stream)
58 (print-unreadable-object (object stream :type t :identity t)
59 (format stream "~A (~A, ~A)" (gdk-device-name object) (gdk-device-source object) (gdk-device-mode object))))
61 (defcfun gdk-devices-list (glib:glist (g-object gdk-device) :free-from-foreign nil))
63 (export 'gdk-devices-list)
65 (defcfun gdk_device_set_mode :boolean
66 (device (g-object gdk-device))
67 (mode gdk-input-mode))
69 (defcfun gdk-device-set-key :void
70 (device (g-object gdk-device))
73 (modifiers modifier-type))
75 (export 'gdk-device-set-key)
77 (defcfun gdk-device-set-axis-use :void
78 (device (g-object gdk-device))
82 (export 'gdk-device-set-axis-use)
84 (defcfun gdk-device-get-core-pointer (g-object gdk-device))
86 (export 'gdk-device-get-core-pointer)
88 (defcfun gdk_device_get_state :void
89 (device (g-object gdk-device))
90 (window (g-object gdk-window))
91 (axes (:pointer :double))
92 (mask (:pointer modifier-type)))
94 (defun gdk-device-get-state (device window)
95 (with-foreign-objects ((axes :double (%gdk-device-n-axes device)) (mask 'modifier-type))
96 (gdk_device_get_state device window axes mask)
97 (values (iter (for i from 0 below (%gdk-device-n-axes device))
98 (collect (mem-aref axes :double i)))
99 (mem-ref mask 'modifier-type))))
101 (export 'gdk-device-get-state)
103 (define-g-boxed-cstruct gdk-time-coord nil
105 (axes :double :count 128))
107 (defcfun gdk_device_get_history :boolean
108 (device (g-object gdk-device))
109 (window (g-object gdk-window))
112 (events (:pointer (:pointer (:pointer gdk-time-coord-cstruct))))
113 (n-events (:pointer :int)))
115 (defcfun gdk_device_free_history :void
116 (events (:pointer (:pointer gdk-time-coord-cstruct)))
119 (defun gdk-device-get-history (device window start stop)
120 (with-foreign-objects ((events :pointer) (n-events :int))
121 (when (gdk_device_get_history device window start stop events n-events)
123 (iter (with events-ar = (mem-ref events :pointer))
124 (for i from 0 below (mem-ref n-events :int))
125 (for coord = (mem-aref events-ar '(g-boxed-foreign gdk-time-coord) i))
127 (gdk_device_free_history (mem-ref events :pointer) (mem-ref n-events :int))))))
129 (export 'gdk-device-get-history)
131 (defcfun gdk_device_get_axis :boolean
132 (device (g-object gdk-device))
133 (axes (:pointer :double))
135 (value (:pointer :double)))
137 (defun gdk-device-get-axis (device axes axis-use)
138 (assert (= (%gdk-device-n-axes device) (length axes)))
139 (with-foreign-objects ((axes-ar :double (%gdk-device-n-axes device)) (value :double))
143 (setf (mem-aref axes-ar :double i) v)
146 (when (gdk_device_get_axis device axes-ar axis-use value)
147 (mem-ref value :double))))
149 (export 'gdk-device-get-axis)
151 (defcfun gdk-input-set-extension-events :void
152 (window (g-object gdk-window))
154 (mode gdk-extension-mode))
156 (export 'gdk-input-set-extension-events)