CLOS (Common Lisp Object System)

; define the slots for the shape class
(defclass shape ()
  ((x :accessor shape-x :initarg :x)
   (y :accessor shape-y :initarg :y)))

; define the methods for the shape class
(defmethod move-to ((figure shape) new-x new-y)
  (setf (shape-x figure) new-x)
  (setf (shape-y figure) new-y))
(defmethod r-move-to ((figure shape) delta-x delta-y)
   (setf (shape-x figure) (+ delta-x (shape-x figure)))
   (setf (shape-y figure) (+ delta-y (shape-y figure))))
(defmethod draw ((figure shape)))

; define the slots for the rectangle class
(defclass rectangle (shape)
  ((width :accessor rectangle-width :initarg :width)
   (height :accessor rectangle-height :initarg :height)))

; define the methods for the rectangle class
(defmethod draw ((figure rectangle))
  (format t "~&Drawing a Rectangle at:(~a,~a), width ~a, height ~a~%"
    (shape-x figure)
    (shape-y figure)
    (rectangle-width figure)
    (rectangle-height figure)))
(defmethod set-width ((figure rectangle) new-width)
  (setf (rectangle-width figure) new-width))
(defmethod set-height ((figure rectangle) new-height)
  (setf (rectangle-height figure) new-height))

; define the slots for the circle class
(defclass circle (shape)
  ((radius :accessor circle-radius :initarg :radius)))

; define the methods for the circle class
(defmethod draw ((figure circle))
  (format t "~&Drawing a Circle at:(~a,~a), radius ~a~%"
    (shape-x figure)
    (shape-y figure)
    (circle-radius figure)))
(defmethod set-radius ((figure circle) new-radius)
  (setf (circle-radius figure) new-radius))

(defun polymorph()
   ; declare scope level variables
   (let ((scribble) (a-rectangle)))

   ; create a list containing various shape instances
   (setf scribble
         (list (make-instance 'rectangle :x 10 :y 20 :width 5 :height 6)
               (make-instance 'circle :x 15 :y 25 :radius 8)))

   ; handle the shapes polymorphically
   (dolist (a-shape scribble)
     (draw a-shape)
     (r-move-to a-shape 100 100)
     (draw a-shape))

   ; create a field that holds a rectangle instance
   (setf a-rectangle (make-instance 'rectangle :x 0 :y 0 :width 15 :height 15))

   ; set the width of the rectangle instance
   (set-width a-rectangle 30)
   (draw a-rectangle)

)

(load "shape.lisp")
(load "rectangle.lisp")
(load "circle.lisp")
(load "polymorph.lisp")
(polymorph)

Drawing a Rectangle at:(10,20), width 5, height 6
Drawing a Rectangle at:(110,120), width 5, height 6
Drawing a Circle at:(15,25), radius 8
Drawing a Circle at:(115,125), radius 8
Drawing a Rectangle at:(0,0), width 30, height 15
NIL