examples/keytest.lisp

   1 (require '#:asdf)
   2 (asdf:oos 'asdf:load-op '#:cl-glfw)
   3
   4 (defparameter *key-repeat* nil)
   5 (defparameter *system-keys* t)
   6
   7 (defun get-key-name (key)
   8   (dolist (special-key '("backspace" "del" "down" "end" "enter" "esc" "f1" "f10" "f11" "f12" "f13"
   9                           "f14" "f15" "f16" "f17" "f18" "f19" "f2" "f20" "f21" "f22" "f23" "f24" "f25"
  10                           "f3" "f4" "f5" "f6" "f7" "f8" "f9" "home" "insert" "kp-0" "kp-1" "kp-2" "kp-3"
  11                           "kp-4" "kp-5" "kp-6" "kp-7" "kp-8" "kp-9" "kp-add" "kp-decimal" "kp-divide"
  12                           "kp-enter" "kp-equal" "kp-multiply" "kp-subtract" "lalt" "lctrl" "left"
  13                           "lshift" "pagedown" "pageup" "ralt" "rctrl" "repeat" "right" "rshift" "space"
  14                           "special" "tab" "unknown" "up"))
  15     (when (eql key (symbol-value (find-symbol (string-upcase (format nil "+key-~a+" special-key))
  16                                               (find-package '#:glfw))))
  17       (return-from get-key-name special-key))))
  18
  19 (cffi:defcallback keyfun :void ((key :int) (action :int))
  20   (cond
  21     ((not (eql action glfw:+press+)))
  22
  23     ((and (>= key glfw:+key-f1+)
  24           (<= key glfw:+key-f25+))
  25      (format t "F~d~%" (1+ (- key glfw:+key-f1+))))
  26
  27     ((eql key glfw:+key-esc+)
  28      (format t "ESC => quit program~%")
  29      (glfw:close-window))
  30
  31     ((eql key (char-code #\R))
  32      (setf *key-repeat* (not *key-repeat*))
  33      (funcall (if *key-repeat* #'glfw:enable #'glfw:disable) glfw:+key-repeat+)
  34      (format t "R => Key repeat: ~s~%" (if *key-repeat* "ON" "OFF")))
  35
  36     ((eql key (char-code #\S))
  37      (setf *system-keys* (not *system-keys*))
  38      (funcall (if *system-keys* #'glfw:enable #'glfw:disable) glfw:+system-keys+)
  39      (format t "S => System keys: ~s~%" (if *system-keys* "ON" "OFF")))
  40     ((let ((name (get-key-name key)))
  41        (when name
  42          (format t "~a~%" name)
  43          t)))
  44
  45     ((and (> key 0)
  46           (< key 256))
  47      (format t "~c~%" (code-char key)))
  48
  49     (t
  50      (format t "??? decimal ~d" key)
  51      (when (graphic-char-p (code-char key))
  52       (format t " character ~c" (code-char key)))
  53      (fresh-line)))
  54   (force-output))
  55
  56 (glfw:do-window ("Press some keys!" 250 100)
  57     ((glfw:set-key-callback (cffi:callback keyfun)))
  58
  59   (destructuring-bind (width height) (glfw:get-window-size)
  60     (gl:viewport 0 0 width height))
  61
  62   (gl:clear-color (coerce (+ 0.5 (* 0.5 (sin (* 3.0 (glfw:get-time)))))
  63                           'single-float)
  64                   0.0 0.0 0.0)
  65   (gl:clear gl:+color-buffer-bit+))