;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                          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 the object that made it
  ;; and the input list, or string if it matched a single predicate, see
  ;; above (see the top of commands.ss for details about possible
  ;; outputs).
  (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))

;;; An object that ca get commands.
(defclass <command-able> ())


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

;;; Return a list of commands for an object.  No method is actually
;;; defined here.
(defgeneric (commands command-able))

;;; Find and apply a command on a command-able object.
(defgeneric (do-command command-able input))

;;; Truncate a string - remove whitespace characters from both ends.
;;; (define (truncate-string str) ...)

;;; Converts an input line to a string.
;;; (define (line->list string) ...)

;;; Asks the player the three initial questions and return a list of the
;;; nickname symbol and the name string.
;;; (define (read-player-nick+name) ...)

;;; Returns a random element from a given list.
;;; (define (random-elt list) ...)


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

;;; Truncate a string - remove whitespace characters from both ends.
(define (truncate-string str)
  (define len (string-length str))
  (define (first n)
    (cond ((= n len) #f)
          ((char-whitespace? (string-ref str n))
           (first (add1 n)))
          (else n)))
  (define (last n)
    (cond ((= n 0) #f)
          ((char-whitespace? (string-ref str (sub1 n)))
           (last (sub1 n)))
          (else n)))
  (let* ((f (first 0))
         (l (and f (last len))))
    (if f (substring str f l) "")))

;;; A read-line version that truncates input and returns #f on end of file.
(define (read-inp-line)
  (let ((x (read-line)))
    (and (not (eof-object? x)) (truncate-string x))))

;;; Convert an input string to a list.
(define (line->list str)
  ;; this will convert the string to an input list
  (no-errors
    (let ((result (read-from-string (string-append "(" str ")"))))
      (and (list? result) result))))

;;; 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 (obj <command-able>) (inp <string>))
  ;; finds a matching input and return the corresponding command
  (define (find/apply-command commands)
    (if (null? commands)
      ;; return an error (a string) if no command was found
      "That didn't make sense, try again (type help for a list)."
      (let ((inp (match-input inp (cmd-specs (head commands)))))
        (if inp
          ((cmd-func (head commands)) obj inp)
          (find/apply-command (tail commands))))))
  (if (equal? inp "")
    ""
    (find/apply-command (commands obj))))

;;; Initialization input section.

;;; Return a random element from a list.
(define (random-elt list)
  (list-ref list (random (length list))))

;;; Ask one of the *WHAT* questions.
(define (*what* something)
  (echon "*WHAT* is" something "? ")
  (read-inp-line))

;;; Get a string for a player name.
(define (read-player-string)
  (let ((string (*what* "your name")))
    (if (equal? string "")
      (read-player-string)
      string)))

;;; Get a unique symbol for a nickname, must be short.
(define (read-unique-nikname)
  (let ((symbol (match-input (*what* "your nickname (short symbol)")
                             (list symbol?))))
    (cond ((not symbol)
           (echo "You must enter a symbol.")
           (read-unique-nikname))
          ((> (string-length (as <string> (first symbol))) 8)
           (echo "You must use less than 8 characters.")
           (read-unique-nikname))
          ((memq (first symbol) (map nick *players*))
           (echo "This name is already used, try another.")
           (read-unique-nikname))
          (else (first symbol)))))

;; Ask the third question, ignore the result.
(define (ask-third-question)
  (define question
    (random-elt
     '("the value of ((lambda (x) (x x)) (lambda (x) (x x)))"
       "the average airspeed of an unladen swallow"
       "the capital of Assyria"
       "your favourite colour"
       "the grade you want")))
  ;; make sure some reply is received
  (define (loop) (when (equal? (*what* question) "") (loop)))
  (loop))

;;; Return a list of nick name and name for a player.
(define (read-player-nick+name)
  (echo "Welcome to the Quest for the Holy Grail!")
  (echo)
  (echo "Who would enter the Caverns of Scheme must answer me")
  (echo "these questions three, ere the final grade he see.")
  ;; make sure that the result is #f if any of the inputs is #f
  (let ((name (read-player-string)))
    (and name
         (let ((nick (read-unique-nikname)))
           (and nick
                (ask-third-question)
                (list nick name))))))