Object Creation

[David A. Moon <Moon@STONY-BROOK.SCRC.Symbolics.COM>]

Here's how I would do the x/y/rho/theta example:

;;; Abstract class that can be specialized to use either
;;; polar or cartesian representation

(defclass position () ())

(defmethod initialize-instance :before
	   ((self position) &key x y rho theta)
  (when (or x y)
    (set-cartesian-position self (or x 0) (or y 0)))
  (when (or rho theta)
    (set-polar-position self (or rho 0) (or theta 0))))

;;; Default methods.  One pair or the other must be shadowed.

(defmethod cartesian-position ((self position))
  (multiple-value-call #'polar-to-cartesian (polar-position self)))

(defmethod set-cartesian-position ((self position) x y)
  (multiple-value-call #'set-polar-position
		       self (cartesian-to-polar x y)))

(defmethod polar-position ((self position))
  (multiple-value-call #'cartesian-to-polar (cartesian-position self)))

(defmethod set-polar-position ((self position) rho theta)
  (multiple-value-call #'set-cartesian-position
		       self (polar-to-cartesian rho theta)))

;;; Internal subroutines for coordinate transformation

(defun polar-to-cartesian (rho theta)
  (values (* rho (cos theta))
	  (* rho (sin theta))))

(defun cartesian-to-polar (x y)  
  (if (and (zerop x) (zerop y))
      (values 0 0)
      (values (sqrt (+ (* x x) (* y y)))
	      (atan y x))))

;;; Useful macro

(defmacro with-direct-slots ((instance) &body body)
  `(with-slots ((,instance :use-accessors nil))
     ,@body))

;;; Instantiable class that uses cartesian representation

(defclass cartesian-position (position) (x y))

(defmethod cartesian-position ((self cartesian-position))
  (with-direct-slots (self)
    (values x y)))

(defmethod set-cartesian-position ((self cartesian-position)
				   new-x new-y)
  (with-direct-slots (self)
    (setq x new-x y new-y)))

;;; Instantiable class that uses polar representation

(defclass polar-position (position) (rho theta))

(defmethod polar-position ((self polar-position))
  (with-direct-slots (self)
    (values rho theta)))

(defmethod set-polar-position ((self polar-position)
			       new-rho new-theta)
  (with-direct-slots (self)
    (setq rho new-rho theta new-theta)))