sasagawa::log6

sasagawa::log6

Open-glの自分の学習用にライフゲームを作ってみました。世代交代の計算が間違ってるかも。 とりあえずマウスボタンを押すとチカチカとセルが動き始めるので一応は動いてるようです。 時間ができたらしっかり書き直します。2010/12/18 23:10:28 PST

;;以前書いたOpenGLの演習用コードをベースにしてライフげゲームを書く。
;;OpenGL学習用のコード。
;;データは自作行列ライブラリの行列を使って世代交代を計算する。
;;世代交代の都度、アニメーションの要領でデータを画像表示する。
;;左マウスボタンを押している間は世代交代が進む。離すと計算停止。
;;右マウスボタンクリックで1世代だけ計算して表示。
;; r キーで初期化。乱数で初期状態を生成、表示。
;;対話モードで(main)で起動。
;;Ver0.1
;;とりあえず画面がちかちかと変化するものの、ちゃんと世代交代の計算になっているのかどうかは
;;未確認。


(use gl)
(use gl.glut)
(use math.matrix) ;;自作行列ライブラリ 
(use srfi-27) 

;;i,j要素について生死を判定する。 
;;端の要素でない通常の場合なら 
;; 0 0 0 (i-1,j-1)(i-1,j)(i-1,j+1) 
;; 0 1 0 (i,j-1)(i,j)(i,j+1) 
;; 0 0 0 (i+1,j-1)(i+1,j)(i+1,j+1) 
;;10*10 なら8*8の部分だけを使う。これにより端の要素の判定を簡素化できる。 

(define n 100) ;;生成するセルの大きさ n*n
(define quad-size (/ 500 n));;描画するときの四角の1辺の長さ
(define mat1 (make-matrix (+ n 2) (+ n 2))) 
(define mat2 (make-matrix (+ n 2) (+ n 2))) 
(define sw 1) ;スイッチ 最初はmat1をもとに判定するので1、その後2,1,2,1・・・ 

;;生死判定。隣接する8つのセルのうち2あるいは3個が生のときに限り生。 
(define (life? m i j) 
  (let ((life-n 0)) 
    (do ((x (- i 1) (+ x 1))) 
        ((> x (+ i 1))) 
        (do ((y (- j 1) (+ y 1))) 
            ((> y (+ j 1))) 
            (cond ((= x y) #t) 
                  ((= (matrix-ref m x y) 1) (inc! life-n))))) 
    (or (= life-n 2)(= life-n 3)))) 

;;行列1の状態から次世代を行列2に生成する。 
(define (next-1->2) 
  (define start 2)
  (define end (- n 1))
  (do ((i start (+ i 1))) 
      ((> i end)) 
      (do ((j start (+ j 1))) 
          ((> j end))
          (if (life? mat1 i j) 
              (matrix-set! mat2 i j 1) 
              (matrix-set! mat2 i j 0))))) 

;;行列2の状態から次世代を行列1に生成する。 
(define (next-2->1)
  (define start 2)
  (define end (- n 1)) 
  (do ((i start (+ i 1))) 
      ((> i end)) 
      (do ((j start (+ j 1))) 
          ((> j end))
          (if (life? mat2 i j) 
              (matrix-set! mat1 i j 1) 
              (matrix-set! mat1 i j 0))))) 

;;乱数で0-9を発生させて0のときだけ生としてmat1に要素1を書き込む。他は0。 
;;範囲は中央の20*20
(define (set-random)
  (define start (- (/ n 2) 10))
  (define end (+ (/ n 2) 10)) 
  
  (matrix-map! (lambda (x) 0) mat1) 
  (do ((i start (+ i 1))) 
      ((> i end))
      (do ((j start (+ j 1))) 
          ((> j end)) 
          (if (= (random-integer 10) 0) 
              (matrix-set! mat1 i j 1))))) 


;;描画
;;画面を500*500とみて行列を指定して描かせる。これをmat1,mat2について交互に行う。
(define (disp)
  (cond ((= sw 1)
         (next-1->2)
         (disp-mat mat2)
         (set! sw 2))
        ((= sw 2)
         (next-2->1)
         (disp-mat mat1)
         (set! sw 1))))

;;行列を描画する。
(define (disp-mat mat)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 0 0 1)
  (do ((i 2 (+ i 1)))
      ((> i n))
      (do ((j 2 (+ j 1)))
          ((> j n))
          (if (= (matrix-ref mat i j) 1)
              (disp-quad i j))))
  (gl-flush))

                           
;;上記下請け関数
;;行列のi,j成分に相当する位置に四角を描く。
(define (disp-quad i j)
  (gl-begin GL_QUADS)
  (let* ((x1 (* quad-size (- i 1)))
         (y1 (* quad-size (- j 1)))
         (x2 (+ x1 quad-size))
         (y2 y1)
         (x3 x2)
         (y3 (+ y1 quad-size))
         (x4 x1)
         (y4 y3))
    (gl-vertex x1 y1)
    (gl-vertex x2 y2)
    (gl-vertex x3 y3)
    (gl-vertex x4 y4))
  (gl-end))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho -0.5 (- w 0.5)  (- h 0.5) -0.5 -1.0 1.0))

