2024-04-26 23:07:23 +02:00
|
|
|
;Auhors:Dubois Brieuc, Dubois Simon
|
|
|
|
|
;Added lambda function to allow for aguments in methodes
|
|
|
|
|
;We renamed dispatch as self
|
|
|
|
|
|
|
|
|
|
;Class definition
|
2024-04-23 22:05:17 +02:00
|
|
|
(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)
|
|
|
|
|
|
2024-04-26 23:07:23 +02:00
|
|
|
;Usage example
|
2024-04-23 22:05:17 +02:00
|
|
|
(define p1 (point 1 2))
|
|
|
|
|
(define p2 (point 3 4))
|
|
|
|
|
((p1 'getx)) ; returns 1
|
|
|
|
|
((p1 'gety)) ; returns 2
|
|
|
|
|
((p2 'getx)) ; returns 3
|
|
|
|
|
((p2 'gety)) ; returns 4
|
|
|
|
|
(define pp ((p1 'add) p2)) ; returns a new point pp
|
|
|
|
|
((pp 'info)) ; returns (point 4 6)
|
|
|
|
|
(define pn ((p1 'sub) p2)) ; returns a new point pn
|
|
|
|
|
((pn 'info)) ; returns (point -2 -2)
|
|
|
|
|
((pp 'foo)) ; should display "Message not understood" error
|
|
|
|
|
((p1 'setx!) 5)
|
|
|
|
|
((p1 'sety!) 5)
|
|
|
|
|
((p1 'info)) ; returns (point 5 5)
|
|
|
|
|
|
