;;; File:
;;;   guessing-game.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   0.1 of Thursday, 9 November 2006
;;; Summary:
;;;   Sample procedures for a silly guessing game.

; +-------------------+-----------------------------------------------
; | Related Libraries |
; +-------------------+

; Load the names vector.
(load "/home/rebelsky/Web/Courses/CS151/2006F/Examples/names.scm")
; (load "/home/rebelsky/Web/Courses/CS151/2006F/Examples/fewernames.scm")


; +----------------+--------------------------------------------------
; | The Strategies |
; +----------------+

;;; Procedures:
;;;   guess-name
;;;   binary-guess-name
;;;   random-guess-name
;;;   sequential-guess-name
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Play a guessing game.
;;; Produces:
;;;   Nothing.  Called for the side-effects.
;;; Process:
;;;   binary-guess-name uses a variant of binary search to guess the name.
;;;   random-guess-name guesses "random" members of names.
;;;   sequential-guess-name guesses each name in turn.
;;;   guess-name uses one of those strategies.
(define sequential-guess-name
  (lambda ()
    ; Remember the length of the vector
    (let ((len (vector-length names)))
      ; In the kernel, we step through the positions, guessing each one
      ; in turn.
      (letrec ((kernel
                (lambda (pos)
                  (cond
                    ((equal? pos len)
                     (print-line "You win!  I've run out of names."))
                    ((yes-or-no? (string-append "Is the name "
                                                (vector-ref names pos)
                                                "?"))
                     (print-line "I win!"))
                    (else (kernel (+ pos 1)))))))
        (print-line "Think of a name and I'll try to guess it.")
        (kernel 0)
        (newline)
        (if (yes-or-no? "Play again?")
            (sequential-guess-name)
            (print-line "Thanks for playing."))))))

(define random-guess-name
  (lambda ()
    ; Remember the length of the vector
    (let ((len (vector-length names)))
      ; In the kernel, we just guess a random position
      (letrec ((kernel
                (lambda ()
                  (cond
                    ((yes-or-no? (string-append "Is the name "
                                                (vector-ref names (random len))
                                                "?")) 
                     (print-line "I win!"))
                    (else (kernel))))))
        (print-line "Think of a name and I'll try to guess it.")
        (kernel)
        (newline)
        (if (yes-or-no? "Play again?")
            (random-guess-name)
            (print-line "Thanks for playing."))))))

(define guess-name sequential-guess-name)


; +-------------+-----------------------------------------------------
; | Interaction |
; +-------------+

;;; Procedure:
;;;   print-line
;;; Parameters:
;;;   line, a Scheme value.
;;; Purpose:
;;;   Print the line to the screen, followed by a carriage return.
;;; Produces:
;;;   Nothing.  Called for the side effect.
;;; Postconditions:
;;;   line has been displayed to the screen.
;;;   The cursor is now at the beginning of the next line.
;;; Philosophy:
;;;   A shorthand for (begin (display line) (newline)), which I type
;;;   much too much
(define print-line
  (lambda (line)
    (display line)
    (newline)))

;;; Procedure:
;;;   prompt
;;; Parameters:
;;;   message, a string
;;;   valid-responses, a list of strings
;;; Purpose:
;;;   Repeatedly prints the message and gets a response until that 
;;;   response is one of the valid respones.
;;; Produces:
;;;   response, a sting entered by the user
;;; Postconditions:
;;;   Output has been displayed to the screen.
;;;   Input has been read from the user.
;;;   response is the most recent response from the user.
;;;   (member response valid-responses)
(define prompt
  (lambda (message valid-responses)
    (display message)
    (display " ")
    (let ((response (read-line)))
      (if (string-member? response valid-responses)
          response
          (begin
            (display "I'm sorry, but '")
            (display response)
            (display "' is not a valid response.  Please try again.")
            (newline)
            (prompt message valid-responses))))))

;;; Procedure:
;;;   read-line
;;; Parameters:
;;;   source, an input port
;;; Purpose:
;;;   Read one line of input from a source and return that line
;;;   as a string.
;;; Produces:
;;;   line, a string
;;; Preconditions:
;;;   The source is open for reading. [Unverified]
;;; Postconditions: 
;;;   Has read characters from the source (thereby affecting
;;;     future calls to read-char and peek-char).
;;;   line represents the characters in the file from the
;;;     "current" point at the time read-line was called
;;;     until the first end-of-line or end-of-file character.
;;;   line does not contain a newline.
(define read-line
  (letrec ((read-line-of-chars
             (lambda ()
               (cond
                 ((eof-object? (peek-char)) null)
                 ((char=? (peek-char) #\newline) (read-char) null)
                 (else (cons (read-char) (read-line-of-chars)))))))
    (lambda ()
      (list->string (read-line-of-chars)))))

;;; Procedure:
;;;   yes-or-no?
;;; Parameters:
;;;   question, a string
;;; Purpose:
;;;   Presents the question, reads a response from the user, and then
;;;   returns true if the user responded yes (or a variant) and
;;;   false if the user responded no (or a variant).
;;; Produces:
;;;   yes?, a boolean
;;; Postconditions:
;;;   Output and input occurred.
;;;   If the user answered some reasonable variant of 'yes', yes? is #t.
;;;   Otherwise, yes? is #f.
(define yes-or-no?
  (let* ((yes-words (list "y" "yes" "yeah" "of course"))
         (no-words (list "n" "no" "nope"))
         (responses (append yes-words no-words)))
    (lambda (question)
      (string-member? (prompt question responses) yes-words))))
   
 
; +----------------+--------------------------------------------------
; | Misc Utilities |
; +----------------+

;;; Procedure:
;;;   string-member?
;;; Parameters:
;;;   str, a string
;;;   strings, a list of strings
;;; Purpose:
;;;   Determines if str appears anywhere in strings.
;;; Produces:
;;;   is-member?, a Boolean
;;; Postconditions:
;;;   If there is an i such that
;;;     (string-ci=? str (list-ref strings i))
;;;   then 
;;;     is-member? is #t
;;;   Otherwise
;;;     is-member? is #f.
(define string-member?
  (lambda (str strings)
    (and (not (null? strings))
         (or (string-ci=? str (car strings))
             (string-member? str (cdr strings))))))