;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                             Fighting                             ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

;;; Weapons have potency - an animate has more chances to win a fight
;;; when this is bigger.
(defclass <weapon> (<inanimate>)
  (potency :type      <number>
           :accessor  potency
           :initarg   :potency
           :initvalue 0))

;;; These are characters that can fight without a weapon.
(defclass <fighter> (<weapon> <character>))


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

;;; Find an animate's weapon - return #f if non found.
(defgeneric (find-weapon animate))

;;; The "potency" of getting a draw in a fight.
(defgeneric (draw-weight animate1 animate2))

;;; Two animates fighting.
(defgeneric (fight animate1 animate2))


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

;;; Find an animate's weapon - return #f if non found.
(defmethod (find-weapon (a <animate>))
  (find-if (lambda (x) (instance-of? x <weapon>)) (contents a)))

;;; Fighters are their own weapons.
(defmethod (find-weapon (f <fighter>))
  f)

;;; The potency of animates is the potency of their weapon, or 0 if non.
(defmethod (potency (a <animate>))
  (let ((weapon (find-weapon a)))
    (if weapon (potency weapon) 0)))

;;; The "potency" of getting a draw in a fight - this means that
;;; potencies should at around the same umber.
(defmethod (draw-weight (a1 <animate>) (a2 <animate>))
  50)

;;; This makes characters have a very small chances of anyone winning.
(defmethod (draw-weight (a1 <player>) (a2 <player>))
  1000)

;;; Two animates fighting.
(defmethod (fight (a1 <animate>) (a2 <animate>))
  (when (and (eq? (location a1) (location a2)) (not (eq? a1 a2)))
    (let* ((p1 (potency a1))
           (p2 (potency a2))
           (w1 (find-weapon a1))
           (w2 (find-weapon a2))
           (d  (draw-weight a1 a2))
           (r  (random (+ p1 p2 d)))
           (l  (location a1)))
      (define (killed won lost)
        (place-message
         l (echos-ns (name won) " killed " (name lost) "!!!") #f #f)
        (kill lost))
      (place-message
       l (echos-ns (name a1) " fights " (name a2) "!") #f #f)
      (place-message
       l (echos " " (name a1) "fights with" (cond
                                             ((eq? w1 a1) "bare hands")
                                             (w1          (name w1))
                                             (else        "nothing")))
       #f #f)
      (place-message
       l (echos " " (name a2) "fights with" (cond
                                             ((eq? w2 a2) "bare hands")
                                             (w2          (name w2))
                                             (else        "nothing")))
       #f #f)
      (cond
       ((< r p1) (killed a1 a2))        ; p1 won
       ((< r (+ p1 p2)) (killed a2 a1)) ; p2 won
       (else ; draw
        (place-message
         l (echos-ns (name a1) " and " (name a2)
                     " are exhausted, but no one won...")
         #f #f)))))
  #t)

;;; Animate trying to fight another animate.
(defmethod (fight (a <player>) (c <character>))
  (if (instance-of? c <fighter>)
    (call-next-method)
    (begin
      (tell a "Thou shalt not kill!")
      #t)))

;;; Corpses get mutilated.
(defmethod (fight (a <animate>) (c <corpse>))
  (mutilate a c)
  #t)

;;; Make it impossible to have more than one weapon.
(defmethod (transfer (o <weapon>) (from <container>) (to <player>))
  (let ((w (find-weapon to)))
    (if w
      (tell to (echos "You cannot hold another weapon, drop"
                      (name w) "first"))
      (call-next-method)))
  #t)

;;; Since fighter is also an inanimate, prevent players picking up a
;;; fighter.
(defmethod (transfer (f <fighter>) (from <place>) (to <player>))
  (tell to (echos "You try to pickup" (name f) "but it is too heavy."))
  #t)