;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                          Commands Input                          ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


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

;;; A class that represents a command object.
(defclass <command> ()
  ;; specs is one of:
  ;; - a list of Scheme primitive values, or a predicate, each input
  ;;   element should match a spec or th epredicate should return true,
  ;; - a list that with the first element of :or, which specifies a list
  ;;   of alternatives,
  ;; - a string that must match the exact input,
  ;; - or simply a predicate that will be applied on the whole string.
  (specs     :accessor  cmd-specs
             :initarg   :specs)
  ;; func is a function that will be applied to an object to make it do
  ;; something, and the listener that made the command, as well as the
  ;; input list, or string if it matched a single predicate, see above.
  (func      :type      <function>
             :accessor  cmd-func
             :initarg   :func)
  ;; a one-line string description for the command (empty string means
  ;; that it won't show on help.
  (desc      :type      <string>
             :accessor  cmd-desc
             :initarg   :desc)
  ;; the priority of the command... higher priority commands will be
  ;; selected before other commands that would satisfy the users request
  (priority  :type      <integer>
             :accessor  cmd-priority
             :initarg   :priority
             :initvalue 0)
  (namespace :type      <symbol>
             :accessor  cmd-namespace
             :initarg   :namespace
             :initvalue 'default))

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

;;; Find and apply a command on a command-able object. When command-able
;;; is the player, listener should be the same.
(defgeneric (do-command player input))

;;; Add a command to the player commands.
(defgeneric (add-player-command namespace specs desc func))

(defgeneric (add-command object namespace specs desc func))

;;; Returns a list of commands available to the player
(defgeneric (commands plyr game-object))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Globals

;;; Commands for <player>s.
(define *player-commands* '())

;;; Defines what should be done if the only thing typed in is the nick.
(define *default-command*
  (make <command>
        :specs (list symbol?)
        :desc ""
        :func
        (lambda (plyr inp)
          (let* ((what  (first inp))
                 (place (nick-find what (exits (location plyr))))
                 (thing (nick-find what (contents (location plyr))))
                 (held  (nick-find what (contents plyr))))
            ;; Describe the current location
            (cond ((eq? what (nick (location plyr)))
                   ;; Empty the visited list to get full description
                   (let ((tmp (visited-places plyr)))
                     (set! (visited-places plyr) '())
                     (describe plyr (location plyr))
                     (set! (visited-places plyr) tmp))
                   0)
                  ;; Go through an exit
                  (place (transfer plyr (location plyr) place))
                  ;; Look at something in the current location
                  (thing
                   (tell plyr (echos-ns "You see "
                                        (name+nick thing) ":"))
                   (describe plyr thing)
                   0)
                  ;; Look at something in the inventory
                  (held
                   (tell plyr (echos-ns "You are holding "
                                        (name+nick held) ":"))
                   (describe plyr held)
                   0)
                  ;; There isn't anything with that nickname
                  (else
                   (tell plyr (echos "That didn't make much sense..."
                                     "maybe you should try again."))
                   0))))))

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

;;; Command search and execution methods

;;; Match an input list to a specification list.  The result is either a
;;; list or a string.  See above for a description of a specification
;;; list.
(define (match-input inp specs)
  (cond
   ;; return the string in case of a successful predicate, or a string
   ((procedure? specs) (and (specs inp) inp))
   ((string? specs)    (and (equal? specs inp) inp))
   ;; an alternative list, go down recursively (specs is never null)
   ((eq? (first specs) :or)
    (some (lambda (spec) (match-input inp spec)) (tail specs)))
   ;; a simple spec list
   (else
    (let ((inp (line->list inp)))
      (and (list? inp) (= (length inp) (length specs))
           (every (lambda (x spec)
                    (if (procedure? spec)
                      (spec x)          ; a procedure is a predicate
                      (equal? x spec))) ; otherwise it must be a value
                  inp
                  specs)
           ;; return the list if succeed
           inp)))))

;;; Make the given object do the command.
(defmethod (do-command (plyr <player>) (inp <string>))
  ;; finds a matching input and return the corresponding command
  (define (find/apply-command commands)
    (if (null? commands)
      "That didn't make much sense... maybe you should try again."
      (let ((inp (match-input inp (cmd-specs (head commands)))))
        (if inp
          ((cmd-func (head commands)) plyr inp)
          (find/apply-command (tail commands))))))
  (if (equal? inp "")
    ""
    (find/apply-command (commands plyr plyr))))


;;; Command creation methods

;;; Command additions are made so that most specific come first in the
;;; list.
(defmethod (add-player-command (namespace <symbol>) specs
                               (desc <string>) (func <function>))
  (set! *player-commands*
        (append! *player-commands*
                 (list (make <command>
                             :namespace namespace
                             :specs specs
                             :desc  desc
                             :func  func)))))

(defmethod (add-command (obj <game-object>) (namespace <symbol>) specs
                        (desc <string>) (func <function>))
  (set! (commlist obj)
        (append! (commlist obj)
                 (list (make <command>
                             :namespace namespace
                             :specs specs
                             :desc desc
                             :func func)))))

;;; Command aggregators

(defmethod (commands (plyr <player>) (obj <game-object>))
  (commlist obj))

;;; Returns a list of commands available to the player
(defmethod (commands (plyr <player>) (p <player>))
  (if (eq? plyr p)
    ;; Return list of commands for this player
    (let* ((here (location plyr))
           (player (commlist plyr))
           (exits (map ((curry commands) plyr) (exits here)))
           (more  (map ((curry commands) plyr) (contents plyr)))
           (stuff (map ((curry commands) plyr)
                       (remq plyr (contents here))))
           (here (commands plyr here)))
      (priority-sort (flatten player here exits more stuff
                              *player-commands* *default-command*)
                     cmd-priority))
    ;; Cannot use another player's list of commands
    empty))