[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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

- Prev by Date:
**defmethod-setf patch for DEC CL v2.0** - Next by Date:
**Request to Moon for Thursday's Discussion** - Previous by thread:
**Object creation** - Next by thread:
**defmethod-setf patch for DEC CL v2.0** - Index(es):