diff --git a/project-2/step3b.rkt b/project-2/step3b.rkt index a53a115..106b02c 100644 --- a/project-2/step3b.rkt +++ b/project-2/step3b.rkt @@ -3,7 +3,7 @@ (define (self m) (cond ((eq? m 'type) (lambda () 'object)) - (else (lambda () (display (string-append "Message not understood: " (symbol->string m) "\n")))) + (else (lambda args (display (string-append "Message not understood: " (symbol->string m) "\n")))) ) ) self @@ -29,6 +29,7 @@ (point (- x px) (- y py)) ) )) + (define (self m) (cond ((eq? m 'getx) (getx)) ((eq? m 'gety) (gety)) @@ -38,18 +39,40 @@ ((eq? m 'info) (info)) ((eq? m 'add) (add)) ((eq? m 'sub) (sub)) - (else (lambda () (method-lookup super (list m)))) + (else (lambda args (method-lookup super (cons m args)))) ) ) self ) -(define (send2 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 (color-point x y color) + (define super (point x y)) + (define (type) (lambda () 'color-point)) + (define (get-color) (lambda () color)) + (define (info) (lambda () (append ((super 'info)) (list color)))) + (define (add) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (color-point (+ x px) (+ y py) color) + ) + )) + (define (sub) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (color-point (- x px) (- y py) color) + ) + )) + + (define (self m) + (cond ((eq? m 'type) (type)) + ((eq? m 'get-color) (get-color)) + ((eq? m 'info) (info)) + ((eq? m 'add) (add)) + (else (lambda args (method-lookup super (cons m args)))) + ) + ) + self +) (define (method-lookup reciever message) (if (= (length message) 1) @@ -64,6 +87,9 @@ ) ) +(define o (object)) +(send o 'type) ; object +(send o 'foo) ; should display "Message not understood" (define p1 (point 1 2)) (define p2 (point 3 4)) @@ -72,11 +98,17 @@ (send p2 'getx) ; 3 (send p2 'gety) ; 4 (define p (send p1 'add p2)) -(send p 'test); (send p 'info) ; (point 4 6) -(send 'not-a-point 'info) ; should display "Inappropriate receiver object" -(send p 'foo) ; should display "Message not understood" -; Same issue than step3 -;(send p 'bar 2) ; should display "Message not understood" -(send p1 'setx! 5) -(send p1 'getx) ; returns 5 + +(define cp (color-point 5 6 'red)) +(send cp 'type) ; color−point +(send cp 'getx) ; 5 +(send cp 'gety) ; 6 +(send cp 'get-color) ; red +(send cp 'info) + +(define cp−1 (send cp 'add (color-point 1 2 'green))) +(send cp−1 'type) ; color−point +(send cp−1 'getx) ; 6 +(send cp−1 'gety) ; 8 +(send cp−1 'get-color) ; red