# Object Creation

• To: Common-Lisp-Object-System@sail.stanford.edu
• Subject: Object Creation
• From: David A. Moon <Moon@STONY-BROOK.SCRC.Symbolics.COM>
• Date: Wed, 24 Jun 87 12:58 EDT

```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)))

```