Step 3b: color-point

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