examples/keytest.lisp

   1 (require '#:asdf)
   2 (asdf:oos 'asdf:load-op '#:cl-glfw)
   3
   4 (defparameter *running* t)
   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      (setf *running* nil))
  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 (defun main ()
  58   (unless (eql gl:+true+ (glfw:open-window 250 100 0 0 0 0  0 0 glfw:+window+))
  59     (return-from main))
  60
  61   (glfw:set-key-callback (cffi:callback keyfun))
  62   (glfw:set-window-title "Press some keys!")
  63
  64   (do ((*running* t (and *running* (not (zerop (glfw:get-window-param glfw:+opened+)))))
  65        (t1 (glfw:get-time) (glfw:get-time)))
  66       ((not *running*))
  67
  68     (destructuring-bind (width height) (glfw:get-window-size)
  69       (gl:viewport 0 0 width height))
  70
  71     (gl:clear-color (coerce (+ 0.5 (* 0.5 (sin (* 3.0 t1))))
  72                             'single-float)
  73                     0.0 0.0 0.0)
  74     (gl:clear gl:+color-buffer-bit+)
  75
  76     (glfw:swap-buffers)))
  77
  78 (glfw:init)
  79 (main)
  80 (glfw:terminate)