(display "\nex-2.44 - a picture language\n") ; One solution for 2.51 (define (below painter1 painter2) (let ((paint-top (transform-painter painter2 (make-vect 0.0 0.5) (make-vect 1.0 0.5) (make-vect 0.0 1.0))) (paint-bottom (transform-painter painter1 (make-vect 0.0 0.0) (make-vect 1.0 0.0) (make-vect 0.0 0.5)))) (lambda (frame) (lambda (draw-line) ((paint-top frame) draw-line) ((paint-bottom frame) draw-line))))) (define (beside painter1 painter2) (let ((split-point (make-vect 0.5 0.0))) (let ((paint-left (transform-painter painter1 (make-vect 0.0 0.0) split-point (make-vect 0.0 1.0))) (paint-right (transform-painter painter2 split-point (make-vect 1.0 0.0) (make-vect 0.5 1.0)))) (lambda (frame) (lambda (draw-line) ((paint-left frame) draw-line) ((paint-right frame) draw-line)))))) (define (right-split painter n) (if (= n 0) painter (let ((smaller (right-split painter (- n 1)))) (beside painter (below smaller smaller))))) (define (corner-split painter n) (if (= n 0) painter (let ((up (up-split painter (- n 1))) (right (right-split painter (- n 1)))) (let ((top-left (beside up up)) (bottom-right (below right right)) (corner (corner-split painter (- n 1)))) (beside (below painter top-left) (below bottom-right corner)))))) (define (up-split painter n) (if (= n 0) painter (let ((smaller (up-split painter (- n 1)))) (below painter (beside smaller smaller))))) (display "\nex-2.45\n") (define (split main-placer smaller-placer) (define (rec painter n) (if (= n 0) painter (let ((smaller (rec painter (- n 1)))) (main-placer painter (smaller-placer smaller smaller))))) rec) (define right-split (split beside below)) (define up-split (split below beside)) (display "\nex-2.46\n") (define (frame-coord-map frame) (lambda (v) (add-vect (origin-frame frame) (add-vect (scale-vect (xcor-vect v) (edge1-frame frame)) (scale-vect (ycor-vect v) (edge2-frame frame)))))) (define make-vect cons) (define xcor-vect car) (define ycor-vect cdr) (define (add-vect v w) (make-vect (+ (xcor-vect v) (xcor-vect w)) (+ (ycor-vect v) (ycor-vect w)))) (define (sub-vect v w) (make-vect (- (xcor-vect v) (xcor-vect w)) (- (ycor-vect v) (ycor-vect w)))) (define (scale-vect s v) (make-vect (* s (xcor-vect v)) (* s (ycor-vect v)))) (define (frame-coord-map frame) (lambda (v) (add-vect (origin-frame frame) (add-vect (scale-vect (xcor-vect v) (edge1-frame frame)) (scale-vect (ycor-vect v) (edge2-frame frame)))))) (display "\nex-2.47\n") (define (make-frame origin edge1 edge2) (list origin edge1 edge2)) (define origin-frame car) (define edge1-frame cadr) (define edge2-frame caddr) (define (make-frame origin edge1 edge2) (cons origin (cons edge1 edge2))) (define origin-frame car) (define edge1-frame cadr) (define edge2-frame cddr) (display "\nex-2.48\n") (define (segments->painter segment-list) (lambda (frame) (lambda (draw-line) (for-each (lambda (segment) (draw-line ((frame-coord-map frame) (start-segment segment)) ((frame-coord-map frame) (end-segment segment)))) segment-list)))) (define make-segment list) (define start-segment car) (define end-segment cadr) (display "\nex-2.49\n") (define simple-frame (make-frame (make-vect 0 1080) (make-vect 1920 0) (make-vect 0 -1080))) (define (make-line x1 y1 x2 y2) (make-segment (make-vect x1 y1) (make-vect x2 y2))) (define painter-outline (segments->painter (list (make-line 0 0 0 1) (make-line 0 0 1 0) (make-line 1 0 1 1) (make-line 0 1 1 1)))) (define painter-x (segments->painter (list (make-line 0 0 1 1) (make-line 0 1 1 0)))) (define painter-diamond (segments->painter (list (make-line 0.5 0 0 0.5) (make-line 0.5 0 1 0.5) (make-line 0 0.5 0.5 1) (make-line 1 0.5 0.5 1)))) ; from here: http://wiki.drewhess.com/wiki/SICP_exercise_2.49 (define painter-wave (segments->painter (list (make-line 0.4 0 0.5 0.33) (make-line 0.5 0.33 0.6 0.0) (make-line 0.25 0.0 0.33 0.5) (make-line 0.33 0.5 0.3 0.6) (make-line 0.3 0.6 0.1 0.4) (make-line 0.1 0.4 0.0 0.6) (make-line 0.0 0.6 0.0 0.8) (make-line 0.0 0.8 0.1 0.6) (make-line 0.1 0.6 0.33 0.65) (make-line 0.33 0.65 0.4 0.65) (make-line 0.4 0.65 0.35 0.8) (make-line 0.35 0.8 0.4 1.0) (make-line 0.4 1.0 0.6 1.0) (make-line 0.75 0.0 0.6 0.45) (make-line 0.6 0.45 1.0 0.15) (make-line 1.0 0.15 1.0 0.35) (make-line 1.0 0.35 0.8 0.65) (make-line 0.8 0.65 0.6 0.65) (make-line 0.6 0.65 0.65 0.8) (make-line 0.65 0.8 0.6 1.0)))) (load "misc/draw.scm") (draw-to-py (painter-diamond simple-frame) "wave") (display "\nex-2.50\n") (define (transform-painter painter origin corner1 corner2) (lambda (frame) (let ((m (frame-coord-map frame))) (let ((new-origin (m origin))) (painter (make-frame new-origin (sub-vect (m corner1) new-origin) (sub-vect (m corner2) new-origin))))))) (define (flip-vert painter) (transform-painter painter (make-vect 0.0 1.0) ; new origin (make-vect 1.0 1.0) ; new end of edge1 (make-vect 0.0 0.0))) ; new end of edge2 (draw-to-py ((flip-vert painter-wave) simple-frame) "wave-flipped") (define (shrink-to-upper-right painter) (transform-painter painter (make-vect 0.5 0.5) (make-vect 1.0 0.5) (make-vect 0.5 1.0))) (draw-to-py ((shrink-to-upper-right painter-wave) simple-frame) "wave-shrinked") (define (rotate90 painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (draw-to-py ((rotate90 painter-wave) simple-frame) "wave-rotated") (define (flip-horiz painter) (transform-painter painter (make-vect 1.0 0.0) ; new origin (make-vect 0.0 0.0) ; new end of edge1 (make-vect 1.0 1.0))) ; new end of edge2 (define (rotate180 painter) (transform-painter painter (make-vect 1.0 1.0) (make-vect 0.0 1.0) (make-vect 1.0 0.0))) ; both works of course (define (rotate270 painter) (rotate90 (rotate90 (rotate90 painter)))) (define (rotate270 painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) (draw-to-py ((beside painter-wave painter-diamond) simple-frame) "wave-beside-diamond") (display "\nex-2.51\n") ; First implementation is at the beginning of this file. (draw-to-py ((below painter-x painter-diamond) simple-frame) "x-below-diamond-1") (define (below painter1 painter2) (rotate270 (beside (rotate90 painter2) (rotate90 painter1)))) (draw-to-py ((below painter-x painter-diamond) simple-frame) "x-below-diamond-2") (display "\nex-2.52\n") ; a. (define painter-wave-smile (segments->painter (list (make-line 0.4 0 0.5 0.33) (make-line 0.5 0.33 0.6 0.0) (make-line 0.25 0.0 0.33 0.5) (make-line 0.33 0.5 0.3 0.6) (make-line 0.3 0.6 0.1 0.4) (make-line 0.1 0.4 0.0 0.6) (make-line 0.0 0.6 0.0 0.8) (make-line 0.0 0.8 0.1 0.6) (make-line 0.1 0.6 0.33 0.65) (make-line 0.33 0.65 0.4 0.65) (make-line 0.4 0.65 0.35 0.8) (make-line 0.43 0.87 0.46 0.87) ; left eye (make-line 0.54 0.87 0.57 0.87) ; right eye (make-line 0.45 0.75 0.55 0.75) ; smile (make-line 0.35 0.8 0.4 1.0) (make-line 0.4 1.0 0.6 1.0) (make-line 0.75 0.0 0.6 0.45) (make-line 0.6 0.45 1.0 0.15) (make-line 1.0 0.15 1.0 0.35) (make-line 1.0 0.35 0.8 0.65) (make-line 0.8 0.65 0.6 0.65) (make-line 0.6 0.65 0.65 0.8) (make-line 0.65 0.8 0.6 1.0)))) (draw-to-py (painter-wave-smile simple-frame) "wave-smile") ; b. (define (corner-split-adapted painter n) (if (= n 0) painter (let ((up (up-split painter (- n 1))) (right (right-split painter (- n 1)))) (let ((top-left up) (bottom-right right) (corner (corner-split-adapted painter (- n 1)))) (beside (below painter top-left) (below bottom-right corner)))))) (draw-to-py ((corner-split-adapted painter-wave 3) simple-frame) "corner-split-3") ; c. didn't do anything here (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))))