This program uses the files
hangman.dict
and
hangman.index.
hangman.lisp
(defconstant file-root "c:/Documents and Settings/John/lisp-prog/")
(defconstant dictionary-file (concatenate 'string file-root "hangman.dict"))
(defconstant index-file (concatenate 'string file-root "hangman.index"))
(defconstant index-size 100)
(defvar word-count 0
"The number of lines in the word file.")
(defvar index-array (make-array (1+ index-size) :element-type 'integer))
(defun create-dictionary-index ()
(let ((p (parse-namestring index-file)))
(with-open-file (s p :direction :input)
(setf word-count (parse-integer (read-line s)))
(dotimes (i (1+ index-size))
(setf (aref index-array i) (parse-integer (read-line s))))
)))
(create-dictionary-index)
(defun select-word (number)
(let* ((p (parse-namestring dictionary-file))
(increment (floor (/ word-count index-size)))
(index (floor (/ number increment)))
(counter (* index increment)))
(with-open-file (s p :direction :input)
(file-position s (aref index-array index))
(do ((l (read-line s) (read-line s nil 'eof)))
((or (eq l 'eof) (= counter number)) l)
(incf counter)))
))
(defun select-letter ()
(let ((letter
(progn
(write-string "Select letter: ")
(force-output)
(clear-input)
(ignore-errors (string-upcase (read-line))))))
(if (and (= (length letter) 1) (alpha-char-p (char letter 0)))
letter
(progn
(write-line "Type a single letter.")
(select-letter)))))
(defun make-guess-string (guessed word)
(let ((current
(make-string (length word) :initial-element #\-)))
(loop for i from 0 to (- (length word) 1) do
(let ((ch (elt word i)))
(if (search (make-string 1 :initial-element ch) guessed)
(setf (elt current i) ch))))
current))
(defun gallow-matrix (failures)
(let ((gallow-matrix
(make-array '(12 12) :element-type 'character :initial-element #\SPACE)))
(tagbody
(case failures
(1 (go head))
(2 (go body))
(3 (go right-arm))
(4 (go left-arm))
(5 (go right-leg))
(6 (go left-leg))
(7 (go right-hand))
(8 (go left-hand))
(9 (go right-foot))
(10 (go left-foot)))
left-foot
(setf (aref gallow-matrix 10 2) #\\)
right-foot
(setf (aref gallow-matrix 10 8) #\/)
left-hand
(setf (aref gallow-matrix 2 1) #\/)
right-hand
(setf (aref gallow-matrix 2 9) #\\)
left-leg
(setf (aref gallow-matrix 9 4) #\/)
(setf (aref gallow-matrix 10 3) #\/)
right-leg
(setf (aref gallow-matrix 9 6) #\\)
(setf (aref gallow-matrix 10 7) #\\)
left-arm
(loop for (i j) in '((3 1) (4 2) (5 3) (6 4)) do
(setf (aref gallow-matrix i j) #\\))
right-arm
(loop for (i j) in '((6 6) (5 7) (4 8) (3 9)) do
(setf (aref gallow-matrix i j) #\/))
body
(loop for (i j) in '((5 5) (6 5) (7 5) (8 5)) do
(setf (aref gallow-matrix i j) #\X))
head
(loop for (i j) in '((2 4) (2 5) (2 6) (4 4) (4 5) (4 6)) do
(setf (aref gallow-matrix i j) #\-))
(setf (aref gallow-matrix 3 3) #\()
(setf (aref gallow-matrix 3 7) #\))
(setf (aref gallow-matrix 3 4) #\.)
(setf (aref gallow-matrix 3 6) #\.)
;gallow
(loop for j from 0 to 11 do
(setf (aref gallow-matrix j 0) #\X))
(loop for i from 0 to 5 do
(setf (aref gallow-matrix 0 i) #\X))
(setf (aref gallow-matrix 1 5) #\X)
)
gallow-matrix))
(defun draw-gallow (failures)
(let ((gallow-matrix (gallow-matrix failures)))
(loop for line from 0 to 11 do
(loop for col from 0 to 11 do
(write-char (aref gallow-matrix line col)))
(terpri)
finally
(terpri))))
(defun return-progress (failures)
(case failures
(1 "First, we draw the head.")
(2 "Now we draw a body")
(3 "Next we draw and arm.")
(4 "This time it's the other arm.")
(5 "Now, let's draw the right leg.")
(6 "This time, let's draw the left leg.")
(7 "Now we put up a hand.")
(8 "Next the other hand.")
(9 "Now we put up a foot.")
(10 "Heres the other foot.")))
(defun hangman ()
(setf *random-state* (make-random-state t))
(loop
(let* ((current-word (select-word (random word-count)))
(current-letter "*")
(guessed-letter-list "")
(guessed-word (make-guess-string guessed-letter-list current-word))
(tries 0)
(dead nil)
(success nil))
(terpri)
(write-line "This is the game of hangman.")
(write-line "I have selected a word.")
(write-line "Now you try to guess it.")
(terpri)
(write-line guessed-word)
(terpri)
(loop until (or dead success) do
(setq current-letter (select-letter))
(terpri)
(if (search current-letter guessed-letter-list)
(progn
(write-line "You already tried that.")
(terpri))
(progn
(setq guessed-letter-list
(sort
(remove-duplicates
(concatenate 'string current-letter
guessed-letter-list))
'char-lessp))
(write-line "Here are the letters you used")
(write-line guessed-letter-list)
(terpri)
(setq guessed-word
(make-guess-string guessed-letter-list current-word))
(write-line guessed-word)
(terpri)
(if (string= guessed-word current-word)
(progn
(write-line "You guessed it!")
(terpri)
(setq success t))
(if (not (search current-letter current-word))
(progn
(incf tries)
(write-line (return-progress tries))
(draw-gallow tries)
(if (= tries 10)
(progn
(format *standard-output*
"You are hung!~%~%The word was ~S.~%~%"
current-word)
(setq dead t)))))))))
(unless (y-or-n-p "Play again? ") (return)))))
genindex.lisp
(defconstant dictionary-file "c:\\lisp-prog\\hangman.dict")
(defconstant index-file "c:\\lisp-prog\\hangman.index")
(defconstant index-size 100)
(defun count-lines-file ()
(let ((sz 0) (p (parse-namestring dictionary-file)))
(with-open-file (s p :direction :input)
(do ((l (read-line s) (read-line s nil 'eof)))
((eq l 'eof) sz)
(incf sz)))))
(defun make-index-file ()
(let* ((word-count (count-lines-file))
(in-name (parse-namestring dictionary-file))
(out-name (parse-namestring index-file))
(increment (floor (/ word-count index-size)))
(index 0))
(with-open-file (out out-name :direction :output :if-exists :supersede)
(format out "~D~%" word-count)
(format out "~D~%" 0)
(with-open-file (in in-name :direction :input)
(do ((l (read-line in)
(read-line in nil 'eof)))
((eq l 'eof) Nil)
(incf index)
(if (= (mod index increment) 0)
(format out "~&~D~%" (file-position in)))
))
)))
![[HOME]](../home.png)