;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))
        ((= key (char->integer #\r)) (reset))))

;;リセット
;;初期行列を乱数で生成し描画する。
(define (reset)
  (set-random)
  (set! sw 1)
  (disp-mat mat1))

;;マウス操作
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;初期化
;;背景色は白
(define (init)
  (gl-clear-color 1 1 1 1)
  (set-random))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 500 500)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "lifegame")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)


Open-glは奥が深いのでしょうけれどもわかりやすい本(「OpenGL入門」床井先生)のお蔭で 雰囲気はわかってきました。こんどは自分で何か考えて作ってみて知識を消化したいと思っています。 2次元の単純なもの、ライフゲームだったら簡単に作れそうに思います。2010/12/18 00:18:56 PST

材質を設定

赤の材質に緑の光を当てるとこんな感じなのかなぁ。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver1.2  材質を設定する。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))

;;面の色データ
;;データは#f32で与えるのが最も効率がよい。
(define color 
  '(#f32(1 0 0)
    #f32(0 1 0)
    #f32(0 0 1)
    #f32(1 1 0)
    #f32(1 0 1)
    #f32(0 1 1)))

;;光源のデータ、法線ベクトル
(define normal
  '(#f32(0 0 -1)
    #f32(1 0 0)
    #f32(0 0 1)
    #f32(-1 0 0)
    #f32(0 -1 0)
    #f32(0 1 0)))

;;光源の位置
(define light0-pos #f32(0 3 5 1))

(define light1-pos #f32(5 3 0 1))

;;光源の色グリーンと赤
(define green #f32(0 1 0 1))

(define red #f32(0.8 0.2 0.2 1))

;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '(#f32(0 0 0)
    #f32(1 0 0)
    #f32(1 1 0)
    #f32(0 1 0)
    #f32(0 0 1)
    #f32(1 0 1)
    #f32(1 1 1)
    #f32(0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))



;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      
      ;;光源の位置設定
      (gl-light GL_LIGHT0 GL_POSITION light0-pos)
      (gl-light GL_LIGHT1 GL_POSITION light1-pos)
      
      ;;図形回転
      (gl-rotate r 0 1 0)
      
      ;;図形の色、赤
      (gl-material GL_FRONT_AND_BACK GL_DIFFUSE red)
      
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。
      (for-each (lambda (f c)
                  (gl-normal c) ;;光を当てる。
                  (for-each (lambda (v)
                              (gl-vertex (nth vertex v))) f)) face normal)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1)
  (gl-enable GL_DEPTH_TEST)
  (gl-enable GL_CULL_FACE)
  (gl-cull-face GL_FRONT)
  (gl-enable GL_LIGHTING)
  (gl-enable GL_LIGHT0)
  (gl-enable GL_LIGHT1)
  (gl-light GL_LIGHT1 GL_DIFFUSE green)
  (gl-light GL_LIGHT1 GL_SPECULAR green))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH)) 
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)


ユニフォームvector、光源を2つへ

#s32 だとうまくいかなくて#f32にしたらうまく色がでました。なぜ?

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver1.1 光源を2つにする。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))

;;面の色データ
(define color 
  '((1 0 0)
    (0 1 0)
    (0 0 1)
    (1 1 0)
    (1 0 1)
    (0 1 1)))

;;光源のデータ、法線ベクトル
(define normal
  '((0 0 -1)
    (1 0 0)
    (0 0 1)
    (-1 0 0)
    (0 -1 0)
    (0 1 0)))

;;光源の位置
;;データは#s32,#f32で与えることとなっているのだけれど、#f32でないと
;;グリーンにならない。#f32を使った方がよさそう。理由はわからない。
(define light0-pos #f32(0 3 5 1))

(define light1-pos #f32(5 3 0 1))

;;光源の色グリーン
(define green #f32(0 1 0 1))

;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;色データをリストで受け取って(gl-color x y z)を呼び出す。
(define (gl-color3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-color x y z)))

;;光源の法線ベクトルデータ(リスト)を受け取って(gl-normal x y z)を呼び出す。
(define (gl-normal3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-normal x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      
      ;;光源の位置設定
      (gl-light GL_LIGHT0 GL_POSITION light0-pos)
      (gl-light GL_LIGHT1 GL_POSITION light1-pos)
      
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。面に色をつける。
      (for-each (lambda (f c)
                  (gl-normal3d c) ;;光を当てる。
                  (for-each (lambda (v)
                              (gl-vertex3d (nth vertex v))) f)) face color)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1)
  (gl-enable GL_DEPTH_TEST)
  (gl-enable GL_CULL_FACE)
  (gl-cull-face GL_FRONT)
  (gl-enable GL_LIGHTING)
  (gl-enable GL_LIGHT0)
  (gl-enable GL_LIGHT1)
  (gl-light GL_LIGHT1 GL_DIFFUSE green)
  (gl-light GL_LIGHT1 GL_SPECULAR green))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)


Gaucheをぜひとも高校授業へ

Gauche-gl、これはたまらなく面白いです。最初にさわったPC6001並みの手軽さがありながら、三次元の高度なこともできます。これはすごいことです。受験数学ってのはほんとにほんとにクソつまらなかったのですが、こっちのグラフィクスなどコンピューターに使われている数学は生きた数学、動く数学です。数式処理、グラフ、線形代数、Gaucheの力を借りて高校生に送り届けたい気持ちです。 これは私のライフワーク。2010/12/17 18:43:30 PST

光を当てる。へ~、そんな風になるんだ。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver1.0 光源をあてる。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))

