Finished up to 2.51 (skipped 2.52)
This commit is contained in:
parent
7d513dccf6
commit
944efce5df
|
@ -0,0 +1,192 @@
|
|||
(define (make-vect x y) (cons x y))
|
||||
(define (xcor-vect v) (car v))
|
||||
(define (ycor-vect v) (cdr v))
|
||||
|
||||
(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 (* (xcor-vect v) s)
|
||||
(* (ycor-vect v) s)))
|
||||
|
||||
|
||||
;; 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 start end)
|
||||
(cons start end))
|
||||
|
||||
(define (start-segment segment)
|
||||
(car segment))
|
||||
|
||||
(define (end-segment segment)
|
||||
(cdr segment))
|
||||
|
||||
|
||||
;; 2.49
|
||||
|
||||
(define (for-each f l)
|
||||
(if (not (null? l))
|
||||
(begin (f (car l))
|
||||
(for-each f (cdr l)))))
|
||||
|
||||
(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 (draw-line start end)
|
||||
(print "(" start " -> " end ")"))
|
||||
|
||||
(define (segments->painter segment-list)
|
||||
(lambda (frame)
|
||||
(for-each
|
||||
(lambda (segment)
|
||||
(draw-line
|
||||
((frame-coord-map frame) (start-segment segment))
|
||||
((frame-coord-map frame) (end-segment segment))))
|
||||
segment-list)))
|
||||
|
||||
(define frame (make-frame (make-vect 1 1) (make-vect 1 0) (make-vect 0 1)))
|
||||
(define bottom-left (make-vect 0 0))
|
||||
(define top-left (make-vect 0 1))
|
||||
(define top-right (make-vect 1 1))
|
||||
(define bottom-right (make-vect 1 0))
|
||||
(define top (make-vect 0.5 1))
|
||||
(define bottom (make-vect 0.5 0))
|
||||
(define left (make-vect 0 0.5))
|
||||
(define right (make-vect 1 0.5))
|
||||
|
||||
(define outline-painter (segments->painter
|
||||
(list
|
||||
(make-segment bottom-left bottom-right)
|
||||
(make-segment bottom-right top-right)
|
||||
(make-segment top-right top-left)
|
||||
(make-segment top-left bottom-left))))
|
||||
|
||||
(define x-painter
|
||||
(segments->painter
|
||||
(list
|
||||
(make-segment bottom-left top-right)
|
||||
(make-segment bottom-right top-left))))
|
||||
|
||||
(define diamond-painter
|
||||
(segments->painter
|
||||
(list
|
||||
(make-segment bottom left)
|
||||
(make-segment left top)
|
||||
(make-segment top right)
|
||||
(make-segment right bottom))))
|
||||
|
||||
|
||||
;; 2.50
|
||||
|
||||
(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-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)))
|
||||
|
||||
(define (rotate90 painter)
|
||||
(transform-painter painter
|
||||
(make-vect 1.0 0.0)
|
||||
(make-vect 1.0 1.0)
|
||||
(make-vect 0.0 0.0)))
|
||||
|
||||
(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)
|
||||
(paint-left frame)
|
||||
(paint-right frame)))))
|
||||
|
||||
(define (below painter1 painter2)
|
||||
(let ((split-point (make-vect 0 0.5)))
|
||||
(let ((paint-bottom
|
||||
(transform-painter
|
||||
painter1
|
||||
(make-vect 0 0)
|
||||
(make-vect 1 0)
|
||||
split-point))
|
||||
(paint-top
|
||||
(transform-painter
|
||||
painter2
|
||||
split-point
|
||||
(make-vect 1 0.5)
|
||||
(make-vect 0 1))))
|
||||
(lambda (frame)
|
||||
(paint-bottom frame)
|
||||
(paint-top frame)))))
|
||||
|
||||
(define (below-rot painter1 painter2)
|
||||
(rotate270
|
||||
(beside (rotate90 painter1)
|
||||
(rotate90 painter2))))
|
Loading…
Reference in New Issue