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