;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                  Communication Facilities                        ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

;;; Say something to all animates in the same place.
(defgeneric (say animate string))

;;; Emote something - like say without the colon.
(defgeneric (emote animate string))

;;; Shout something.
(defgeneric (shout animate string))

;;; A general string message.
(defgeneric (tell animate string))

;;; This is used to make a listener react to some message.
(defgeneric (message animate originator type msg))


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

;;; Communication for all <character> objects

;;; Say something to all animates in the same place.
(defmethod (say (from <animate>) (msg <string>))
  (place-message (location from) from 'say msg))

;;; Say something to all animates in the same place _without_ "name:" -
;;; so if you do (emote "laughs"), everyone will see "*name* laughs".
(defmethod (emote (from <animate>) (msg <string>))
  (place-message (location from) from 'emote msg))

;;; Shout something to everyone.
(defmethod (shout (from <animate>) (msg <string>))
  (place-message (location from) from 'shout msg))

;;; A general string message - do nothing by default.
(defmethod (tell (to <animate>) (s <string>))
  #t)

(defmethod (tell (to <list>) (msg <string>))
  (for-each (lambda (animate) (tell animate msg)) to))

;;; Messages - default is to translate to simple message.
(defmethod (message (to <animate>) (from <animate>)
                    (type <symbol>) (msg <string>))
  (define bell (as <char> 7))
  (tell to (case type
             ((say)   (echos (name from) "says:" msg))
             ((emote) (echos-ns "*" (name from) " " msg "*"))
             ((shout) (echos (name from) "shouts:" msg bell))
             ((tell)  (echos (name from) "tells you:" msg))
             ((enter) (echos (name from) "arrived from" msg))
             ((leave) (echos (name from) "left to" msg))
             (else msg))))

;;; Added to simplify the place message option... basically
;;; if the type is #f, we want to give the message to the
;;; animate without any changes.
(defmethod (message (to <animate>) from
                    (type <boolean>) (msg <string>))
  (tell to msg))


;;; Communication for <player> objects

;;; Default tell method - simply print the string.
(defmethod (tell (p <player>) (s <string>))
  ;;!!!
  (parameterize ((current-output-port (wrap-port (current-output-port))))
    (echo s)))

;;; Say something to all people in the same place as the player.
;;; This is an example of specialization on a specific object.
(defmethod (say (p <player>) (s <string>))
  (tell p (echos "You say:" s))
  (call-next-method))

;;; Shout something to everyone, use a limit on frequency, also everyone
;;; in the game will hear it.
(defmethod (shout (p <player>) (s <string>))
  (define bell-char (as <char> 7))
  ;; enforce at least 20 seconds between shouts
  (if (< (+ (last-shout-time p) 20) (current-time))
    (begin
      (tell p (echos "You shout:" s bell-char))
      ;; do a normal shout
      (call-next-method)
      ;; save the time
      (set! (last-shout-time p) (current-time))
      ;; and make all other players get a shout
      (for-each (lambda (q)
                  (unless (memq q (contents (location p)))
                    (tell q (echos "You hear a distant shout:"
                                   s bell-char))))
                *players*))
    ;; can't shout too often...
    (tell p (random-elt '("You try to shout but your throat is sore."
                          "Don't be so noisy!"
                          "Be quiet for a while.")))))