;;面の色データ
(define color 
  '((1 0 0)
    (0 1 0)
    (0 0 1)
    (1 1 0)
    (1 0 1)
    (0 1 1)))

;;光源のデータ、法線ベクトル
(define normal
  '((0 0 -1)
    (1 0 0)
    (0 0 1)
    (-1 0 0)
    (0 -1 0)
    (0 1 0)))


;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;色データをリストで受け取って(gl-color x y z)を呼び出す。
(define (gl-color3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-color x y z)))

;;光源の法線ベクトルデータ(リスト)を受け取って(gl-normal x y z)を呼び出す。
(define (gl-normal3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-normal x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。面に色をつける。
      (for-each (lambda (f c)
                  (gl-normal3d c) ;;光を当てる。
                  (for-each (lambda (v)
                              (gl-vertex3d (nth vertex v))) f)) face color)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1)
  (gl-enable GL_DEPTH_TEST)
  (gl-enable GL_CULL_FACE)
  (gl-cull-face GL_FRONT)
  (gl-enable GL_LIGHTING)
  (gl-enable GL_LIGHT0))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

カリング。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.9 カリング、なんか形が歪になってしまう。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))

;;面の色データ
(define color 
  '((1 0 0)
    (0 1 0)
    (0 0 1)
    (1 1 0)
    (1 0 1)
    (0 1 1)))


;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;色データをリストで受け取って(gl-color x y z)を呼び出す。
(define (gl-color3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-color x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。面に色をつける。
      (for-each (lambda (f c)
                  (gl-color3d c)
                  (for-each (lambda (v)
                              (gl-vertex3d (nth vertex v))) f)) face color)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1)
  (gl-enable GL_DEPTH_TEST)
  (gl-enable GL_CULL_FACE)
  (gl-cull-face GL_BACK))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

デプスバッファ それなに? 裏側が見えなくなった。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.8 デプスバッファってなんだ?ああ、裏側が見えなくなったよ。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))

;;面の色データ
(define color 
  '((1 0 0)
    (0 1 0)
    (0 0 1)
    (1 1 0)
    (1 0 1)
    (0 1 1)))


;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;色データをリストで受け取って(gl-color x y z)を呼び出す。
(define (gl-color3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-color x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。面に色をつける。
      (for-each (lambda (f c)
                  (gl-color3d c)
                  (for-each (lambda (v)
                              (gl-vertex3d (nth vertex v))) f)) face color)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1)
  (gl-enable GL_DEPTH_TEST))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

カラフルな立方体。でも、ちょっと変。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.7 立方体を面として表示する。カラフルな立方体がマウス操作で動き出す。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))

;;面の色データ
(define color 
  '((1 0 0)
    (0 1 0)
    (0 0 1)
    (1 1 0)
    (1 0 1)
    (0 1 1)))


;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;色データをリストで受け取って(gl-color x y z)を呼び出す。
(define (gl-color3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-color x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear GL_COLOR_BUFFER_BIT)
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。面に色をつける。
      (for-each (lambda (f c)
                  (gl-color3d c)
                  (for-each (lambda (v)
                              (gl-vertex3d (nth vertex v))) f)) face color)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

立方体を面で表示する。黒い物体?2010/12/17 06:13:33 PST

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.6 立方体を面として表示する。黒い立方体がマウス操作で動き出す。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;立方体の面のデータ
(define face
  '((0 1 2 3)
    (1 5 6 2)
    (5 4 7 6)
    (4 0 3 7)
    (4 5 1 0)
    (3 2 6 7)))


;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear GL_COLOR_BUFFER_BIT)
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_QUADS)
      ;;面集合リストから立方体を描画する。
      (for-each (lambda (f) 
                  (for-each (lambda (v)
                              (gl-vertex3d (nth vertex v))) f)) face)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

ダブルバッファリング 速い! C言語の | はたぶん (logior )

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.5 立方体をアニメーションで動かす。ダブルバッファリング追加
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear GL_COLOR_BUFFER_BIT)
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_LINES)
      ;;辺集合リストから立方体を描画する。
      (for-each (lambda (e) 
                  (gl-vertex3d (nth vertex (car e)))
                  (gl-vertex3d (nth vertex (cadr e)))) edge)
      (gl-end)
      (glut-swap-buffers)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1))

(define (main)
  (glut-init '())
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE)) ;; これでいいのかな?
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

右手系 

OpenGL,よくよく図をみると右手系みたい。数学で習った時には上方向がZ軸だったので違和感がある。 けれどZ軸を横方向と考えれば多分、右手系なはず。違ったら教えてください。2010/12/17 01:53:12 PST

アニメーション 動いた。面白いね~。昔懐かしいスタートレックでも作りたいなぁ。 2010/12/17 00:58:06 PST

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.4 立方体をアニメーションで動かす。
;;左マウスボタンを押し続けると回転。離すと停止。右マウスボタンをクリックすると一コマ回転。
;;起動は対話モードから(main)、終了はESCキー。

(use gl)
(use gl.glut)

