2 (asdf:oos
'asdf
:load-op
'#:cl-glfw
)
3 (asdf:oos
'asdf
:load-op
'#:cl-glfw-opengl
)
5 (defparameter *key-repeat
* nil
)
6 (defparameter *system-keys
* t
)
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
))))
20 (cffi:defcallback keyfun
:void
((key :int
) (action :int
))
22 ((not (eql action glfw
:+press
+)))
24 ((and (>= key glfw
:+key-f1
+)
25 (<= key glfw
:+key-f25
+))
26 (format t
"F~d~%" (1+ (- key glfw
:+key-f1
+))))
28 ((eql key glfw
:+key-esc
+)
29 (format t
"ESC => quit program~%")
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")))
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
)))
43 (format t
"~a~%" name
)
48 (format t
"~c~%" (code-char key
)))
51 (format t
"??? decimal ~d" key
)
52 (when (graphic-char-p (code-char key
))
53 (format t
" character ~c" (code-char key
)))
57 (glfw:do-window
("Press some keys!" 250 100)
58 ((glfw:set-key-callback
(cffi:callback keyfun
)))
60 (destructuring-bind (width height
) (glfw:get-window-size
)
61 (gl:viewport
0 0 width height
))
63 (gl:clear-color
(coerce (+ 0.5 (* 0.5 (sin (* 3.0 (glfw:get-time
)))))
66 (gl:clear gl
:+color-buffer-bit
+))