examples/color-selector.lisp

   1 #|
   2   OpenGL color selector.
   3   Show 3 color planes (+x=red, +y=green, and +z=blue);
   4   select the color at their intersection.
   5 |#
   6 (require '#:asdf)
   7 (asdf:oos 'asdf:load-op '#:cl-glfw)
   8 (asdf:oos 'asdf:load-op '#:cl-glfw-opengl)
   9 (asdf:oos 'asdf:load-op '#:cl-glfw-glu)
  10
  11 ;;;; The viewer
  12 (defparameter *red* 0)
  13 (defparameter *green* 0)
  14 (defparameter *blue* 0)
  15
  16 (cffi:defcallback key-callback :void ((key :int) (action :int))
  17   (when (eql action glfw:+press+)
  18     (cond ((eql key (char-code #\Z))
  19            (if (eql (glfw:get-key glfw:+key-lshift+) glfw:+press+)
  20                (decf *blue*)
  21                (incf *blue*)))
  22           ((eql key glfw:+key-esc+)   (glfw:close-window))
  23           ((eql key glfw:+key-up+)    (incf *red*))
  24           ((eql key glfw:+key-down+)  (decf *red*))
  25           ((eql key glfw:+key-left+)  (decf *green*))
  26           ((eql key glfw:+key-right+) (incf *green*)))))
  27
  28 (defun color-selector ()
  29  (let ((frames 0)
  30       t0 t1)
  31    (setf *red* 0
  32          *green* 0
  33          *blue* 0)
  34   (glfw:do-window ("Color Selector" 640 480)
  35       ((glfw:enable glfw:+sticky-keys+)
  36        (glfw:enable glfw:+key-repeat+)
  37        (gl:disable gl:+cull-face+)
  38        (gl:enable gl:+depth-test+)
  39        (gl:depth-mask gl:+true+)
  40        (glfw:swap-interval 0)
  41        (glfw:set-key-callback (cffi:callback key-callback))
  42        (setf t0 (glfw:get-time)
  43              t1 (glfw:get-time)))
  44
  45     (when (eql (glfw:get-key glfw:+key-esc+) glfw:+press+)
  46       (return-from glfw:do-window))
  47
  48     (setf t1 (glfw:get-time))
  49
  50     (when (> (- t1 t0) 1)
  51       (glfw:set-window-title (format nil "Color Selector (~,1f FPS)" (/ frames (- t1 t0))))
  52       (setf frames 0
  53             t0 t1))
  54
  55     (incf frames)
  56
  57     (destructuring-bind (width height) (glfw:get-window-size)
  58       (setf height (max height 1))
  59       (gl:viewport 0 0 width height)
  60
  61       (gl:clear-color 0 0 0 0)
  62       (gl:clear (+ gl:+color-buffer-bit+
  63                    gl:+depth-buffer-bit+))
  64
  65       (gl:matrix-mode gl:+projection+)
  66       (gl:load-identity)
  67       (glu:perspective 65 (/ width height) 1 100)
  68       (gl:matrix-mode gl:+modelview+)
  69       (gl:load-identity)
  70       (glu:look-at 0  1 0
  71                    0 20 0
  72                    0  0 1)
  73
  74       (gl:translate-f 0 14 0)
  75
  76       (gl:with-push-matrix
  77         (gl:rotate-f 20 1 0 0)
  78         (gl:rotate-f 0 0 1 0)
  79         (gl:rotate-f -135 0 0 1)
  80         (gl:scale-f 5 5 5)
  81
  82         (gl:with-begin gl:+quads+
  83           (flet ((show (r g b)
  84                    (gl:color-3f r g b)
  85                    (gl:vertex-3f r g b)))
  86             (macrolet ((bound (axis)
  87                          `(cond ((< ,axis 0) (setf ,axis 0) 0)
  88                                 ((> ,axis 255) (setf ,axis 255) 1)
  89                                 (t (/ ,axis 255)))))
  90               (let ((red (bound *red*))
  91                     (green (bound *green*))
  92                     (blue (bound *blue*)))
  93                 ;; red (green-blue plane)
  94                 (show red 0 0)
  95                 (show red 0 1)
  96                 (show red 1 1)
  97                 (show red 1 0)
  98                 ;; green (blue-red plane)
  99                 (show 0 green 0)
 100                 (show 0 green 1)
 101                 (show 1 green 1)
 102                 (show 1 green 0)
 103                 ;; blue (red-green plane)
 104                 (show 0 0 blue)
 105                 (show 0 1 blue)
 106                 (show 1 1 blue)
 107                 (show 1 0 blue))))))))))
 108
 109 (color-selector)