40 lines
1.5 KiB
Plaintext
40 lines
1.5 KiB
Plaintext
|
(define (point x y)
|
||
|
|
(define (self m)
|
||
|
|
(cond ((eq? m 'getx) (lambda () x))
|
||
|
|
((eq? m 'gety) (lambda () y))
|
||
|
|
((eq? m 'type) (lambda () 'point))
|
||
|
|
((eq? m 'setx!) (lambda (nx) (set! x nx)))
|
||
|
|
((eq? m 'sety!) (lambda (ny) (set! y ny)))
|
||
|
|
((eq? m 'info) (lambda () (list 'point x y)))
|
||
|
|
((eq? m 'add) (lambda (p)
|
||
|
|
(let ((px ((p 'getx)))
|
||
|
|
(py ((p 'gety))))
|
||
|
|
(point (+ x px) (+ y py)))))
|
||
|
|
((eq? m 'sub) (lambda (p)
|
||
|
|
(let ((px ((p 'getx)))
|
||
|
|
(py ((p 'gety))))
|
||
|
|
(point (- x px) (- y py)))))
|
||
|
|
(else (lambda () (display (string-append "Message not understood: " (symbol->string m) "\n"))))))
|
||
|
|
self)
|
||
|
|
|
||
|
|
(define (send obj . args)
|
||
|
|
(if (procedure? obj)
|
||
|
|
(if (= (length args) 1)
|
||
|
|
((obj (car args)))
|
||
|
|
((obj (car args)) (car (cdr args)))) ; Extracting the second argument
|
||
|
|
(display (string-append "Inappropriate receiver object: " (symbol->string obj) "\n"))))
|
||
|
|
|
||
|
|
(define p1 (point 1 2))
|
||
|
|
(define p2 (point 3 4))
|
||
|
|
(send p1 'getx) ; 1
|
||
|
|
(send p1 'gety) ; 2
|
||
|
|
(send p2 'getx) ; 3
|
||
|
|
(send p2 'gety) ; 4
|
||
|
|
(define p (send p1 'add p2))
|
||
|
|
(send p 'info) ; (point 4 6)
|
||
|
|
(send 'not-a-point 'info) ; should display "Inappropriate receiver object"
|
||
|
|
(send p 'foo) ; should display "Message not understood"
|
||
|
|
(send p 'bar 2) ; should display "Message not understood"
|
||
|
|
(send p1 'setx! 5)
|
||
|
|
(send p1 'getx) ; returns 5
|