examples/keytest.lisp

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