Chapter 2.2.4
Picture Language
Exercise 2.44
(define (align-operator combiner op1 op2)
(lambda (painter) (combiner (op1 painter) (op2 painter))))
(define align-vert (align-operator below identity identity))
(define align-horiz (align-operator beside identity identity))
(define (up-split painter n)
(if (= n 0) painter
(below painter (align-horiz (up-split painter (- n 1))))))
Exercise 2.45
(define right-split (split beside below))
(define up-split (split below beside))
(define (split align-identity align-splitted)
(define (splitter painter n)
(if (= n 0) painter
(align-identity painter
((align-operator align-splitted)
(splitter painter (- n 1))))))
splitter)
以降はFrame, Painterの実装について
Exercise 2.46
; vector constructor and selectors
; vector operating procedures
(define make-vect cons)
(define x-vect car)
(define y-vect cdr)
(define (add-vect u v)
(make-vect (+ (x-vect u) (x-vect v))
(+ (y-vect u) (y-vect v))))
(define (sub-vect u v)
(make-vect (- (x-vect u) (x-vect v))
(- (y-vect u) (y-vect v))))
(define (scale-vect a v)
(make-vect (* a (x-vect v)) (* a (y-vect v))))
Exercise 2.47
; implementing a frame
(define (make-frame1 origin h-edge v-edge) (list origin h-edge v-edge))
(define origin-frame1 car)
(define h-edge-frame1 (lambda (x) (car (cdr x))))
(define v-edge-frame1 (lambda (x) (car (cdr (cdr x)))))
(define (make-frame2 origin h-edge v-edge) (cons origin (cons h-edge v-edge)))
(define origin-frame2 car)
(define h-edge-frame2 (lambda (x) (cdr (car x))))
(define v-edge-frame2 (lambda (x) (cdr (cdr x))))
Exercise 2.48
; segment:線分 = 始点, 終点
(define make-segment cons)
(define start-segment car)
(define end-segment cdr)
Exercise 2.49
implementing some primitive painters
; outline: draws the outlines of the given frame
; diagonal: draws an X by connecting opposite corners
; diamond: draws a diamond shape by connecting midpoint of sides
; wave
(define outline (segment->painter
(list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 0.0))
(make-segment (make-vect 1.0 0.0) (make-vect 1.0 1.0))
(make-segment (make-vect 1.0 1.0) (make-vect 0.0 1.0))
(make-segment (make-vect 0.0 1.0) (make-vect 0.0 0.0)))))
(define diagonal (segment->painter
(list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0))
(make-segment (make-vect 1.0 0.0) (make-vect 0.0 1.0)))))
(define diamond (segment->painter
(list (make-segment (make-vect 0.0 0.5) (make-vect 0.5 1.0))
(make-segment (make-vect 0.5 1.0) (make-vect 0.5 0.0))
(make-segment (make-vect 0.5 0.0) (make-vect 0.0 0.5)))))
(define wave (segment->painter
(list (make-segment (make-vect 0.0 0.86) (make-vect 0.14 0.6))
(make-segment (make-vect 0.14 0.6) (make-vect 0.25 0.64))
(make-segment (make-vect 0.25 0.64) (make-vect 0.39 0.64))
(make-segment (make-vect 0.39 0.64) (make-vect 0.36 0.86))
(make-segment (make-vect 0.36 0.86) (make-vect 0.39 1.0)) ;;
(make-segment (make-vect 0.61 1.0) (make-vect 0.64 0.86))
(make-segment (make-vect 0.64 0.86) (make-vect 0.61 0.64))
(make-segment (make-vect 0.61 0.64) (make-vect 0.75 0.64))
(make-segment (make-vect 0.75 0.64) (make-vect 1.0 0.35)) ;;
(make-segment (make-vect 0.0 0.64) (make-vect 0.14 0.39))
(make-segment (make-vect 0.14 0.39) (make-vect 0.25 0.6))
(make-segment (make-vect 0.25 0.6) (make-vect 0.36 0.5))
(make-segment (make-vect 0.36 0.5) (make-vect 0.25 0.0)) ;;
(make-segment (make-vect 0.39 0.0) (make-vect 0.5 0.29))
(make-segment (make-vect 0.5 0.29) (make-vect 0.61 0.0)) ;;
(make-segment (make-vect 0.75 0.0) (make-vect 0.61 0.47))
(make-segment (make-vect 0.61 0.47) (make-vect 1.0 0.14)))))
Exercise 2.50
(define (flip-vert painter)
(transform-painter painter
(make-vect 0.0 1.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))
(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)))
(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 (rotate90 painter)
(transform-painter painter
(make-vect 1.0 0.0)
(make-vect 1.0 1.0)
(make-vect 0.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)))
Exercise 2.51
(define (beside painter1 painter2)
(let ((paint-left (transform-painter painter1
(make-vect 0.0 0.0)
(make-vect 0.5 0.0)
(make-vect 0.0 1.0)))
(paint-right (transform-painter painter2
(make-vect 0.5 0.0)
(make-vect 1.0 0.0)
(make-vect 0.5 1.0))))
(lambda (frame)
(paint-left frame)
(paint-right frame))))
(define (below painter1 painter2)
(let ((paint-bottom (transform-painter painter1
(make-vect 0.0 0.0)
(make-vect 1.0 0.0)
(make-vect 0.0 0.5)))
(paint-top (transform-painter painter2
(make-vect 0.0 0.5)
(make-vect 1.0 0.5)
(make-vect 0.0 1.0))))
(lambda (frame)
(paint-top frame)
(paint-bottom frame))))