;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;描画
(define disp
  (let ((r 0))
    (lambda ()
      (gl-clear GL_COLOR_BUFFER_BIT)
      (gl-load-identity)
      ;;視点設定、視線方向設定
      (glu-look-at 3 4 5 0 0 0 0 1 0)
      ;;図形回転
      (gl-rotate r 0 1 0)
      (gl-color 0 0 0)
      (gl-begin GL_LINES)
      ;;辺集合リストから立方体を描画する。
      (for-each (lambda (e) 
                  (gl-vertex3d (nth vertex (car e)))
                  (gl-vertex3d (nth vertex (cadr e)))) edge)
      (gl-end)
      (gl-flush)
      (inc! r)
      (when (>= r 360)
        (set! r 0))
      )))

;;アイドル状態で呼び出される。
(define (idle)
  (glut-post-redisplay))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  
  (gl-matrix-mode GL_MODELVIEW))

;;マウス入力
(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-idle-func idle)
             ;;idle状態での実行を停止。マニュアルには書いてないけど無効は#fでいいのかな?
             (glut-idle-func #f)))
        ((= button GLUT_RIGHT_BUTTON)
         (if (= state GLUT_DOWN)
             (glut-post-redisplay)))))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1 1 1 1))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

やっとできた。2010/12/16 03:38:21 PST

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver1.2マウスで線を書く。再描画をする。
;;起動は対話モードから(main)
;;あれこれと試行錯誤のうえでやっと所定動作、確認。
;;マウス左ボタンを押した位置から移動後マウス左ボタンを話した位置までに線を引く。

(use gl)
(use gl.glut)

;;描画した座標はリストに((xn yn)...(x2 y2)(x1 y1))で記憶する。
;;再描画でこの座標を使う。
(define point-list '())


;;再描画
;;複数の頂点についてgl-vertex GL_LINESを行うと奇数番目と偶数番目の点の対に線が引かれる。
;;奇数個の頂点について行うと最後の1個は対になっておらずこれには線は引かれない。
;;リストは時系列の古い頂点は右側にあるのでリバースしてから描画する。マウスを押した時点で
;;再描画がかかると新しい方の頂点から再描画しているとおかしな結果になる。
;;再描画はマウスボタンの押す、離すだけでも起動しており窓の移動以外に頻繁に再描画が行われている。
(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 1 1 1)
  (gl-begin GL_LINES)
  (for-each (lambda (v) (gl-vertex (car v) (cadr v))) (reverse point-list))
  (gl-end)
  (gl-flush))


;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho -0.5 (- w 0.5)  (- h 0.5) -0.5 -1.0 1.0))

;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

;;マウス操作
;;描画の挙動がおかしなときにはgl-flushを落としてないか確認。
;;gl-begin* を使っても同じはずなのだけれど、なぜか描画の挙動が異なる。
;;シンプルにgl-begin gl-end で記述した方がよさそう。
(define (mouse button state x y)
  (cond ((and (= state GLUT_DOWN)(= button GLUT_LEFT_BUTTON))
         (set! point-list (cons (list x y) point-list)))
        ((and (= state GLUT_UP) (= button GLUT_LEFT_BUTTON))
         (set! point-list (cons (list x y) point-list))
         (let* ((vn (car point-list))
                (vn-1 (cadr point-list))
                (xn (car vn))
                (yn (cadr vn))
                (xn-1 (car vn-1))
                (yn-1 (cadr vn-1)))
           (gl-color 1 1 1)
           (gl-begin GL_LINES)
           (gl-vertex xn-1 yn-1)
           (gl-vertex xn yn)
           (gl-end)
           (gl-flush)))))

  
;;初期化
;;背景色は青
(define (init)
  (gl-clear-color 0 0 1 1))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 320 240)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)

SICP図形言語をOpen-GLの今のところの知識でなんとか表示してみました。2010/12/15 07:52:16 PST

lebel綴りまちがってる。levelのつもり。

;;; Open-GLの学習
;;; SICP図形言語より
;;; 使い方
;;;対話モードで(main)で起動。
;;;ESCキーで終了、a~eのキーを押すと図形が描画される。
;;;1~9のキーを押すと図形の再帰レベルが変化する。
;;;大文字のR,G,B,Yを押すと線の色が赤、緑、青、黄になる。


(use gl)
(use gl.glut)

