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