93 lines
No EOL
3.5 KiB
Scheme
93 lines
No EOL
3.5 KiB
Scheme
#lang sicp
|
|
|
|
(#%require sicp-pict)
|
|
|
|
|
|
; a) modified wave:
|
|
(define wave
|
|
(segments->painter
|
|
(list (make-segment (make-vect 0 0.55)
|
|
(make-vect 0.2 0.5))
|
|
(make-segment (make-vect 0.2 0.5)
|
|
(make-vect 0.4 0.6))
|
|
(make-segment (make-vect 0.4 0.6)
|
|
(make-vect 0.35 0.8))
|
|
(make-segment (make-vect 0.35 0.8)
|
|
(make-vect 0.4 1))
|
|
(make-segment (make-vect 0.6 1)
|
|
(make-vect 0.65 0.8))
|
|
(make-segment (make-vect 0.65 0.8)
|
|
(make-vect 0.6 0.6))
|
|
(make-segment (make-vect 0.6 0.6)
|
|
(make-vect 0.8 0.7))
|
|
(make-segment (make-vect 0.8 0.7)
|
|
(make-vect 1 0.55))
|
|
(make-segment (make-vect 1 0.45)
|
|
(make-vect 0.8 0.6))
|
|
(make-segment (make-vect 0.8 0.6)
|
|
(make-vect 0.6 0.5))
|
|
(make-segment (make-vect 0.6 0.5)
|
|
(make-vect 0.6 0.3))
|
|
(make-segment (make-vect 0.6 0.3)
|
|
(make-vect 0.7 0))
|
|
(make-segment (make-vect 0.6 0)
|
|
(make-vect 0.5 0.2))
|
|
(make-segment (make-vect 0.5 0.2)
|
|
(make-vect 0.4 0))
|
|
(make-segment (make-vect 0.3 0)
|
|
(make-vect 0.4 0.3))
|
|
(make-segment (make-vect 0.4 0.3)
|
|
(make-vect 0.4 0.5))
|
|
(make-segment (make-vect 0.4 0.5)
|
|
(make-vect 0.2 0.4))
|
|
(make-segment (make-vect 0.2 0.4)
|
|
(make-vect 0 0.45))
|
|
(make-segment (make-vect 0.4 0.85) ; modifications to wave:
|
|
(make-vect 0.45 0.85)) ;
|
|
(make-segment (make-vect 0.55 0.85) ;
|
|
(make-vect 0.6 0.85)) ;
|
|
(make-segment (make-vect 0.4 0.75) ;
|
|
(make-vect 0.5 0.7)) ;
|
|
(make-segment (make-vect 0.5 0.7) ;
|
|
(make-vect 0.6 0.75)) ;
|
|
(make-segment (make-vect 0.6 0.75) ;
|
|
(make-vect 0.4 0.75))))) ;
|
|
|
|
(define (right-split painter n)
|
|
(if (= n 0)
|
|
painter
|
|
(let ((right-split-1 (right-split painter (- n 1))))
|
|
(beside painter
|
|
(below right-split-1 right-split-1)))))
|
|
|
|
|
|
(define (up-split painter n)
|
|
(if (= n 0)
|
|
painter
|
|
(let ((smaller (up-split painter (- n 1))))
|
|
(below painter
|
|
(beside smaller smaller)))))
|
|
|
|
(define (corner-split painter n)
|
|
(if (= n 0)
|
|
painter
|
|
(let ((smaller-r (right-split painter (- n 1)))
|
|
(smaller-u (up-split painter (- n 1)))
|
|
(smaller-c (corner-split painter (- n 1))))
|
|
(below (beside painter
|
|
(below (below smaller-r smaller-r) ; changes to
|
|
(below smaller-r smaller-r))) ; corner split
|
|
(beside (beside (beside smaller-u smaller-u) ;
|
|
(beside smaller-u smaller-u)) ;
|
|
smaller-c)))))
|
|
|
|
(define (square-of-four tl tr bl br)
|
|
(lambda (painter)
|
|
(let ((top (beside (tl painter) (tr painter)))
|
|
(bottom (beside (bl painter) (br painter))))
|
|
(below bottom top))))
|
|
|
|
(define (square-limit painter n)
|
|
(let ((combine4 (square-of-four flip-vert rotate180 ; changes to square-limit
|
|
identity flip-horiz))) ;
|
|
(combine4 (corner-split painter n)))) |