(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