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.3|) (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 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            [(equal? status-word updated-status)
95             (local ((define lost-part (first body-parts-left)))
96               (begin (set! body-parts-left (rest body-parts-left))
97                      (cond  
98                        [(empty? body-parts-left) (list "The End" lost-part chosen-word)]
99                        [else (list "Sorry" lost-part status-word)])))]
100            [else (begin (set! status-word updated-status)
101                         (cond
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 ;contains : (listof X) X -> boolean
116 ;Determine if alox contains anx
117 (define (contains alox anx)
118   (ormap (lambda (x) (equal? x anx)) alox))
119 ;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
120 
121 #|
122 ;Tests
123 ;test-hangman : letter word X -> boolean
124 ;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).
125 (define (test-hangman guess status partsleft response)
126   (begin (set! chosen-word '(b a l l))
127          (set! status-word status)
128          (set! body-parts-left partsleft)
129          (equal? (hangman-guess guess) response)))
130 
131 
132 
133 (and (test-hangman 'l '(b _ _ _) '(arm leg) '("Good guess!" (b _ l l)))
134      (equal? status-word '(b _ l l)))
135 (test-hangman 'a '(b _ l l) '(arm leg) "You won")
136 (and (test-hangman 'l '(b _ l l) '(right-leg left-leg) '("Sorry" right-leg (b _ l l)))
137      (equal? body-parts-left '(left-leg)))
138 (and (test-hangman 'l '(b _ l l) '(left-leg) '("The End" (b a l l)))
139      (equal? body-parts-left empty))
140 |#
141 
142 ;;View
143 
144 ;word->string : word -> string
145 ;Given a word, convert it to a string.
146 
147 (define (word->string aword)
148   (foldr string-append "" (map (lambda (aletter) (symbol->string aletter)) aword)))
149 
150 ;;GUI-items
151 (define guess-message (make-message "Guess: "))
152 (define guess-choice (make-choice (map (lambda (aletter) (symbol->string aletter)) LETTERS)))
153 (define status-message (make-message "Status: "))
154 (define status-word-message (make-message (word->string status-word)))
155 (define result-message (make-message "Let's play hangman!"))
156 (define body-part-message (make-message ""))
157 
158 ;;Controller
159 
160 ;   1. "You won"
161 ;   2. (list "The End" body-part word)
162 ;   3. (list "Good guess!" word)
163 ;   4. (list "Sorry" body-part word)
164 
165 
166 (define (check-call-back event)
167   (local ((define response (hangman-guess (list-ref LETTERS (choice-index guess-choice)))))
168     (cond
169       [(string? response) (and (draw-message result-message response)
170                                (draw-message status-word-message (word->string status-word)))]
171       [(= (length response) 2)
172        (and (draw-message result-message (first response))
173             (draw-message status-word-message (word->string (second response))))]
174       [(and (draw-message result-message (first response))
175             (draw-message body-part-message (symbol->string (second response)))
176             (draw-message status-word-message (word->string (third response)))
177             (draw-next-part (second response)))
178        (cond
179          [(empty? body-parts-left)
180           (begin (hangman)
181                  (draw-message status-message "Chosen Word:"))]
182          [else true])])))
183 
184 (define check-button (make-button "Check" check-call-back))
185 
186 (create-window
187  (list (list guess-message guess-choice check-button)
188        (list status-message status-word-message)
189        (list result-message body-part-message)))
190 
191 (define CWIDTH 300)
192 (define CHEIGHT 300)
193 (start CWIDTH CHEIGHT)
194 
195 ; draw-next-part : symbol -> boolean
196 ; Draws the next part given the name of the part.  Returns true if
197 ; drawing is successful.
198 
199 (define (draw-next-part part)
200   (local ((define XCENTER (/ CWIDTH 2))
201           (define COLORHEAD 'brown)
202           (define COLORBODY 'purple)
203           (define COLORARMS 'brown)
204           (define COLORLEGS 'red)
205           (define (draw-noose)
206             (and (draw-solid-line (make-posn 0 (/ CHEIGHT 10))
207                                   (make-posn XCENTER (/ CHEIGHT 10)))
208                  (draw-solid-line (make-posn XCENTER (/ CHEIGHT 10))
209                                   (make-posn XCENTER (/ CHEIGHT 5)))))
210           (define (draw-head)
211             (draw-circle (make-posn XCENTER (/ CHEIGHT 3)) (* CHEIGHT 2/15) COLORHEAD))
212           (define (draw-body)
213             (draw-solid-line (make-posn XCENTER (* 7/15 CHEIGHT))
214                              (make-posn XCENTER (* CHEIGHT 3/4))
215                              COLORBODY))
216           (define (draw-right-arm)
217             (draw-solid-line (make-posn XCENTER (* 3/5 CHEIGHT))
218                              (make-posn (* CWIDTH 3/4) (* CHEIGHT 7/15))
219                              COLORARMS))
220           (define (draw-left-arm)
221             (draw-solid-line (make-posn XCENTER (* 3/5 CHEIGHT))
222                              (make-posn (* CWIDTH 1/4) (* CHEIGHT 7/15))
223                              COLORARMS))
224           (define (draw-right-leg)
225             (draw-solid-line (make-posn XCENTER (* 3/4 CHEIGHT))
226                              (make-posn (* CWIDTH 7/8) (* CHEIGHT 15/16))
227                              COLORLEGS))
228           (define (draw-left-leg)
229             (draw-solid-line (make-posn XCENTER (* 3/4 CHEIGHT))
230                              (make-posn (* CWIDTH 1/8) (* CHEIGHT 15/16))
231                              COLORLEGS)))
232     (cond
233       [(symbol=? part 'noose) (draw-noose)]
234       [(symbol=? part 'head) (draw-head)]
235       [(symbol=? part 'body) (draw-body)]
236       [(symbol=? part 'right-arm) (draw-right-arm)]
237       [(symbol=? part 'left-arm) (draw-left-arm)]    
238       [(symbol=? part 'right-leg) (draw-right-leg)]    
239       [(symbol=? part 'left-leg) (draw-left-leg)])))
240 
241 
242 ;;Wish-list
243 ;;Once game is over, create a new button, reset the board
244 ;;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)
245 ;;Once game is over, replace status-word with chosen-word