#lang sicp (#%require sicp-pict) (define (flipped-pairs painter) (let ((painter2 (beside painter (flip-vert painter)))) (below painter2 painter2))) (define (right-spilt painter n) (if (= n 0) painter (let ((smaller (right-spilt painter (dec n)))) (beside painter (below smaller smaller))))) (define (up-split painter n) (if (= n 0) painter (let ((smaller (up-split painter (dec n)))) (below painter (beside smaller smaller))))) (define (corner-spilt painter n) (if (= n 0) painter (let ((up (up-split painter (dec n))) (right (right-spilt painter (dec n)))) (let ((top-left (beside up up)) (bottom-right (below right right)) (corner (corner-spilt painter (dec n)))) (beside (below painter top-left) (below bottom-right corner)))))) (define (square-limit painter n) (let ((quarter (corner-spilt painter n))) (let ((half (beside (flip-horiz quarter) quarter))) (below (flip-vert half) half)))) (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 (split children-parent children) (lambda (parent n) (if (= n 0) parent (let ((child ((split children-parent children) parent (dec n)))) (children-parent parent (children child child)))))) (define make-vect cons) (define xcor-vect car) (define ycor-vect cdr) (define (add-vect v1 v2) (make-vect (+ (xcor-vect v1) (xcor-vect v2)) (+ (ycor-vect v1) (ycor-vect v2)))) (define (sub-vect v1 v2) (make-vect (- (xcor-vect v1) (xcor-vect v2)) (- (ycor-vect v1) (ycor-vect v2)))) (define (scale-vect s v) (make-vect (* s (xcor-vect v)) (* s (ycor-vect v)))) (define (make-frame origin edge1 edge2) (cons origin (cons edge1 edge2))) (define origin-frame car) (define edge1-frame cadr) (define edge2-frame cddr) (define (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))))) (define (xxx frame) (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 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)))))