;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname |39.2|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
#|
Exercise 39.2.3.   Develop make-hangman. The program consumes a list of words, creates a hangman game using the list, and produces the hangman-guess function as a result. A player would use the dialogue as follows:

> (define hangman-easy (make-hangman (list 'a 'an 'and 'able 'adler)))
> (define hangman-difficult (make-hangman (list 'ardvark ...)))
> (hangman-easy 'a)
"You won"
> (hangman-difficult 'a)
(list 'head (list '_ '_ '_ '_ '_ '_))
> ... 

Compare this with the first dialogue in section 37.2. 
|#

;Data Definitions
;
;;A word is a (listof letters) where letters is a symbol from 'a ... 'z and '_.
;
;A hangman-interface is an interface
;1. 'guess -> (letter -> response)
;2. 'reveal -> ( -> word)
;
;
;;A response is either
;;   1. "You won"
;;   2. (list "The End" body-part word)
;;   3. (list "Good guess!" word)
;;   4. (list "Sorry" body-part word)


;make-hangman : (listof word) -> hangman-interface
;;Effect: Given alow, uses the (listof word) to create the hidden, chosen words (WORDS).
;;Output: Returns a hangman-interface, which can be used to access hangman-guess and hangman-reveal.

(define (make-hangman alow)
  (local (;;The list of potential chosen words
          (define WORDS alow)
          ;;The alphabet
          (define LETTERS '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
          ;;The number of words
          (define WORDS# (length WORDS))
          ;;A body-part is one of the following symbols:
          (define PARTS '(noose head body right-arm left-arm right-leg left-leg))
          
          ;;State Variables
          ;;chosen-word : word
          ;;This word is the target word that the player needs to guess
          (define chosen-word (first WORDS))
          ;;status-word : word
          ;;This word represents the current status of the player's guesses
          (define status-word (first WORDS))
          ;;body-parts-left : (listof body-parts)
          ;;Indicates how many body-parts are left before the hangman is dead.
          (define body-parts-left PARTS)
          ;;previous-guesses : word
          ;;Keeps track of all previous guesses.
          (define previous-guesses empty)
          ;;new-knowledge : boolean
          ;;Keeps track of whether or not the guessed letter adds new-knowledge.
          (define new-knowledge false)
          ;;letters-remaining : number
          ;;Keeps track of the letters that still need to be uncovered.
          (define letters-remaining (length chosen-word))
          
          ;make-status-word : word -> word
          ;Given aword, creates an equally long word consisting only of the letter '_.
          (define (make-status-word aword)
            (build-list (length aword) (lambda (x) '_)))
          
          ;;hangman : -> void
          ;;Initiates the hangman program by selecting the chosen word and resetting the status word and the number of body-parts left.
          (define (hangman)
            (begin (set! chosen-word (list-ref WORDS (random WORDS#)))
                   (set! status-word (make-status-word chosen-word))
                   (set! body-parts-left PARTS)
                   (set! previous-guesses empty)
                   (set! new-knowledge false)
                   (set! letters-remaining (length chosen-word))))
          
          ;hangman-guess : letter -> response
          ;If aletter is present in chosen-word but not in status-word, (effect) update status-word.  Otherwise, shorten body-part-list.  In all cases, output one of the four possible responses.  Also effect the update of previous-guesses.
          
          (define (hangman-guess aletter)
            (local ((define updated-status (reveal-word chosen-word status-word aletter)))
              (cond
                [(contains previous-guesses aletter) "You have used this guess before."]
                [else
                 (begin
                   (set! previous-guesses (cons aletter previous-guesses))
                   (cond
                     [new-knowledge (begin (set! status-word updated-status)
                                           (set! letters-remaining (sub1 letters-remaining))
                                           (cond
                                             [(zero? letters-remaining) "You won"]
                                             [else (list "Good guess!" status-word)]))]
                     [else
                      (local ((define lost-part (first body-parts-left)))
                        (begin (set! body-parts-left (rest body-parts-left))
                               (cond  
                                 [(empty? body-parts-left) (list "The End" lost-part chosen-word)]
                                 [else (list "Sorry" lost-part status-word)])))]))])))
          
          ;reveal-word: word word letter -> word
          ;Given chosen-word, status-word, and aletter, return an updated status-word where '_ is replaced by aletter for all letters in chosen-word that are aletter.
          
          (define (reveal-word chosen-word status-word aletter)
            (local ((define (reveal-letter chosen-letter status-letter)
                      (cond
                        [(and (symbol=? chosen-letter aletter)
                              (symbol=? status-letter '_))
                         (begin (set! new-knowledge true)
                                aletter)]
                        [else status-letter])))
              (begin (set! new-knowledge false)
                     (map reveal-letter chosen-word status-word)))) 
          
          ;contains : (listof X) X -> boolean
          ;Determine if alox contains anx
          (define (contains alox anx)
            (ormap (lambda (x) (equal? x anx)) alox))
          (define (service-manager msg)
            (cond
              [(equal? msg 'guess) hangman-guess]
              [(equal? msg 'reveal) chosen-word]
              [else (error 'make-hangman "msg not understood")])))
    (begin (hangman)
           service-manager)))

(define my-hangman (make-hangman '((f a r m e r)
                                   (p l a n t e r)
                                   (t r a c t o r)
                                   (s e e d s)
                                   (l i v e s t o c k))))