lec22 - (let ([pt (make-point #f #f)]) (make-obj (append...

Info iconThis preview shows pages 1–2. Sign up to view the full content.

View Full Document Right Arrow Icon
;; CSE 341 Spring 2008 Lecture 22: OO pattern in Scheme ; ;; We can "use" dynamic dispatch in a language without it ;; manually. ; (define-struct obj (fields methods)) ( (define (get obj fld) (let ([pr (assoc fld (obj-fields obj))]) (if pr (cdr pr) (error "field not found")))) (define (set obj fld v) (let ([pr (assoc fld (obj-fields obj))]) (if pr (set-cdr! pr v) (error "field not found")))) (define (send obj msg . args) (let ([pr (assoc msg (obj-methods obj))]) (if pr ((cdr pr) obj args) ; do the call (error "method not found" msg)))) (define make-point (lambda (_x _y) (make-obj (list (cons 'x _x) (cons 'y _y)) (list (cons 'get-x (lambda (self lst) (get self 'x))) (cons 'get-y (lambda (self lst) (get self 'y))) (cons 'set-x (lambda (self lst) (set self 'x (car lst)))) (cons 'set-y (lambda (self lst) (set self 'y (car lst)))) (cons 'distToOrigin (lambda (self lst) (let ([a (send self 'get-x)] [b (send self 'get-y)]) (sqrt (+ (* a a) (* b b)))))))))) (define make-polar-point (lambda (_r _th)
Background image of page 1

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Background image of page 2
This is the end of the preview. Sign up to access the rest of the document.

Unformatted text preview: (let ([pt (make-point #f #f)]) (make-obj (append (list (cons 'r _r) (cons 'theta _th)) (obj-fields pt)) ; Java-style field extension (append (list (cons 'set-r-theta (lambda (self lst) (begin (set self 'r (car lst)) (set self 'theta (car (cdr lst)))))) (cons 'get-x (lambda (self lst) (let ([r (get self 'r)] [theta (get self 'theta)]) (* r (cos theta))))) (cons 'get-y (lambda (self lst) (let ([r (get self 'r)] [theta (get self 'theta)]) (* r (sin theta))))) (cons 'set-x (lambda (self lst) (let* ([a (car lst)] [b (send self 'get-y)] [theta (atan (/ b a))] [r (sqrt (+ (* a a) (* b b)))]) (send self 'set-r-theta r theta)))) (cons 'set-y (lambda (self lst) (let* ([b (car lst)] [a (send self 'get-x)] [theta (atan (/ b a))] [r (sqrt (+ (* a a) (* b b)))]) (send self 'set-r-theta r theta))))) (obj-methods pt)))))) (define p1 (make-polar-point 4 3.1415926535)) (send p1 'get-x) (send p1 'get-y) (send p1 'distToOrigin)...
View Full Document

This note was uploaded on 10/12/2009 for the course CSE 341 taught by Professor Staff during the Spring '08 term at University of Washington.

Page1 / 2

lec22 - (let ([pt (make-point #f #f)]) (make-obj (append...

This preview shows document pages 1 - 2. Sign up to view the full document.

View Full Document Right Arrow Icon
Ask a homework question - tutors are online