惑星系 planet.c

『OpenGLプログラミングガイド 第2版』の 惑星系 planet.c を cl-opengl で。

キー操作による動きがあるからまた面白い。

月も追加してみた。

Common Lisp で書く場合は、ちょこっとパラメータを変更して C-c C-c すれば、プログラム実行したまま即反映されるからとても楽だ。

動きがあると透視法射影の意味が実感できる。確かに遠近法だ。

カメラの上方向ベクトルってのは、カメラの上側の方向なんだ。 0 1 0 ならランドスケープで、1 0 0 ならポートレイト。 0 0 1 だと机に置いたものを接写しているイメージかな。

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

(defclass planet-window (glut:window)
  ((year :initform 0)
   (day  :initform 0)
   (month  :initform 0))
  (:default-initargs :title "Planet"
    :mode '(:double :rgb)
    :width 500 :height 500
    :pos-x 100 :pos-y 100))

(defmethod glut:display-window :before ((window planet-window))
  (%gl:clear-color 0 0 0 0)
  (%gl:shade-model :flat))

(defmethod glut:display ((window planet-window))
  (with-slots (year day month) window
    (gl:clear :color-buffer-bit)
    (%gl:color-3f 1 1 1)
    (gl:with-pushed-matrix
      (gl:color 1 0 0)
      (glut:wire-sphere 1 20 16)        ; 太陽。半径、経線数、緯線数
      (%gl:rotate-f year 0 1 0)         ; 地球の公転
      (%gl:translate-f 2 0 0)           ; 太陽と地球の距離
      (gl:with-pushed-matrix
        (%gl:rotate-f day 0 1 0)        ; 地球の自転
        (gl:color 0 0 1)
        (glut:wire-sphere 0.2 10 8))    ; 地球
      (%gl:rotate-f month 0 1 0)        ; 月の公転
      (%gl:translate-f 0.3 0 0)         ; 地球と月の距離
      (gl:color 1 1 0)
      (glut:wire-sphere 0.05 8 6))      ; 月
    (glut:swap-buffers)))

(defmethod glut:reshape ((window planet-window) width height)
  (%gl:viewport 0 0 width height)
  (%gl:matrix-mode :projection)
  (%gl:load-identity)
  (glu:perspective 60                   ; 透視射影の視野角度
                   (/ width height)     ; 縦横比
                   1                    ; 手前の座標
                   20)                  ; 奥の座標
  (%gl:matrix-mode :modelview)
  (%gl:load-identity)
  (glu:look-at 0 0 5                    ; カメラの位置
               0 0 0                    ; 向いてる方向
               0 1 0))                  ; 上方向

(defmethod glut:keyboard ((window planet-window) key x y)
  (declare (ignore x y))
  (with-slots (year day month) window
    (case key
      ((#\Esc #\q)
         (glut:destroy-current-window))
      (#\m
         (setf month (mod (+ month 5) 360))
         (glut:post-redisplay))
      (#\M
         (setf month (mod (- month 5) 360))
         (glut:post-redisplay))
      (#\d
         (setf day (mod (+ day 10) 360))
         (glut:post-redisplay))
      (#\D
         (setf day (mod (- day 10) 360))
         (glut:post-redisplay))
      (#\y
         (setf year (mod (+ year 5) 360))
         (glut:post-redisplay))
      (#\Y
         (setf year (mod (- year 5) 360))
         (glut:post-redisplay)))))

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