SICP_2.48-2.49

#lang sicp

(#%require sicp-pict)

(define (make-vect a b)
  (cons a b))

(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 v1)
  (make-vect (* s (xcor-vect v1))
             (* s (ycor-vect v1))))

;;;;;;;;;;;;;;;;;;;2.48
(define (make-segment start end)
  (make-vect start end))

(define (start-segment segment)
  (car segment))

(define (end-segment segment)
  (cdr segment))

;;;;;;;;;;;;;;;;;;;2.49
(define (segment->painter segment-list)
  (lambda (frame)
    (for-each
     (lambda (segment)
       (draw-line
        ((frame-coord-map frame) (start-segment segment))
        ((frame-coord-map frame) (end-segment segmnet))))
     segment-list)))

(define top-left (make-vect 0.0 1.0))
(define top-right (make-vect 1.0 1.0))
(define bottom-left (make-vect 0.0 0.0))
(define bottom-right (make-vect 1.0 0.0))

(define top (make-segment top-left top-right))
(define left (make-segment top-left bottom-left))
(define right (make-segment top-right bottom-right))
(define bottom (make-segment bottom-left bottom-right))

(segment->painter (list top bottom left right))

;;;下同