; a class of points
; usage: (Point class-method arg..)
(define Point
  (lambda (class-method . args)
    (cond
      ((eq? class-method 'super) Object)
      ((eq? class-method 'name) "Point")
      ((eq? class-method 'class) Point-class)
      (else (message Point class-method nil args))))
)

; the method name to move a point
(define move 'move)

; the class-description for Point
(define Point-class
  (list
    (list 'new                  ; usage: (Point new x y)
      (lambda (null args)       ; returns new point
        (letrec (
          (data (list (car args)        ; [0] x
                      (cadr args)))     ; [1] y
          (this
            (lambda (method . args)
              (cond
                ((eq? method 'class) Point)
                ((eq? method 'data)  data)
                ((eq? method 'data!) (set! data (car args)))
                (else (message Point method this args))))))
          this
        )
      )
    )
    (list 'toString             ; usage: (aPoint toString)
      (lambda (this args)       ; returns "<super> at <x>,<y>"
        (string-append
          (this 'super Point 'toString args)
          " at "
          (number->string (get (this 'data) 0))
          ","
          (number->string (get (this 'data) 1)))
      )
    )
    (list 'move                 ; usage: (aPoint move dx dy)
      (lambda (this args)       ; returns this
        (let ((data (this 'data)))
          (put! data 0 (+ (get data 0) (car args)))
          (put! data 1 (+ (get data 1) (cadr args)))
        )
        this
      )
    )
  )
)