Scheme - 図形言語(ペインタの変換と組み合わせ、フレーム変換、頑健な設計のための言語レベル、成層設計)

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• OS X Lion - Apple(OS)
• Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
• プログラミング言語: MIT/GNU Scheme

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション)の2(データによる抽象の構築)、2.2(階層データ構造と閉包)、2.2.4(例: 図形言語)の問題 2.50、問題 2.51、問題 2.52を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題 2.50

コード

sample.scm

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

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

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

問題 2.51

コード

sample.scm

(define (below painter1 painter2)
  (let ((paint-below (transform-painter painter1
                                        (make-vect 0.0 0.0)
                                        (make-vect 1.0 0.0)
                                        (make-vect 0.0 0.5)))
        (paint-up (transform-painter painter2
                                     (make-vect 0.0 0.5)
                                     (make-vect 1.0 0.5)
                                     (make-vect 0.0 1.0))))
    (lambda (frame)
      (paint-below frame)
      (paint-up frame))))

; 回転演算を使ってbelow演算を定義
(define (below-r painter1 painter2)
  (let ((rotate270-painter1 (rotate270 painter1))
        (rotate270-painter2 (rotate270 painter2)))
    (let ((painter (beside rotate270-painter1 rotate270-painter-2)))
      (lambda (frame) (painter frame)))))

問題 2.52

コード

sample.scm

;a
(define (make-smile-wave frame)
  (define smile (segments->painter
                  (list (make-segment (make-vect 0.375 0.925)
                                      (make-vect 0.475 0.975))
                        (make-segment (make-vect 0.575 0.975)
                                      (make-vect 0.675 0.925))
                        (make-segment (make-vect 0.425 0.8)
                                      (make-vect 0.5 0.775))
                        (make-segment (make-vect 0.5 0.775)
                                      (make-vect 0.575 0.8)))))
  (wave frame)
  (smile frame))

; b
(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up-painter (up-split painter (- n 1)))
            (right-painter (right-split painter (- n 1)))
            (corner-painter (corner-split painter (- n 1))))
        (beside (below painter up-painter)
                (below right-painter corner-painter)))))

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

2013/06/02 追記:

ブラウザ上で描画(線分の場合)を作成。JavaScript - Schemeの図形言語(picture language)をHTML5のcanvas要素で実装)