gdk/gdk.input-devices.lisp

   1 (in-package :gdk)
   2
   3 (defcstruct %gdk-device
   4   (parent-instance gobject.ffi::%g-object)
   5   (name (:string :free-from-foreign nil))
   6   (source gdk-input-source)
   7   (mode gdk-input-mode)
   8   (has-cursor :boolean)
   9   (num-axes :int)
  10   (axes :pointer)
  11   (num-keys :int)
  12   (keys :pointer))
  13 (defctype %gdk-device (:struct %gdk-device))
  14
  15 (define-g-boxed-cstruct gdk-device-key nil
  16   (keyval :uint)
  17   (modifiers modifier-type))
  18
  19 (define-g-boxed-cstruct gdk-device-axis nil
  20   (use axis-use)
  21   (min :double)
  22   (max :double))
  23
  24 (defun %gdk-device-name (device)
  25   (foreign-slot-value (pointer device) '%gdk-device 'name))
  26
  27 (defun %gdk-device-source (device)
  28   (foreign-slot-value (pointer device) '%gdk-device 'source))
  29
  30 (defun %gdk-device-mode (device)
  31   (foreign-slot-value (pointer device) '%gdk-device 'mode))
  32
  33 (defun %gdk-device-has-cursor (device)
  34   (foreign-slot-value (pointer device) '%gdk-device 'has-cursor))
  35
  36 (defun %gdk-device-n-axes (device)
  37   (foreign-slot-value (pointer device) '%gdk-device 'num-axes))
  38
  39 (defun %gdk-device-n-keys (device)
  40   (foreign-slot-value (pointer device) '%gdk-device 'num-keys))
  41
  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)))
  48           (collect axis))))
  49
  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)))
  56           (collect key))))
  57
  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))))
  61
  62 (defcfun gdk-devices-list (glib:glist (g-object gdk-device) :free-from-foreign nil))
  63
  64 (export 'gdk-devices-list)
  65
  66 (defcfun gdk_device_set_mode :boolean
  67   (device (g-object gdk-device))
  68   (mode gdk-input-mode))
  69
  70 (defcfun gdk-device-set-key :void
  71   (device (g-object gdk-device))
  72   (index :uint)
  73   (keyval :uint)
  74   (modifiers modifier-type))
  75
  76 (export 'gdk-device-set-key)
  77
  78 (defcfun gdk-device-set-axis-use :void
  79   (device (g-object gdk-device))
  80   (index :uint)
  81   (use axis-use))
  82
  83 (export 'gdk-device-set-axis-use)
  84
  85 (defcfun gdk-device-get-core-pointer (g-object gdk-device))
  86
  87 (export 'gdk-device-get-core-pointer)
  88
  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)))
  94
  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))))
 101
 102 (export 'gdk-device-get-state)
 103
 104 (define-g-boxed-cstruct gdk-time-coord nil
 105   (time :uint32)
 106   (axes :double :count 128))
 107
 108 (defcfun gdk_device_get_history :boolean
 109   (device (g-object gdk-device))
 110   (window (g-object gdk-window))
 111   (start :uint32)
 112   (stop :uint32)
 113   (events (:pointer (:pointer (:pointer gdk-time-coord-cstruct))))
 114   (n-events (:pointer :int)))
 115
 116 (defcfun gdk_device_free_history :void
 117   (events (:pointer (:pointer gdk-time-coord-cstruct)))
 118   (n-events :int))
 119
 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)
 123       (prog1
 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))
 127                 (collect coord))
 128         (gdk_device_free_history (mem-ref events :pointer) (mem-ref n-events :int))))))
 129
 130 (export 'gdk-device-get-history)
 131
 132 (defcfun gdk_device_get_axis :boolean
 133   (device (g-object gdk-device))
 134   (axes (:pointer :double))
 135   (use axis-use)
 136   (value (:pointer :double)))
 137
 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))
 141     (let ((i 0))
 142       (map nil
 143            (lambda (v)
 144              (setf (mem-aref axes-ar :double i) v)
 145              (incf i))
 146            axes))
 147     (when (gdk_device_get_axis device axes-ar axis-use value)
 148       (mem-ref value :double))))
 149
 150 (export 'gdk-device-get-axis)
 151
 152 (defcfun gdk-input-set-extension-events :void
 153   (window (g-object gdk-window))
 154   (mask :int)
 155   (mode gdk-extension-mode))
 156
 157 (export 'gdk-input-set-extension-events)