(define pict 'a);;図形の種類
(define lebel 3);;図形の再帰レベル
(define color 'B);;線の色


(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (cond ((eq? color 'R) (gl-color 1 0 0))
        ((eq? color 'G) (gl-color 0 1 0))
        ((eq? color 'B) (gl-color 0 0 1))
        ((eq? color 'Y) (gl-color 1 1 0)))
  (cond ((eq? pict 'a) (disp-a))
        ((eq? pict 'b) (disp-b))
        ((eq? pict 'c) (disp-c))
        ((eq? pict 'd) (disp-d))
        ((eq? pict 'e) (disp-e)))
  (gl-flush))


(define (disp-a)
  ((corner-split wave lebel) full-frame))

(define (disp-b)
  ((square-limit wave lebel) full-frame))

(define (disp-c)
  ((up-split wave lebel) full-frame))

(define (disp-d)
  ((right-split wave lebel) full-frame))

(define (disp-e)
  ((up-split wave lebel) full-frame))

(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho (- (/ w 400.0)) (/ w 400.0) (- (/ h 400.0)) (/ h 400.0) -1.0 1.0))

(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))
        ((= key (char->integer #\a)) (set! pict 'a)(disp))
        ((= key (char->integer #\b)) (set! pict 'b)(disp))
        ((= key (char->integer #\c)) (set! pict 'c)(disp))
        ((= key (char->integer #\d)) (set! pict 'd)(disp))
        ((= key (char->integer #\e)) (set! pict 'e)(disp))
        ((and (>= key (char->integer #\1))
              (<= key (char->integer #\9))) (set! lebel (- key (char->integer #\0)))(disp))
        ((= key (char->integer #\R)) (set! color 'R)(disp))
        ((= key (char->integer #\G)) (set! color 'G)(disp))
        ((= key (char->integer #\B)) (set! color 'B)(disp))
        ((= key (char->integer #\Y)) (set! color 'Y)(disp))))

(define (init)
  (gl-clear-color 1 1 1 1))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 640 480)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "pict-language")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)



(define height 2)
(define width 2)

(define (draw-line v1 v2)
  (let ((x1 (- (xcor-vect v1) 1))
        (y1 (- (ycor-vect v1) 1))
        (x2 (- (xcor-vect v2) 1))
        (y2 (- (ycor-vect v2) 1)))
    (gl-begin* GL_LINES
         (gl-vertex x1 y1)
         (gl-vertex x2 y2))))


;;以下SICP図形言語より

(define (frame-coord-map frame)
  (lambda (v)
    (add-vect
      (origin-frame frame)
      (add-vect (scale-vect (xcor-vect v)
                            (edge1-frame frame))
                (scale-vect (ycor-vect v)
                            (edge2-frame frame))))))

;;; 問題2.46

(define (make-vect x y)
  (cons x y))

(define (xcor-vect v)
  (car v))

(define (ycor-vect v)
  (cdr v))

(define (add-vect v1 v2)
  (make-vect (+ (xcor-vect v1)
                (xcor-vect v2))
             (+ (ycor-vect v1)
                (ycor-vect v2))))

(define (sub-vect v1 v2)
  (make-vect (- (xcor-vect v1)
                (xcor-vect v2))
             (- (ycor-vect v1)
                (ycor-vect v2))))

(define (scale-vect s v)
  (make-vect (* s (xcor-vect v))
             (* s (ycor-vect v))))


;;; 問題2.47
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

(define (origin-frame frame)
  (car frame))

(define (edge1-frame frame)
  (cadr frame))

(define (edge2-frame frame)
  (caddr frame))

(define full-frame (make-frame (make-vect 0 0)
                               (make-vect width 0)
                               (make-vect 0 height)))



(define (segments->painter segment-list)
  (lambda (frame)
    (for-each
      (lambda (segment)
        (draw-line 
          ((frame-coord-map frame) (start-segment segment))
          ((frame-coord-map frame) (end-segment segment))))
      segment-list)))

(define (make-segment v1 v2)
  (cons v1 v2))

(define (start-segment s)
  (car s))

(define (end-segment s)
  (cdr s))

;;; 問題2.49
(define wave
  (segments->painter
    (list (make-segment (make-vect 0.000 0.645) (make-vect 0.154 0.411))
          (make-segment (make-vect 0.154 0.411) (make-vect 0.302 0.588))
          (make-segment (make-vect 0.302 0.588) (make-vect 0.354 0.497))
          (make-segment (make-vect 0.354 0.497) (make-vect 0.245 0.000))
          (make-segment (make-vect 0.419 0.000) (make-vect 0.497 0.171))
          (make-segment (make-vect 0.497 0.171) (make-vect 0.575 0.000))
          (make-segment (make-vect 0.748 0.000) (make-vect 0.605 0.462))
          (make-segment (make-vect 0.605 0.462) (make-vect 1.000 0.142))
          (make-segment (make-vect 1.000 0.354) (make-vect 0.748 0.657))
          (make-segment (make-vect 0.748 0.657) (make-vect 0.582 0.657))
          (make-segment (make-vect 0.582 0.657) (make-vect 0.640 0.857))
          (make-segment (make-vect 0.640 0.857) (make-vect 0.575 1.000))
          (make-segment (make-vect 0.419 1.000) (make-vect 0.354 0.857))
          (make-segment (make-vect 0.354 0.857) (make-vect 0.411 0.657))
          (make-segment (make-vect 0.411 0.657) (make-vect 0.285 0.657))
          (make-segment (make-vect 0.285 0.657) (make-vect 0.154 0.605))
          (make-segment (make-vect 0.154 0.605) (make-vect 0.000 0.857)))))
;;; ちゃんとした図形にするのはけっこう大変なので、データを和田先生の解答から拝借しました。

(define (transform-painter painter origin corner1 corner2)
  (lambda (frame)
    (let ((m (frame-coord-map frame)))
      (let ((new-origin (m origin)))
        (painter
          (make-frame new-origin
                      (sub-vect (m corner1) new-origin)
                      (sub-vect (m corner2) new-origin)))))))

(define (flip-vert painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 0.0)))


(define (shrink-to-upper-right painter)
  (transform-painter painter
                     (make-vect 0.5 0.5)
                     (make-vect 1.0 0.5)
                     (make-vect 0.5 1.0)))

(define (rotate90 painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 0.0)))

(define (squash-inwards painter)
  (transform-painter painter
                     (make-vect 0.0 0.0)
                     (make-vect 0.65 0.35)
                     (make-vect 0.35 0.65)))

(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
            (transform-painter painter1
                               (make-vect 0.0 0.0)
                               split-point
                               (make-vect 0.0 1.0)))
          (paint-right
            (transform-painter painter2
                               split-point
                               (make-vect 1.0 0.0)
                               (make-vect 0.5 1.0))))
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

;;; 問題2.50
;;; 
(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

;;; 問題2.51
;;; 
(define (below painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-left
            (transform-painter painter1
                               (make-vect 0.0 0.0)
                               (make-vect 1.0 0.0)
                               split-point))
                               
          (paint-right
            (transform-painter painter2
                               split-point
                               (make-vect 1.0 0.5)
                               (make-vect 0.0 1.0))))
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(define (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))



あれ、図形が動くぞ。gl-rotateを加えてみたらなぜかマウスボタンで回転をする。不思議。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.3 立方体を描く。なぜかマウスボタンを押すと図形が動く。
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;辺集合リストから立方体を描画する。
(define (disp2 edge-ls)
  (cond ((null? edge-ls) (gl-end))
        (else 
          (let* ((e (car edge-ls))
                 (v1 (nth vertex (car e)))
                 (v2 (nth vertex (cadr e))))
            (gl-vertex3d v1)
            (gl-vertex3d v2))
          (disp2 (cdr edge-ls)))))


;;描画
(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-rotate 25 0 1 0.5) ;;追加してみた。マウスボタンを押すとなぜか図形が回転する。
  (gl-color 0 0 0)
  (gl-begin GL_LINES)
  (disp2 edge)
  (gl-flush))

;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (glu-perspective 30 (/ w h) 1 100)
  (gl-translate 0 0 -5))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)


立方体を表示する。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.2 立方体を描く。ただし、今のバージョンでは正方形にしか見えない。
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

;;図形は頂点と辺からなる。グラフのような感じ。
;;頂点の集合と辺の集合はリストで表す。
;;座標は整数で与えても問題ないみたいだ。
(define vertex
  '((0 0 0)
    (1 0 0)
    (1 1 0)
    (0 1 0)
    (0 0 1)
    (1 0 1)
    (1 1 1)
    (0 1 1)))

(define edge
  '((0 1)
    (1 2)
    (2 3)
    (3 0)
    (4 5)
    (5 6)
    (6 7)
    (7 4)
    (0 4)
    (1 5)
    (2 6)
    (3 7)))

;;リストの最初の要素は0番目
(define (nth ls n)
  (if (= n 0)
      (car ls)
      (nth (cdr ls) (- n 1))))

;;3次元の座標をリストで受け取って(gl-vertex x y z)を呼び出す。
(define (gl-vertex3d ls)
  (let ((x (car ls))
        (y (cadr ls))
        (z (caddr ls)))
    (gl-vertex x y z)))

;;辺集合リストから立方体を描画する。
(define (disp2 edge-ls)
  (cond ((null? edge-ls) (gl-end))
        (else 
          (let* ((e (car edge-ls))
                 (v1 (nth vertex (car e)))
                 (v2 (nth vertex (cadr e))))
            (gl-vertex3d v1)
            (gl-vertex3d v2))
          (disp2 (cdr edge-ls)))))


;;描画
(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 0 0 0)
  (gl-begin GL_LINES)
  (disp2 edge)
  (gl-flush))

;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho -2 2 -2 2 -2 2))



;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-keyboard-func keyboard)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)

今度は3D。座標系が数学で習ったのとは違うような。たしか右手系はこうじゃなかったような。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.1 3Dに挑戦
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-rotate 25.0 0.0 1.0 0.0) ;;y軸方向へ25度回転
  (gl-begin* GL_POLYGON
             (gl-color 1.0 0.0 0.0);赤
             (gl-vertex -0.9 -0.9)
             (gl-color 0.0 1.0 0.0);緑
             (gl-vertex 0.9 -0.9)
             (gl-color 0.0 0.0 1.0);青
             (gl-vertex 0.9 0.9)
             (gl-color 1.0 1.0 0.0);黄
             (gl-vertex -0.9 0.9))
  (gl-flush))

;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)

再描画

マウスで線を引いた後、さらにマウスで線を引くと以前の線は消えてしまいます? そういうものなのでしょうか? やり方がわからないので非効率ながらマウスアップボタンの 都度、最初の座標から再描画しています。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver1.1,マウスで線を書く。再描画をする。
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

;;描画した座標はリストに((xn yn)...(x2 y2)(x1 y1))で記憶する。
;;再描画でこの座標を使う。
(define point-list '())

;;上記のリストを引数としてそれらについて(gl-vertex x y) を行う。
(define (disp1 ls)
  (cond ((null? ls) (gl-end))
        (else (let ((x (caar ls))
                    (y (cadar ls)))
                (gl-begin GL_LINES)
                (gl-vertex x y))
              (disp1 (cdr ls)))))

;;再描画
(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 1.0 1.0 1.0)
  (disp1 point-list)
  (gl-flush))

;;リサイズ
(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  ;;;(gl-ortho (- (/ w 200.0)) (/ w 200.0) (- (/ h 200.0)) (/ h 200.0) -1.0 1.0)
  (gl-ortho -0.5 (- w 0.5)  (- h 0.5) -0.5 -1.0 1.0)
)

;;キー入力
(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

;;マウス操作
;;cond式はロジックがわかりやすいように書いたので冗長になってる。
(define (mouse button state x y)
  (cond ((and (= button GLUT_LEFT_BUTTON) (= state GLUT_DOWN))
         (set! point-list (cons (list x y) point-list)))
        ((and (= button GLUT_LEFT_BUTTON) (= state GLUT_UP))
         (set! point-list (cons (list x y) point-list))
         ;;↓は再描画の関数を使っている。オリジナルの通りにやると以前、書いた線が消えてしまう。
         ;;線が消えない方法がわからないので非効率ながら都度、全部再描画している。
         ;;どうしたらいいのだろう???
         (disp))))


;;初期化
;;背景色は青
(define (init)
  (gl-clear-color 0.0 0.0 1.0 1.0))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 320 240)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)


マウスで線を引く

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver1.0,マウスで線を書く。
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
;;;   (gl-begin* GL_POLYGON
;;;              (gl-color 1.0 0.0 0.0);赤
;;;              (gl-vertex -0.9 -0.9)
;;;              (gl-color 0.0 1.0 0.0);緑
;;;              (gl-vertex 0.9 -0.9)
;;;              (gl-color 0.0 0.0 1.0);青
;;;              (gl-vertex 0.9 0.9)
;;;              (gl-color 1.0 1.0 0.0);黄
;;;              (gl-vertex -0.9 0.9))
  (gl-flush))

(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  ;;;(gl-ortho (- (/ w 200.0)) (/ w 200.0) (- (/ h 200.0)) (/ h 200.0) -1.0 1.0)
  (gl-ortho -0.5 (- w 0.5)  (- h 0.5) -0.5 -1.0 1.0)
)

(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))


;;sicpにこんなのあったなぁ。乱数だっけ。
;;勉強会ではお世話になりました。
;;前に書いた線は消えるけどいいのかな。
(define mouse
  (let ((x0 0)
        (y0 0))
    (lambda (button state x y)
      (cond ((= button GLUT_LEFT_BUTTON)
             (when (= state GLUT_UP)
               (gl-color 1.0 0.0 0.0)
               (gl-begin* GL_LINES
                          (gl-vertex x0 y0)
                          (gl-vertex x y))
               (gl-flush))))
      (set! x0 x)
      (set! y0 y))))  

(define (init)
  (gl-clear-color 0.0 0.0 1.0 1.0))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 320 240)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)


マウス入力

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.9,マウス位置をprintする。ただし終了してから書き出されてる。
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
;;;   (gl-begin* GL_POLYGON
;;;              (gl-color 1.0 0.0 0.0);赤
;;;              (gl-vertex -0.9 -0.9)
;;;              (gl-color 0.0 1.0 0.0);緑
;;;              (gl-vertex 0.9 -0.9)
;;;              (gl-color 0.0 0.0 1.0);青
;;;              (gl-vertex 0.9 0.9)
;;;              (gl-color 1.0 1.0 0.0);黄
;;;              (gl-vertex -0.9 0.9))
  (gl-flush))

(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  ;;;(gl-ortho (- (/ w 200.0)) (/ w 200.0) (- (/ h 200.0)) (/ h 200.0) -1.0 1.0))
)

(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (mouse button state x y)
  (cond ((= button GLUT_LEFT_BUTTON) (print "left"))
        ((= button GLUT_MIDDLE_BUTTON) (print "middle"))
        ((= button GLUT_RIGHT_BUTTON) (print "right")))
  (print " button is ")
  (cond ((= state GLUT_UP) (print "up"))
        ((= state GLUT_DOWN) (print "down")))
  (print "at " x y)) 

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 320 240)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)

キー入力

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.8、ESCキーを押すと終了する
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-begin* GL_POLYGON
             (gl-color 1.0 0.0 0.0);赤
             (gl-vertex -0.9 -0.9)
             (gl-color 0.0 1.0 0.0);緑
             (gl-vertex 0.9 -0.9)
             (gl-color 0.0 0.0 1.0);青
             (gl-vertex 0.9 0.9)
             (gl-color 1.0 1.0 0.0);黄
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho (- (/ w 200.0)) (/ w 200.0) (- (/ h 200.0)) (/ h 200.0) -1.0 1.0))

(define (keyboard key x y)
  (cond ((= key (char->integer #\escape)) (exit))))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 320 240)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)


位置とサイズを指定

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.7、位置とサイズを指定
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-begin* GL_POLYGON
             (gl-color 1.0 0.0 0.0);赤
             (gl-vertex -0.9 -0.9)
             (gl-color 0.0 1.0 0.0);緑
             (gl-vertex 0.9 -0.9)
             (gl-color 0.0 0.0 1.0);青
             (gl-vertex 0.9 0.9)
             (gl-color 1.0 1.0 0.0);黄
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho (- (/ w 200.0)) (/ w 200.0) (- (/ h 200.0)) (/ h 200.0) -1.0 1.0))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init-window-position 100 100)
  (glut-init-window-size 320 240)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)


リサイズ、あれ?うまくいかない。

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.6、リサイズ
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-begin* GL_POLYGON
             (gl-color 1.0 0.0 0.0);赤
             (gl-vertex -0.9 -0.9)
             (gl-color 0.0 1.0 0.0);緑
             (gl-vertex 0.9 -0.9)
             (gl-color 0.0 0.0 1.0);青
             (gl-vertex 0.9 0.9)
             (gl-color 1.0 1.0 0.0);黄
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (resize w h)
  (gl-viewport 0 0 w h)
  (gl-load-identity)
  (gl-ortho (- (/ w 200.0)) (/ w 200.0) (- (/ h 200.0)) (/ h 200.0) -1.0 1.0))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-reshape-func resize)
  (init)
  (glut-main-loop)
  0)


虹みたい!

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.5、図形を塗りつぶす,色分け、虹みたい
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-begin* GL_POLYGON
             (gl-color 1.0 0.0 0.0);赤
             (gl-vertex -0.9 -0.9)
             (gl-color 0.0 1.0 0.0);緑
             (gl-vertex 0.9 -0.9)
             (gl-color 0.0 0.0 1.0);青
             (gl-vertex 0.9 0.9)
             (gl-color 1.0 1.0 0.0);黄
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (init)
  (glut-main-loop)
  0)


図形を塗りつぶす

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.5、図形を塗りつぶす
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 1.0 0.0 0.0)
  (gl-begin* GL_POLYGON
             (gl-vertex -0.9 -0.9)
             (gl-vertex 0.9 -0.9)
             (gl-vertex 0.9 0.9)
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (init)
  (glut-main-loop)
  0)


線に色をつける

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.4、線に色をつける
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 1.0 0.0 0.0)
  (gl-begin* GL_LINE_LOOP
             (gl-vertex -0.9 -0.9)
             (gl-vertex 0.9 -0.9)
             (gl-vertex 0.9 0.9)
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (init)
  (gl-clear-color 0.0 0.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (init)
  (glut-main-loop)
  0)


線を引く

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.3 線を引く
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-begin* GL_LINE_LOOP
             (gl-vertex -0.9 -0.9)
             (gl-vertex 0.9 -0.9)
             (gl-vertex 0.9 0.9)
             (gl-vertex -0.9 0.9))
  (gl-flush))

(define (init)
  (gl-clear-color 0.0 0.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (init)
  (glut-main-loop)
  0)

塗りつぶす

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.2 窓を塗りつぶす
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-flush))

(define (init)
  (gl-clear-color 0.0 0.0 1.0 1.0))

(define (main)
  (glut-init '())
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "test")
  (glut-display-func disp)
  (init)
  (glut-main-loop)
  0)

グラフィクスって面白い

3Dだと線形変換、変換行列が出てきたりで面白いですね~。線形代数習っておいてよかったぁ。 以前、買ってあった本をもとにglutの使い方を勉強し始めました。2010/12/14 01:26:00 PST

;;「GLUTによるOpenGL入門」床井浩平著より
;;ver0.1 窓を開くだけ
;;起動は対話モードから(main)

(use gl)
(use gl.glut)

(define (disp)
  )

(define (main)
  (glut-init '())
  (glut-create-window "test")
  (glut-display-func disp)
  (glut-main-loop)
  0)

ご質問 gl glutについて

①仕事場のノートパソコンでgearsを動かした時にはとても高速で歯車の回転が見えないほどなのですが、自宅のデスクトップで動かすとかなり動作が遅いようです。動作終了後にFPSという単位の数値が表示されますが、一桁ちがってます。ノートは800くらいでデスクトップは50くらいでした。性能的にはデスクトップの方がグラフィックボード(GeForce)も高性能なはずなんですが、どうしてでしょう?

②GLUTはmainloopに入ると終了するまで制御を戻してこないようです。私は対話的にグラフィクスを描かせたいのですが、ループ中で(read)でS式を読み、それに応じて描画をするということは可能でしょうか?

③gl、glutライブラリのコードを参考にしようとファイルを探してみたのですが見つけられません。どのフォルダーに保管されているのでしょうか?

ご教示いただければ幸いです。2010/12/13 16:22:45 PST

ご報告 Gauche0.91 for Windows

Ver0.91、早速試してみました。インストールはまったく問題なく進み、Open-GLのサンプル、gearsも何の問題もなく動作しました。グラフィクスが簡便に使えるようになるので、いいですね~。これを使っていろいろとグラフィクスのコードを書いてみたいと思っています。OSはVistaです。 2010/12/13 01:13:18 PST

数式処理のコードが中途でした。高校レベルの問題集を解かせていて正解を出せないものがあり、 そのデバッグで中途になっていました。デバッグツールを作ればいいのかも。数式処理は中途の数式が前置記法で多重な入れ子になっているためにわかりにくくなっています。これを中置記法に直して 中途の計算過程を見えるようにするツールを組み込めばデバッグも進むかもしれません。下地先生に成果報告をお約束してからかれこれ3年近くになりますでしょうか。途中、入院があったりで大幅に遅れていましたが、なんとかしなくては。2010/12/12 15:53:55 PST

あ、それにこんど出るGauche0.91のWindows版にはひょっとしてOpen-GLが標準添付なのでしょうか? そしたら数式処理に組み合わせてなんとかグラフィクスも組み込みたいものです。


Last modified : 2012/03/18 11:10:15 UTC