SICP 読み (33) 2.2.4 例: 図形言語
読めば読むほどおもしろい。特に frame と painter の実装とか変換の実装をみるに、成程というレベルを越えた興味深さと言えば良いのか分からんが、凄い。
オブジェクト (というか属性を持った手続き) が戻される形になっているのも凄いな。
frame
edge1 や edge2 が frame 原点からの変位でないと駄目だし、渡すベクトルも単位方形内にあれば、真っ当な値が戻ってくる。数学な基本が全部ヌケちゃってるんで、こんなくそ馬鹿な感想しか書けませんが、とても面白い。
あと、frame-coord-map は frame を受け取って手続きを返すんですが、その手続きに単位方形 (square units) を渡すと frame 内における位置がきっちり戻るあたりがキモ。
painter
例示されている painter を生成する手続きも、線分のリストを渡して手続きが戻される。逆に言えば戻ってくる手続きには、線分のリストが内包されている、と言えば良いのか。
ここでも frame-coord-map を上手に使ってるなぁ、という印象。
変換と組み合わせ
がしかし、上記な手続きを上手に組み合わせた transform-painter がまたまた凄い。なんか白痴的な感想しか申し述べる事しかできないんですが、本当にびっくり。
transform-painter に渡す frame な引数 (単位方形なベクタ) もイメージしやすくって、なんてエレガントなんだ、と小一時間 (以下略
描画
一応、2.48 も 2.49 も試験ドリブンなソレで確認は完了したんですが、どっかからパクッてきたソレを元に以下のようなものをでっち上げた。
main.scm
(use gl) (use gl.glut) (load "./2.48") (define (disp) (gl-clear GL_COLOR_BUFFER_BIT) (gl-color '#f32(0.0 0.0 0.0)) (gl-begin GL_LINES) (stub-proc) (gl-end) (gl-flush) ) (define (init) (gl-clear-color 1.0 1.0 1.0 0.0) (gl-matrix-mode GL_PROJECTION) (gl-load-identity) ; (gl-ortho 0.0 1.0 0.0 1.0 -1.0 1.0) ) (define (keyboard key x y) (cond ((= key 27) (exit 0)) )) (define (main args) (glut-init args) (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB)) (glut-init-window-size 250 250) ; (glut-init-window-size 800 600) (glut-init-window-position 100 100) (glut-create-window "hello") (init) (glut-display-func disp) (glut-keyboard-func keyboard) (glut-main-loop) 0)
もひとつ。
2.48.scm
(define (make-vect x y)
(list x y))
(define (xcor-vect v)
(car v))
(define (ycor-vect v)
(cadr 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))))
(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
(define (origin-frame f)
(car f))
(define (edge1-frame f)
(cadr f))
(define (edge2-frame f)
(caddr f))
(define (make-segment start-vect end-vect)
(list start-vect end-vect))
(define (start-segment segment)
(car segment))
(define (end-segment segment)
(cadr segment))
(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))))))
(define (draw-line s e)
(gl-vertex (xcor-vect s) (ycor-vect s))
(gl-vertex (xcor-vect e) (ycor-vect e)))
(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 (stub-proc)
(define l1 (make-segment (make-vect 0.0 0.5) (make-vect 0.2 0.3)))
(define l2 (make-segment (make-vect 0.2 0.3) (make-vect 0.3 0.5)))
(define l3 (make-segment (make-vect 0.3 0.5) (make-vect 0.4 0.4)))
(define l4 (make-segment (make-vect 0.4 0.4) (make-vect 0.3 0.0)))
(define l5 (make-segment (make-vect 0.4 0.0) (make-vect 0.5 0.2)))
(define l6 (make-segment (make-vect 0.5 0.2) (make-vect 0.6 0.0)))
(define l7 (make-segment (make-vect 0.7 0.0) (make-vect 0.6 0.4)))
(define l8 (make-segment (make-vect 0.6 0.4) (make-vect 1.0 0.3)))
(define l9 (make-segment (make-vect 1.0 0.4) (make-vect 0.7 0.6)))
(define la (make-segment (make-vect 0.7 0.6) (make-vect 0.6 0.6)))
(define lb (make-segment (make-vect 0.6 0.6) (make-vect 0.7 0.8)))
(define lc (make-segment (make-vect 0.7 0.8) (make-vect 0.6 1.0)))
(define ld (make-segment (make-vect 0.4 1.0) (make-vect 0.3 0.8)))
(define le (make-segment (make-vect 0.3 0.8) (make-vect 0.4 0.6)))
(define lf (make-segment (make-vect 0.4 0.6) (make-vect 0.3 0.6)))
(define lg (make-segment (make-vect 0.3 0.6) (make-vect 0.2 0.5)))
(define lh (make-segment (make-vect 0.2 0.5) (make-vect 0.0 0.8)))
(define p (segments->painter (list l1 l2 l3 l4 l5 l6 l7 l8 l9 la lb
lc ld le lf lg lh)))
(define f (make-frame (make-vect -1.0 -1.0)
(make-vect 2.0 0)
(make-vect 0 2.0)))
(p f)
)main.scm は使いマワシ可能と見てるんですが ...
# しかも wave 君のアタマでかスギ。
失敗
くそ。試験なソレで作った map なナニは beside とか below で微妙な動きをしやがる事に今気づいた。自分の微妙さ加減に腹が立つ。
例えば beside だとこんなしないと動作確認できぬ。
(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)
(cons
(paint-left frame)
(paint-right frame))))))単体試験、って意味ではダウトじゃね?
スルーしている解は確認取れて以降に晒します。にしても、問題 2.52 が面白そうで。
# あ、そーゆー意味じゃ、square-limit も見れるな。
追記
一応、試験で確認取れたはずなんで解も以下に。
問題 2.50
flip-horiz が以下。
(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)))反時計回りに 180 度
(define (rotate180-rev painter) (transform-painter painter (make-vect 1.0 1.0) (make-vect 0.0 1.0) (make-vect 1.0 0.0)))
反時計回りに 270 度
(define (rotate270-rev painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0)))
試験がダウトだったら微妙だな。(を
問題 2.51
below の一つ目
(define (below1 painter1 painter2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-upper
(transform-painter painter1
split-point
(make-vect 1.0 0.5)
(make-vect 0.0 1.0)))
(paint-lower
(transform-painter painter2
(make-vect 0.0 0.0)
(make-vect 1.0 0.0)
split-point)))
(lambda (frame)
(cons
(paint-upper frame)
(paint-lower frame)))))
)二つ目
(define (rotate90 painter)
(transform-painter painter
(make-vect 0.0 1.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0)))
(define (rotate90-rev painter)
(transform-painter painter
(make-vect 1.0 0.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))
(define (below2 painter1 painter2)
(lambda (frame)
((rotate90 (beside (rotate90-rev painter1)
(rotate90-rev painter2)))
frame))
)試験したら微妙な数値で試験が失敗してて、なんでかね、と思ってたら
(make-vect 1.1 1.1)
とかやってた。とほほスギ。
問題 2.52 は絶対面白いぞ。
# あ、そいえば実際に描画してみて確認もした方が良いな。
