イメージ

『OpenGLプログラミングガイド 第2版』はずっととばして第8章へ。イメージを。

glut:reshape のときに glut:width と glut:height が自動的に更新されてほしい気がするだが気のせいだろうか。

(defmethod glut:reshape ((window glut:window) w h)
  (setf (glut:width window) w
        (glut:height window) h))

というメソッドが定義済であって欲しい。

image.c の cl-opengl バージョン。ひさしぶりに loop ではなく dotimes を使った気がする。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :cl-opengl)
  (require :cl-glu)
  (require :cl-glut))

(defconstant +width+ 64)
(defconstant +height+ 64)

(defclass image-window (glut:window)
  ((image :initform (make-array (* +height+ +width+ 3))
          :accessor image)
   (zoom-factor :initform 1.0
                :accessor zoom-factor))
  (:default-initargs :mode '(:rgb :single )))

(defmethod make-check-image ((window image-window))
  (with-accessors ((image image)) window
    (let ((index -1))
      (dotimes (i +height+)
        (dotimes (j +width+)
          (let ((c (* (logxor (if (zerop (logand i #x8)) 1 0)
                              (if (zerop (logand j #x8)) 1 0))
                      255)))
            (setf (aref image (incf index)) c)
            (setf (aref image (incf index)) c)
            (setf (aref image (incf index)) c)))))))

(defmethod glut:display-window :before ((w image-window))
  (make-check-image w)
  (gl:clear-color 0 0 0 0)
  (%gl:shade-model :flat)
  (gl:pixel-store :unpack-alignment 1))

(defmethod glut:display ((window image-window))
  (gl:clear :color-buffer-bit)          ; クリア
  (gl:raster-pos 0 0)
  (gl:draw-pixels +width+ +height+ :rgb :unsigned-byte (image window))
  (%gl:flush))

(defmethod glut:reshape ((window image-window) w h)
  (setf (glut:width window) w
        (glut:height window) h)
  (%gl:viewport 0 0 w h)
  (%gl:matrix-mode :projection)
  (%gl:load-identity)
  (glu:ortho-2d 0 w 0 h)
  (%gl:matrix-mode :modelview)
  (%gl:load-identity))

(defmethod glut:motion ((window image-window) x y)
  (with-accessors ((zoom-factor zoom-factor)) window
    (let ((screen-y (- (glut:height window) y)))
      (print (list (glut:height window) screen-y y))
      (gl:raster-pos x screen-y)
      (%gl:pixel-zoom zoom-factor zoom-factor)
      (%gl:copy-pixels 0 0 +width+ +height+ :color)
      (%gl:pixel-zoom 1 1)
      (%gl:flush))))

(defmethod glut:keyboard ((window image-window) key x y)
  (declare (ignore x y))
  (with-accessors ((zoom-factor zoom-factor)) window
    (case key
      ((#\r #\R)
         (setf zoom-factor 1)
         (glut:post-redisplay))
      (#\z
         (when (<= 3 (incf zoom-factor 0.5))
           (setf zoom-factor 3)))
      (#\Z
         (when (<= (decf zoom-factor 0.5) 0.5)
           (setf zoom-factor 0.5)))
      ((#\Esc #\q) (glut:destroy-current-window)))))

;;(glut:display-window (make-instance 'image-window))