;;; Demonstration of CLOS classes with multiple inheritance
;;; Stuart C. Shapiro
;;; August 9, 2004
;;; based on the Java classes and interfaces in /web/faculty/shapiro/Courses/CSE115/Demos/InterfaceDemo/
;;;
(defpackage :solids
  (:shadow #:length))

(in-package :solids)

(defclass solid ()
  ((density :documentation
	    "The density of this solid in pounds per unit volume."
	    :initarg :density
	    :reader density)
   (volume :documentation
	   "The volume of this solid."
	   :initarg :volume
	   :reader volume))
  (:documentation
   "The class of solids---3-dimensional objects with volume and uniform density."))

#| Tests:
(setf s (make-instance 'solid :volume 37 :density 52))
(type-of s)
(density s)
(volume s)
(setf (density s) 75) ; Will cause an error.
|#

;;;
;;; Some Planar Figures
;;;
(defclass planarFigure ()
  ((area :documentation "The area of this planar figure."
	 :reader area))
  (:documentation "The class of planar figures."))

(defclass rectangle (planarFigure)
  ((length :documentation "The length of this rectangle."
	   :initarg :length
	   :reader length)
   (width :documentation "The width of this rectangle."
	  :initarg :width
	  :reader width))
  (:documentation "The class of rectangles."))

(defmethod initialize-instance :after ((r rectangle) &rest args)
  "Initializes the area of r."
  (setf (slot-value r 'area) (* (length r) (width r))))

(defclass triangle (planarFigure)
  ((base :documentation "The base of this rectangle."
	 :initarg :base
	 :reader base)
   (height :documentation "The height of this rectangle."
	   :initarg :height
	   :reader height))
  (:documentation "The class of rectangles."))

(defmethod initialize-instance :after ((r triangle) &rest args)
  "Initializes the area of r."
  (setf (slot-value r 'area)
    (/ (* (base r) (height r)) 2.0)))

#|Tests:
(setf r (make-instance 'rectangle :length 5 :width 3))
(area r)
(setf tr (make-instance 'triangle :base 5 :height 3))
(area tr)
|#

;;;
;;; The Weighable Class of Objects
;;;
(defclass weighable ()
  ((weight :documentation "The weight of this object in pounds."
	   :reader weight))
  (:documentation "The class of objects that are capable of being weighed.")) 

;;;
;;; Prisms
;;;
(defclass prism (weighable solid)
  ((crossSection :documentation "The cross section of this prism."
		 :initarg :crossSection
		 :reader crossSection
		 :type planarFigure)
   (height :documentation "The height of this prism."
	   :initarg :height
	   :reader height))
  (:documentation "The class of regular 3-dimensional solids."))

(defmethod initialize-instance :after ((p prism) &rest args)
  "Initializes the volume and weight of p."
  (setf (slot-value p 'weight)
    (* (setf (slot-value p 'volume)
	 (* (area (crossSection p)) (height p)))
       (density p))))

(defclass rectangularPrism (prism)
  ((crossSection :documentation "The cross section of this prism."
		 :initarg :crossSection
		 :reader crossSection
		 :type rectangle))
  (:documentation "The class of prisms with rectangular cross sections."))

(defclass triangularPrism (prism)
  ((crossSection :documentation "The cross section of this prism."
		 :initarg :crossSection
		 :reader crossSection
		 :type triangle))
  (:documentation "The class of prisms with triangular cross sections."))

#| Tests:
(setf rp (make-instance 'rectangularPrism
	   :crossSection (make-instance 'rectangle :length 2 :width 3)
	   :height 5
	   :density 10))
(volume rp)
(weight rp)
(setf tp (make-instance 'triangularPrism
	   :crossSection (make-instance 'triangle :base 2 :height 3)
	   :height 5
	   :density 10))
(volume tp)
(weight tp)
|#

;;;
;;; A class of irregular weighable objects
;;;
(defclass twoTonTruck (weighable)
  ((weight :documentation "The weight of this truck in pounds."
	   :initform 4000		; pounds
	   :reader weight))
  (:documentation "The class of two-ton trucks."))

#|Tests:
(setf myTruck (make-instance 'twoTonTruck))
(weight myTruck)
|#

;;;
;;; Scales to weigh weighable objects.
;;;
(defclass scale ()
  ((numberHeld :documentation "The number of objects on this scale."
	       :initform 0
	       :accessor numberHeld)
   (totalWeight :documentation
		"The total weight of the objects on this scale in pounds."
		:initform 0
		:accessor totalWeight))
  (:documentation
   "The class of scales,
         objects that can hold and weigh weighable objects."))

(defmethod addObject ((s scale) (object weighable))
  "Adds the object to the scale."
  (incf (numberHeld s))
  (incf (totalWeight s) (weight object)))

(defmethod report ((s scale) &optional (ostream *standard-output*))
  "Prints the number of objects on the scale,
     and their total weight in pounds."
  (format ostream
	  "Number of objects held: ~12D~%~
                 Total Weight (in pounds): ~10,2F~%" 
	  (numberHeld s) (totalWeight s)))

#|Tests:
(setf s (make-instance 'scale))
(setf rp (make-instance 'rectangularPrism
	   :crossSection (make-instance 'rectangle :length 2 :width 3)
	   :height 5
	   :density 10))
(volume rp)
(weight rp)
(addObject s rp)
(report s)

(setf tp (make-instance 'triangularPrism
	   :crossSection (make-instance 'triangle :base 2 :height 3)
	   :height 5
	   :density 10))
(volume tp)
(weight tp)
(addObject s tp)
(report s)

(setf myTruck (make-instance 'twoTonTruck))
(weight myTruck)
(addObject s myTruck)
(report s)
|#