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 |37.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 ;;Model
5 
6 ;A word is a (listof letters) where letters is a symbol from 'a ... 'z and '_.
7 
8 ;;Constants
9 
10 (define WORDS '((o c t o p u s)
11                 (s q u i d)
12                 (s a l m o n)
13                 (t i l a p i a)
14                 (b a s s)
15                 (s h r i m p)
16                 (c l a m s)
17                 (m u s s e l)
18                 (o y s t e r)
19                 (c r a b)
20                 (s t a r f i s h)
21                 (j e l l y f i s h)
22                 (s e a l i o n)
23                 (t u n a)
24                 (d o l p h i n)
25                 (w h a l e)
26                 (k e l p)
27                 (m a n a t e e)))
28 
29 ;;The alphabet
30 (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))
31 
32 ;;The number of words
33 (define WORDS# (length WORDS))
34 
35 ;;A body-part is one of the following symbols:
36 (define PARTS '(noose head body right-arm left-arm right-leg left-leg))
37 
38 ;;State Variables
39 
40 ;;chosen-word : word
41 ;;This word is the target word that the player needs to guess
42 
43 (define chosen-word (first WORDS))
44 
45 ;;status-word : word
46 ;;This word represents the current status of the player's guesses
47 
48 (define status-word (first WORDS))
49 
50 ;;body-parts-left : (listof body-parts)
51 ;;Indicates how many body-parts are left before the hangman is dead.
52 
53 (define body-parts-left PARTS)
54 
55 ;;previous-guesses : word
56 ;;Keeps track of all previous guesses.
57 
58 (define previous-guesses empty)
59 
60 ;make-status-word : word -> word
61 ;Given aword, creates an equally long word consisting only of the letter '_.
62 
63 (define (make-status-word aword)
64   (build-list (length aword) (lambda (x) '_)))
65 
66 ;;hangman : -> void
67 ;;Initiates the hangman program by selecting the chosen word and resetting the status word and the number of body-parts left.
68 
69 (define (hangman)
70   (begin (set! chosen-word (list-ref WORDS (random WORDS#)))
71          (set! status-word (make-status-word chosen-word))
72          (set! body-parts-left PARTS)))
73 
74 ;;Initializes the state variables
75 (hangman)
76 
77 ;A response is either
78 ;   1. "You won"
79 ;   2. (list "The End" body-part word)
80 ;   3. (list "Good guess!" word)
81 ;   4. (list "Sorry" body-part 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 old-status status-word)
88           (define updated-status (begin (reveal-list! aletter)
89                                         status-word)))
90     (cond
91       [(contains previous-guesses aletter) "You have used this guess before."]
92       [else
93        (begin
94          (set! previous-guesses (cons aletter previous-guesses))
95          (cond
96            [(equal? old-status updated-status)
97             (local ((define lost-part (first body-parts-left)))
98               (begin (set! body-parts-left (rest body-parts-left))
99                      (cond  
100                        [(empty? body-parts-left) (list "The End" lost-part chosen-word)]
101                        [else (list "Sorry" lost-part status-word)])))]
102            [(equal? status-word chosen-word) "You won"]
103            [else (list "Good guess!" status-word)]))])))
104 
105 ;reveal-word: word word letter -> word
106 ;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.
107 
108 (define (reveal-word chosen-word status-word aletter)
109   (local ((define (reveal-letter chosen-letter status-letter)
110             (cond
111               [(equal? chosen-letter aletter) chosen-letter]
112               [else status-letter])))
113     (map reveal-letter chosen-word status-word))) 
114 
115 ;;reveal-list! : letter -> void
116 ;;effect: modifies status-word based on a comparison with chosen-word, status-word, and guess
117 
118 (define (reveal-list! guess)
119   (local ((define (reveal-one chosen-letter status-letter)
120             (cond
121               [(symbol=? chosen-letter guess) guess]
122               [else status-letter])))
123     (set! status-word (map reveal-one chosen-word status-word))))
124 
125 ;contains : (listof X) X -> boolean
126 ;Determine if alox contains anx
127 (define (contains alox anx)
128   (ormap (lambda (x) (equal? x anx)) alox))
129 ;Exercise 37.2.4.   Formulate the four examples for hangman-guess as boolean-valued expressions that produce true if hangman-guess is correct. Develop an additional example for each case; turn these new examples into additional tests.    Solution
130 
131 #|
132 ;Tests
133 ;test-hangman : letter word X -> boolean
134 ;Tests hangman-guess and returns true if the test is successful.  Consumes guess (a letter), status (a word), partsleft (listof body-parts), and response (one of the four responses).
135 (define (test-hangman guess status partsleft response)
136   (begin (set! chosen-word '(b a l l))
137          (set! status-word status)
138          (set! body-parts-left partsleft)
139          (equal? (hangman-guess guess) response)))
140 
141 
142 
143 (and (test-hangman 'l '(b _ _ _) '(arm leg) '("Good guess!" (b _ l l)))
144      (equal? status-word '(b _ l l)))
145 (test-hangman 'a '(b _ l l) '(arm leg) "You won")
146 (and (test-hangman 'l '(b _ l l) '(right-leg left-leg) '("Sorry" right-leg (b _ l l)))
147      (equal? body-parts-left '(left-leg)))
148 (and (test-hangman 'l '(b _ l l) '(left-leg) '("The End" (b a l l)))
149      (equal? body-parts-left empty))
150 |#
151 
152 ;;View
153 
154 ;word->string : word -> string
155 ;Given a word, convert it to a string.
156 
157 (define (word->string aword)
158   (foldr string-append "" (map (lambda (aletter) (symbol->string aletter)) aword)))
159 
160 ;;GUI-items
161 (define guess-message (make-message "Guess: "))
162 (define guess-choice (make-choice (map (lambda (aletter) (symbol->string aletter)) LETTERS)))
163 (define status-message (make-message "Status: "))
164 (define status-word-message (make-message (word->string status-word)))
165 (define result-message (make-message "Let's play hangman!"))
166 (define body-part-message (make-message ""))
167 
168 ;;Controller
169 
170 ;   1. "You won"
171 ;   2. (list "The End" body-part word)
172 ;   3. (list "Good guess!" word)
173 ;   4. (list "Sorry" body-part word)
174 
175 
176 (define (check-call-back event)
177   (local ((define response (hangman-guess (list-ref LETTERS (choice-index guess-choice)))))
178     (cond
179       [(string? response) (and (draw-message result-message response)
180                                (draw-message status-word-message (word->string status-word)))]
181       [(= (length response) 2)
182        (and (draw-message result-message (first response))
183             (draw-message status-word-message (word->string (second response))))]
184       [(and (draw-message result-message (first response))
185             (draw-message body-part-message (symbol->string (second response)))
186             (draw-message status-word-message (word->string (third response)))
187             (draw-next-part (second response)))
188        (cond
189          [(empty? body-parts-left)
190           (begin (hangman)
191                  (draw-message status-message "Chosen Word:"))]
192          [else true])])))
193 
194 (define check-button (make-button "Check" check-call-back))
195 
196 (create-window
197  (list (list guess-message guess-choice check-button)
198        (list status-message status-word-message)
199        (list result-message body-part-message)))
200 
201 (define CWIDTH 300)
202 (define CHEIGHT 300)
203 (start CWIDTH CHEIGHT)
204 
205 ; draw-next-part : symbol -> boolean
206 ; Draws the next part given the name of the part.  Returns true if
207 ; drawing is successful.
208 
209 (define (draw-next-part part)
210   (local ((define XCENTER (/ CWIDTH 2))
211           (define COLORHEAD 'brown)
212           (define COLORBODY 'purple)
213           (define COLORARMS 'brown)
214           (define COLORLEGS 'red)
215           (define (draw-noose)
216             (and (draw-solid-line (make-posn 0 (/ CHEIGHT 10))
217                                   (make-posn XCENTER (/ CHEIGHT 10)))
218                  (draw-solid-line (make-posn XCENTER (/ CHEIGHT 10))
219                                   (make-posn XCENTER (/ CHEIGHT 5)))))
220           (define (draw-head)
221             (draw-circle (make-posn XCENTER (/ CHEIGHT 3)) (* CHEIGHT 2/15) COLORHEAD))
222           (define (draw-body)
223             (draw-solid-line (make-posn XCENTER (* 7/15 CHEIGHT))
224                              (make-posn XCENTER (* CHEIGHT 3/4))
225                              COLORBODY))
226           (define (draw-right-arm)
227             (draw-solid-line (make-posn XCENTER (* 3/5 CHEIGHT))
228                              (make-posn (* CWIDTH 3/4) (* CHEIGHT 7/15))
229                              COLORARMS))
230           (define (draw-left-arm)
231             (draw-solid-line (make-posn XCENTER (* 3/5 CHEIGHT))
232                              (make-posn (* CWIDTH 1/4) (* CHEIGHT 7/15))
233                              COLORARMS))
234           (define (draw-right-leg)
235             (draw-solid-line (make-posn XCENTER (* 3/4 CHEIGHT))
236                              (make-posn (* CWIDTH 7/8) (* CHEIGHT 15/16))
237                              COLORLEGS))
238           (define (draw-left-leg)
239             (draw-solid-line (make-posn XCENTER (* 3/4 CHEIGHT))
240                              (make-posn (* CWIDTH 1/8) (* CHEIGHT 15/16))
241                              COLORLEGS)))
242     (cond
243       [(symbol=? part 'noose) (draw-noose)]
244       [(symbol=? part 'head) (draw-head)]
245       [(symbol=? part 'body) (draw-body)]
246       [(symbol=? part 'right-arm) (draw-right-arm)]
247       [(symbol=? part 'left-arm) (draw-left-arm)]    
248       [(symbol=? part 'right-leg) (draw-right-leg)]    
249       [(symbol=? part 'left-leg) (draw-left-leg)])))
250 
251 
252 ;;Wish-list
253 ;;Once game is over, create a new button, reset the board
254 ;;Once game is over, you need to erase the body-part message or at least put the correct body part image (left-leg is never given)
255 ;;Once game is over, replace status-word with chosen-word