321 lines
9.6 KiB
Scheme
321 lines
9.6 KiB
Scheme
(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 "shared/lib-draw.scm")
|
|
|
|
(draw-to-py (painter-diamond simple-frame) "draw-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) "draw-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) "draw-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) "draw-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) "draw-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) "draw-x-below-diamond-1")
|
|
|
|
(define (below painter1 painter2)
|
|
(rotate270 (beside (rotate90 painter2) (rotate90 painter1))))
|
|
|
|
(draw-to-py ((below painter-x painter-diamond) simple-frame) "draw-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) "draw-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) "draw-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))))
|
|
|