cl-openglで画像出た

何も分からないままにcl-openglのサンプルを適当にいじったら画像が表示できた。
テクスチャとして貼付けてるので、簡単に回転できた。
gltest01

それにしても、asdfやrequireというのがよくわからない。
cl-openglを使ったソースを探したら、みんな
(require :cl-glut)
とかやってるけど、これをするとcl-openglが見つからないと怒られる。
(asdf:oos ‘asdf:load-op :cl-glut)
これで代用できるみたいだけど面倒だ。
画像を読み込むために、cl-pngというのを入れたけど、これも同じ。それから、
(asdf:oos ‘asdf:load-op :png)
という風に、cl-pngではなくpngと指定しないといけない。ややこしい。

(defclass hello-window (glut:window)
  ((image :initarg :image :initform nil :accessor image)
   (texture :accessor texture))
  (:default-initargs :pos-x 100 :pos-y 100 :width 800 :height 600
                     :mode '(:single :rgb) :title "YUNOHA"))
(defmethod glut:display-window :before ((w hello-window))
  (gl:clear-color 0 0 0 0)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (gl:ortho -4 4 -3 3 -1 1)
  (gl:pixel-store :unpack-alignment 1)
  (setf (texture w) (car (gl:gen-textures 1)))
  (gl:bind-texture :texture-2d (texture w))
  (gl:tex-parameter :texture-2d :texture-min-filter :nearest)
  (gl:tex-parameter :texture-2d :texture-mag-filter :nearest)
  (gl:tex-image-2d :texture-2d 0 :rgb 800 600 0 :rgb :unsigned-byte (image w)))
(defmethod glut:display ((w hello-window))
  (gl:clear :color-buffer-bit)
  (gl:rotate 4 0 0 1)
  (gl:raster-pos 0 0)
  (gl:enable :texture-2d)
  (gl:with-primitive :quads
    (gl:tex-coord 0 0)
    (gl:vertex -3.75 -2.75 0)
    (gl:tex-coord 1 0)
    (gl:vertex 3.75 -2.75 0)
    (gl:tex-coord 1 1)
    (gl:vertex 3.75 2.75 0)
    (gl:tex-coord 0 1)
    (gl:vertex -3.75 2.75 0))
  (gl:disable :texture-2d)
  (gl:flush))
(defmethod glut:idle ((widow hello-window))
  (sleep (/ 1.0 30.0))
  (glut:post-redisplay))
(defmethod glut:keyboard ((window hello-window) key x y)
  (declare (ignore x y))
  (case key
    (#¥Esc (glut:destroy-current-window))))
(defun run ()
  (glut:display-window (make-instance 'hello-window :image (png->raw "kawanishi_lico01.png"))))
(defun png->raw (input-pathname)
  (let* ((old (with-open-file (input input-pathname
                                     :element-type '(unsigned-byte 8))
                (png:decode input)))
         (new (make-array (* (png:image-width old) (png:image-height old) 3)
                          :element-type '(unsigned-byte 8))))
    (dotimes (i (png:image-height old) new)
      (dotimes (j (png:image-width old))
        (dotimes (k 3)
          (setf (aref new (+ (* i (png:image-width old) 3) (* j 3) k))
                (aref old (- (png:image-height old) i 1) j k)))))))

Leave a Reply