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