1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #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")))))
4 #|
5 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:
6 
7 > (define hangman-easy (make-hangman (list 'a 'an 'and 'able 'adler)))
8 > (define hangman-difficult (make-hangman (list 'ardvark ...)))
9 > (hangman-easy 'a)
10 "You won"
11 > (hangman-difficult 'a)
12 (list 'head (list '_ '_ '_ '_ '_ '_))
13 > ... 
14 
15 Compare this with the first dialogue in section 37.2. 
16 |#
17 
18 ;Data Definitions
19 ;
20 ;;A word is a (listof letters) where letters is a symbol from 'a ... 'z and '_.
21 ;
22 ;A hangman-interface is an interface
23 ;1. 'guess -> (letter -> response)
24 ;2. 'reveal -> ( -> word)
25 ;
26 ;
27 ;;A response is either
28 ;;   1. "You won"
29 ;;   2. (list "The End" body-part word)
30 ;;   3. (list "Good guess!" word)
31 ;;   4. (list "Sorry" body-part word)
32 
33 
34 ;make-hangman : (listof word) -> hangman-interface
35 ;;Effect: Given alow, uses the (listof word) to create the hidden, chosen words (WORDS).
36 ;;Output: Returns a hangman-interface, which can be used to access hangman-guess and hangman-reveal.
37 
38 (define (make-hangman alow)
39   (local (;;The list of potential chosen words
40           (define WORDS alow)
41           ;;The alphabet
42           (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))
43           ;;The number of words
44           (define WORDS# (length WORDS))
45           ;;A body-part is one of the following symbols:
46           (define PARTS '(noose head body right-arm left-arm right-leg left-leg))
47           
48           ;;State Variables
49           ;;chosen-word : word
50           ;;This word is the target word that the player needs to guess
51           (define chosen-word (first WORDS))
52           ;;status-word : word
53           ;;This word represents the current status of the player's guesses
54           (define status-word (first WORDS))
55           ;;body-parts-left : (listof body-parts)
56           ;;Indicates how many body-parts are left before the hangman is dead.
57           (define body-parts-left PARTS)
58           ;;previous-guesses : word
59           ;;Keeps track of all previous guesses.
60           (define previous-guesses empty)
61           ;;new-knowledge : boolean
62           ;;Keeps track of whether or not the guessed letter adds new-knowledge.
63           (define new-knowledge false)
64           ;;letters-remaining : number
65           ;;Keeps track of the letters that still need to be uncovered.
66           (define letters-remaining (length chosen-word))
67           
68           ;make-status-word : word -> word
69           ;Given aword, creates an equally long word consisting only of the letter '_.
70           (define (make-status-word aword)
71             (build-list (length aword) (lambda (x) '_)))
72           
73           ;;hangman : -> void
74           ;;Initiates the hangman program by selecting the chosen word and resetting the status word and the number of body-parts left.
75           (define (hangman)
76             (begin (set! chosen-word (list-ref WORDS (random WORDS#)))
77                    (set! status-word (make-status-word chosen-word))
78                    (set! body-parts-left PARTS)
79                    (set! previous-guesses empty)
80                    (set! new-knowledge false)
81                    (set! letters-remaining (length chosen-word))))
82           
83           ;hangman-guess : letter -> response
84           ;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.
85           
86           (define (hangman-guess aletter)
87             (local ((define updated-status (reveal-word chosen-word status-word aletter)))
88               (cond
89                 [(contains previous-guesses aletter) "You have used this guess before."]
90                 [else
91                  (begin
92                    (set! previous-guesses (cons aletter previous-guesses))
93                    (cond
94                      [new-knowledge (begin (set! status-word updated-status)
95                                            (set! letters-remaining (sub1 letters-remaining))
96                                            (cond
97                                              [(zero? letters-remaining) "You won"]
98                                              [else (list "Good guess!" status-word)]))]
99                      [else
100                       (local ((define lost-part (first body-parts-left)))
101                         (begin (set! body-parts-left (rest body-parts-left))
102                                (cond  
103                                  [(empty? body-parts-left) (list "The End" lost-part chosen-word)]
104                                  [else (list "Sorry" lost-part status-word)])))]))])))
105           
106           ;reveal-word: word word letter -> word
107           ;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.
108           
109           (define (reveal-word chosen-word status-word aletter)
110             (local ((define (reveal-letter chosen-letter status-letter)
111                       (cond
112                         [(and (symbol=? chosen-letter aletter)
113                               (symbol=? status-letter '_))
114                          (begin (set! new-knowledge true)
115                                 aletter)]
116                         [else status-letter])))
117               (begin (set! new-knowledge false)
118                      (map reveal-letter chosen-word status-word)))) 
119           
120           ;contains : (listof X) X -> boolean
121           ;Determine if alox contains anx
122           (define (contains alox anx)
123             (ormap (lambda (x) (equal? x anx)) alox))
124           (define (service-manager msg)
125             (cond
126               [(equal? msg 'guess) hangman-guess]
127               [(equal? msg 'reveal) chosen-word]
128               [else (error 'make-hangman "msg not understood")])))
129     (begin (hangman)
130            service-manager)))
131 
132 (define my-hangman (make-hangman '((f a r m e r)
133                                    (p l a n t e r)
134                                    (t r a c t o r)
135                                    (s e e d s)
136                                    (l i v e s t o c k))))