2.2.4 - 図形言語 (前半 - 2.45まで)

図形を出せるようにしよう。

から、glut-3.7.6-bin.zip (117 KB) をダウンロードし
glut32.dll を C:/windows/system以下とかsystem32以下とかに置く。
そして、

から、gauche-glをダウンロードして、cygwin等でコンパイルしてインストール。
具体的には、config -> make -> make check -> make install
cygwin用のgaucheやmakeをインストールしてから実行する。
glutのバージョン違いで嵌ったので、その時点で最新のものを使うように気をつける。
glutの勉強は

などで、簡単に行った。本筋ではないので基本的なとこだけ。


さて、これで、線は表示できるようになった。
rogersを表示するのはまたあとにしてwaveのものを作る。


とりあえず、基本手続き、painter beside below flip-vert flip-horizを定義する必要がある。
ここで、painterはデータを内包した手続きであり、その他の手続きはpainterをとり、新しいpainterを返す手続きである。


painterは内部にポイントの位置情報のlistを内包した手続きにするのが妥当であろうと考える。
内包された位置情報は、割合(x,yとも0〜1)によって表現されており、
painter手続きはleft-bottomとright-topの実際の位置を与えられると、
内包されたポイントの実際の位置情報をlistとして返す。


そのようなpainterを作る手続き、make-painterを定義する。

(define (make-painter list)
  (lambda (left-bottom right-top)
    (let ((width (- (car right-top) (car left-bottom)))
          (height (- (cdr right-top) (cdr left-bottom))))
      (map (lambda (item) (cons (+ (car left-bottom)
                                   (* width (car item)))
                                (+ (cdr left-bottom)
                                   (* height (cdr item))))) list))))

たとえば、painterは以下のように定義する。

(define p1 (make-painter (list '(0.0 . 0.2) '(1.0 . 1.0))))

これを元にbeside,below,flip-vert,flip-horizを定義していく。
これらの手続きは、painterをひとつもしくは二つとり新しいpainterを返す手続きである。
以下のように定義できるだろう。

(define (beside left-painter right-painter)
  (make-painter
   (append (left-painter '(0.0 . 0.0) '(0.5 . 1.0))
           (right-painter '(0.5 . 0.0) '(1.0 . 1.0)))))

(define (below bottom-painter top-painter)
  (make-painter
   (append (bottom-painter '(0.0 . 0.0) '(1.0 . 0.5))
           (top-painter '(0.0 . 0.5) '(1.0 . 1.0)))))

(define (flip-vert painter)
  (make-painter (map (lambda (item)
                       (cons (car item) (- 1.0 (cdr item))))
                     (painter '(0.0 . 0.0) '(1.0 . 1.0)))))

(define (flip-horiz painter)
  (make-painter (map (lambda (item)
                       (cons (- 1.0 (car item)) (cdr item)))
                     (painter '(0.0 . 0.0) '(1.0 . 1.0)))))

最後にpainterを実際に描画する手続き、paintを作る。

(define (paint painter)
  (for-each (lambda (item)
              (gl-vertex (car item) (cdr item)))
            (painter '(-1.0 . -1.0) '(1.0 . 1.0))))

これで終わりで、後はSICPにも載ってる手続きたちを加えれば完成する。


で、それらを加え、gauche-glを使い、最終的に実際に動くコードは以下。

(use gl)
(use gl.glut)

(define (make-painter list)
  (lambda (left-bottom right-top)
    (let ((width (- (car right-top) (car left-bottom)))
          (height (- (cdr right-top) (cdr left-bottom))))
      (map (lambda (item) (cons (+ (car left-bottom)
                                   (* width (car item)))
                                (+ (cdr left-bottom)
                                   (* height (cdr item))))) list))))
(define (paint painter)
  (for-each (lambda (item)
              (gl-vertex (car item) (cdr item)))
            (painter '(-1.0 . -1.0) '(1.0 . 1.0))))

(define (beside left-painter right-painter)
  (make-painter
   (append (left-painter '(0.0 . 0.0) '(0.5 . 1.0))
           (right-painter '(0.5 . 0.0) '(1.0 . 1.0)))))

(define (below bottom-painter top-painter)
  (make-painter
   (append (bottom-painter '(0.0 . 0.0) '(1.0 . 0.5))
           (top-painter '(0.0 . 0.5) '(1.0 . 1.0)))))

(define (flip-vert painter)
  (make-painter (map (lambda (item)
                       (cons (car item) (- 1.0 (cdr item))))
                     (painter '(0.0 . 0.0) '(1.0 . 1.0)))))

(define (flip-horiz painter)
  (make-painter (map (lambda (item)
                       (cons (- 1.0 (car item)) (cdr item)))
                     (painter '(0.0 . 0.0) '(1.0 . 1.0)))))

(define (split f1 f2)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split f1 f2) painter (- n 1))))
        (f1 painter (f2 smaller smaller))))))

(define right-split (split beside below))
(define up-split (split below beside))

(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))))

(define p1 (make-painter (list '(0.0 . 0.2) '(1.0 . 1.0))))


(define (main args)
  (glut-init args)
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "SICP 2.2.4")
  (glut-display-func display)
  (init)
  (glut-main-loop))

(define (display)
  (gl-clear-color 1.0 1.0 1.0 1.0)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 1.0 0.0 0.0)
  (gl-begin GL_LINES)
  (paint (square-limit p1 4))
  (gl-end)
  (gl-flush))

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

実際に動いているところ