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.45、問題 2.46、問題 2.47、問題 2.48、問題 2.49を解いてみる。

その他参考書籍

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

問題 2.45

コード

sample.scm

(define (split proc-1 proc-2)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split proc-1 proc-2) painter (- n 1))))
          (proc-1 painter (proc-2 smaller smaller))))))

問題 2.46

コード

sample.scm

(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)
  (let ((x1 (xcor-vect v1))
        (y1 (ycor-vect v1))
        (x2 (xcor-vect v2))
        (y2 (ycor-vect v2)))
    (make-vect (+ x1 x2) (+ y1 y2))))

(define (sub-vect v1 v2)
  (let ((x1 (xcor-vect v1))
        (y1 (ycor-vect v1))
        (x2 (xcor-vect v2))
        (y2 (ycor-vect v2)))
    (make-vect (- x1 x2) (- y1 y2))))

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

問題 2.47

コード

sample.scm

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

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

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

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

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

(define (edge2-frame-cons frame)
  (cddr frame))

問題 2.48

コード

sample.scm

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

(define (start-segment v) 
  (car v))

(define (end-segment v) 
  (cdr v))

問題 2.49

コード

sample.scm

(define outline-painter
  (segments->painter
    (list (make-segment (make-vect 0 0)
                        (make-vect 0 1))
          (make-segment (make-vect 0 1)
                        (make-vect 1 1))
          (make-segment (make-vect 1 1)
                        (make-vect 1 0))
          (make-segment (make-vect 1 0)
                        (make-vect 0 0)))))

(define x-painter
  (segments->painter
    (list (make-segment (make-vect 0 0)
                        (make-vect 1 1))
          (make-segment (make-vect 1 0)
                        (make-vect 0 1)))))

(define diamond-painter
  (segments->painter
    (list (make-segment (make-vect 0.5 0)
                        (make-vect 0 0.5))
          (make-segment (make-vect 0 0.5)
                        (make-vect 0.5 1))
          (make-segment (make-vect 0.5 1)
                        (make-vect 1 0.5))
          (make-segment (make-vect 1 0.5)
                        (make-vect 0.5 0)))))

(define wave
  (segments->painter
    (list (make-segment (make-vect 0.25 0)
                        (make-vect 0.3 0.6))
          (make-segment (make-vect 0.3 0.6)
                        (make-vect 0.275 0.65))
          (make-segment (make-vect 0.275 0.65)
                        (make-vect 0.2 0.5))
          (make-segment (make-vect 0.2 0.5)
                        (make-vect 0 0.7))
          (make-segment (make-vect 0 0.8)
                        (make-vect 0.2 0.65))
          (make-segment (make-vect 0.2 0.65)
                        (make-vect 0.3 0.7))
          (make-segment (make-vect 0.3 0.7)
                        (make-vect 0.4 0.7))
          (make-segment (make-vect 0.4 0.7)
                        (make-vect 0.35 0.9))
          (make-segment (make-vect 0.35 0.9)
                        (make-vect 0.4 1))
          (make-segment (make-vect 0.6 1)
                        (make-vect 0.65 0.9))
          (make-segment (make-vect 0.65 0.9)
                        (make-vect 0.6 0.7))
          (make-segment (make-vect 0.6 0.7)
                        (make-vect 0.7 0.7))
          (make-segment (make-vect 0.7 0.7)
                        (make-vect 1 0.4))
          (make-segment (make-vect 1 0.2)
                        (make-vect 0.6 0.5))
          (make-segment (make-vect 0.6 0.5)
                        (make-vect 0.75 0))
          (make-segment (make-vect 0.6 0)
                        (make-vect 0.5 0.25))
          (make-segment (make-vect 0.5 0.25)
                        (make-vect 0.4 0)))))

waveは図を見ながら大雑把に定義。

HTML5のcanvas要素、JavaScriptとかを使って実際に出力して合ってるか確かめてみたいけど、とりあえず先に進むことを優先することに。本書を最後まで終えてから、ブラウザ上に描けるように実装してみるかも。

2013/06/02 追記:

ブラウザ上に描けるように実装。JavaScript - Schemeの図形言語(picture language)をHTML5のcanvas要素で実装)