sicp-2.2.4
Posted on 2015-02-20 07:20:40 +0900 in SICP
package used
Drracket picture language is used.
#lang racket
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
2.44
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
2.45
(define (split op1 op2)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller ((split op1 op2) painter (- n 1))))
(op1 painter (op2 smaller smaller))))))
2.46
(define (make-vect x y)
(cons x y))
(define (xcor-vect v)
(car v))
(define (ycor-vect v)
(cdr v))
(define (add-vect u v)
(make-vect
(+ (xcor-vect u) (xcor-vect v))
(+ (ycor-vect u) (ycor-vect v))))
(define (sub-vect u v)
(make-vect
(- (xcor-vect u) (xcor-vect v))
(- (ycor-vect u) (ycor-vect v))))
(define (scale-vect s v)
(make-vect
(* s (xcor-vect v))
(* s (ycor-vect v))))
2.47
(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(caddr frame))
(define (make-frame origin edge1 edge2)
(cons origin (cons edge1 edge2)))
(define (origin-frame frame)
(car frame))
(define (edge1-frame frame)
(cadr frame))
(define (edge2-frame frame)
(cddr frame))
2.48
(define (make-segment u v)
(cons u v))
(define (start-segment segment)
(car segment))
(define (end-segment segment)
(cdr segment))
2.49
(define (draw-outline frame)
((segments->painter
(list (make-segment (make-vect 0 0)
(make-vect 1 0))
(make-segment (make-vect 1 0)
(make-vect 1 1))
(make-segment (make-vect 1 1)
(make-vect 0 1))
(make-segment (make-vect 0 1)
(make-vect 0 0)))
frame)))
(define (draw-X frame)
((segments->painter
(list (make-segment (make-vect 0 0)
(make-vect 1 1))
(make-segment (make-vect 1 0)
(make-vect 0 1))))
frame))
(define (draw-diamond frame)
((segments->painter
(list (make-segment (make-vect 0.5 0.0)
(make-vect 1.0 0.5))
(make-segment (make-vect 1.0 0.5)
(make-vect 0.5 1.0))
(make-segment (make-vect 0.5 1.0)
(make-vect 0.0 0.5))
(make-segment (make-vect 0.0 0.5)
(make-vect 0.5 0.0))))
2.50
(define (flip-horiz painter)
(transform-painter painter
(make-vect 1 0)
(make-vect 0 0)
(make-vect 1 1)))
(define (rotate180 painter)
(transform-painter painter
(make-vect 1 1)
(make-vect 0 1)
(make-vect 1 0)))
(define (rotate270 painter)
(transform-painter painter
(make-vect 0 1)
(make-vect 0 0)
(make-vect 1 1)))
2.51
Hint from the wqzhang, which is very elegant.
(define (below painter1 painter2)
(rotate90 (beside (rotate270 painter1)
(rotate270 painter2))))
Hide Comments
comments powered by Disqus