Back to slide -- Keyboard shortcut: 'u'        next -- Keyboard shortcut: 'n'  Annotated program -- Keyboard shortcut: 't'    colorpoint-class-all.scm - All necessary stuff to play with ColorPoint.Lecture 8 - slide 9 : 11
Program 1

(define (new-instance class . parameters)
  (apply class parameters))

(define (new-part class . parameters)
  (apply class parameters))

(define (method-lookup object selector)
  (cond ((procedure? object) (object selector))
         (else (error "Inappropriate object in method-lookup: " object))))

(define (send message object . args)
  (let ((method (method-lookup object message)))
    (cond ((procedure? method) (apply method args))
          ((null? method) (error "Message not understood: " message))
          (else (error "Inappropriate result of method lookup: " method)))))

(define (point x y)
 (let ((x x) 
       (y y)
   (define (getx) x)

   (define (gety) y)

   (define (add p) 
     (+ x (send 'getx p))
     (+ y (send 'gety p))))

   (define (type-of) 'point)
   (define (self message)
     (cond ((eqv? message 'getx) getx)
           ((eqv? message 'gety) gety)
           ((eqv? message 'add)  add)
           ((eqv? message 'type-of) type-of)
	   (else (error "Undefined message" message))))

(define (color-point x y color)
 (let ((super (new-part point x y))
       (self 'nil))
   (let ((color color))
     (define (get-color)

     (define (type-of) 'color-point)
     (define (dispatch message)
       (cond ((eqv? message 'get-color) get-color)
             ((eqv? message 'type-of) type-of)
             (else (method-lookup super message))))
     (set! self dispatch))