;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                            Inanimates                            ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Classes

;;; The class of all objects.
(defclass <inanimate> (<contained>)
  ;; Holder will be an accessor for the location slot - this means that
  ;; this design does not allow such an object to be held by a player
  ;; while it is located in a place.  The old name can also be used.
  ;; The type is left as the default <container>, because if we use
  ;; <player> it won't allow objects to be in other objects.
  (location :accessor  holder
            :initarg   :holder))

;;; This class is used for corpses.
(defclass <corpse> (<inanimate>)
  (mutilation :type      <integer>
              :accessor  mutilation
              :initarg   :mutilation
              :initvalue 0))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; A predicate for inanimates.
;;; (define (inanimate? x) ...)

;;; This will get an animate and create a corresponding corpse object.
(defgeneric (make-corpse animate))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation

;;; This is defined since it is used in several places.
(define (inanimate? x)
  (instance-of? x <inanimate>))

(defmethod (make-corpse (a <animate>))
  (make <corpse> :nick (nick a) :name (name a) :location (location a)))

;;; Mutilation stuff...
(defmethod (name (c <corpse>))
  (echos-ns "The "
            (case (mutilation c)
              ((0) "")
              ((1) "mutilated ")
              ((2) "torn apart ")
              ((3) "pile of small pieces that were the ")
              (else "dusty remains of the "))
            "corpse of "
            (call-next-method)))
(defmethod (mutilate (a <animate>) (c <corpse>))
  (emote a (echos (case (mutilation c)
                    ((0) "mutilates")
                    ((1) "tears apart")
                    ((2) "cuts down to small pieces")
                    (else "jumps up and down on the remainings of"))
                  (name c)))
  (set! (mutilation c) (1+ (mutilation c))))

;;; This makes transfer be the "take" command, the inanimate is the
;;; object, the place is the source and the player is the target.
(defmethod (transfer (o <inanimate>) (from <place>) (to <player>))
  (if (memq o (contents from))
    (begin
      (call-next-method)
      (tell to (echos "You take" (name o)))
      (place-message from (echos (name to) "took" (name o)) to #f))
    (tell to (echos "You cannot take" (name o))))
  ;; return this sice it is used as the result of a commad processing
  #t)

;;; And this uses transfer again to be a "drop" command, similar to the
;;; above but the types are reversed.
(defmethod (transfer (o <inanimate>) (from <player>) (to <place>))
  (if (memq o (contents from))
    (begin
      (call-next-method)
      (tell from (echos "You drop" (name o)))
      (place-message to (echos (name from) "dropped" (name o)) from #f))
    (tell from (echos "You don't have" (name o))))
  #t)

;;; Yet another version - now transfer is a give operation between two
;;; players.
(defmethod (transfer (o <inanimate>) (from <animate>) (to <animate>))
  (if (memq o (contents from))
    (begin
      (call-next-method)
      (tell from (echos "You give" (name o) "to" (name to)))
      (tell to (echos (name from) "gave you" (name o))))
    (tell from (echos "You don't have" (name o))))
  #t)