2 (asdf:oos
'asdf
:load-op
'#:cl-glfw
)
4 (defparameter *running
* t
)
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
)))
58 (unless (eql gl
:+true
+ (glfw:open-window
250 100 0 0 0 0 0 0 glfw
:+window
+))
61 (glfw:set-key-callback
(cffi:callback keyfun
))
62 (glfw:set-window-title
"Press some keys!")
64 (do ((*running
* t
(and *running
* (not (zerop (glfw:get-window-param glfw
:+opened
+)))))
65 (t1 (glfw:get-time
) (glfw:get-time
)))
68 (destructuring-bind (width height
) (glfw:get-window-size
)
69 (gl:viewport
0 0 width height
))
71 (gl:clear-color
(coerce (+ 0.5 (* 0.5 (sin (* 3.0 t1
))))
74 (gl:clear gl
:+color-buffer-bit
+)