(define (send message obj . par) (let ((method (obj message))) (apply method par))) (define (point x y) (letrec ((getx (lambda () x)) (gety (lambda () y)) (add (lambda (p) (point (+ x (send 'getx p)) (+ y (send 'gety p))))) (move (lambda (dx dy) (point (+ x dx) (+ y dy)))) (move! (lambda (dx dy) (set! x (+ x dx)) (set! y (+ y dy)))) (type-of (lambda () 'point)) ) (lambda (message) (cond ((eq? message 'getx) getx) ((eq? message 'gety) gety) ((eq? message 'add) add) ((eq? message 'move) move) ((eq? message 'move!) move!) ((eq? message 'type-of) type-of) (else (error "Message not understood")))))) (define (rectangle upper-left-corner-point lower-right-corner-point) (letrec ((move (lambda (dx dy) (rectangle (send 'move upper-left-corner-point dx dy) (send 'move lower-right-corner-point dx dy)))) (area (lambda () (let ((width (- (send 'getx lower-right-corner-point) (send 'getx upper-left-corner-point))) (height (- (send 'gety lower-right-corner-point) (send 'gety upper-left-corner-point)))) (abs (* width height))))) (info (lambda () (list (send 'getx upper-left-corner-point) (send 'gety upper-left-corner-point) (send 'getx lower-right-corner-point) (send 'gety lower-right-corner-point)))) ) (lambda (message) (cond ((eq? message 'move) move) ((eq? message 'area) area) ((eq? message 'info) info) (else (error "Message not understood")))))) ; (define p (point 3 4)) ; ; > (send 'getx p) ; 3 ; ; > (send 'move! p 5 6) ; ; > (send 'getx p) ; 8 ; ; > (send 'gety p) ; 10 ; ; > (define pp (send 'move p 2 3)) ; ; > (send 'getx pp) ; 10 ; ; > (send 'gety pp) ; 13 ; ; > (define r (rectangle (point 0 0) (point 5 10))) ; ; > (send 'info r) ; (0 0 5 10) ; ; > (define rr (send 'move r 2 3)) ; ; > (send 'info rr) ; (2 3 7 13) ; ; > (send 'area r) ; 50 ; ; > (send 'area rr) ; 50