(define (color-point x y color)
 (let ((super (new-part point x y))
       (self 'nil))
   (let ((color color))
       
     (define (get-color)
       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))
     
   self))