🚀 go-pugleaf

Probably written too many times in lisp and yet here I am posting this
one.  The ancient game of ``guess the animal''.

There is nothing special about this version of animal.  It saves its
state to ~/.animals.

Interactive entry points are `animal' and `play-animal'.  Play-animal
calls `animal' repeatedly with a boolean request to continue playing.

Written for GZ (where ever she is these days).

Pax, Keith

		*--------------------------------------*

(defvar animals-file "~/.animals" "Animal game data file")

(defvar animals-default-data '("a cat" nil nil) "Default data for animal game")

(defvar animals nil
  "Animal game data.  A recursive list of the form
(STRING TRUE-LIST FALSE_LIST) where TRUE-LIST and FALSE-LIST are lists of
the this form and STRING is either a question posed to the user or a name
of an animal.")

(defun animal ()
  "Play the game of animal using the variable `animals'"
  (interactive)
  (let (animal-buffer)
    (save-window-excursion
      (if (file-readable-p (expand-file-name animals-file))
	  (setq animal-buffer
		(find-file-noselect (expand-file-name animals-file)))
	(progn
	  (setq animal-buffer
		(create-file-buffer (expand-file-name animals-file)))
	  (set-buffer animal-buffer)
	  (erase-buffer)
	  (insert (format "%s" animals-default-data))))
      (set-buffer animal-buffer)
      (goto-char (point-min))
      (setq animals (read animal-buffer)))
    (animal-read-string
     "This is the game called animal where you think of an animal
and I try to guess which one you are thinking of.

Please think of an animal and answer the questions I give you." nil)
    (setq animals (parse-animal-tree animals))
    (save-window-excursion
      (set-buffer animal-buffer)
      (erase-buffer)
      (insert (format "%s" animals))
      (write-file (expand-file-name animals-file)))))

(defun play-animal ()
  "Play the games of animal lots of times"
  (interactive)
  (let (done)
    (while (not done)
      (progn
	(animal)
	(setq done (not (y-or-n-p "Would you like to play again? ")))))))

(defun parse-animal-tree (animal-list)
  "Ask questions about a list (STRING TRUE-LIST FALSE-LIST) until we reach a
terminal"
  (if (animal-query-user (car animal-list) (null (car (cdr animal-list))))
      (if (null (car (cdr animal-list)))
	  (progn 
	    (message "Thanks for playing.")
	    animal-list)			
	(list (car animal-list)
	      (parse-animal-tree
	       (car (cdr animal-list))) (car (cdr (cdr animal-list)))))
    (if (null (car (cdr (cdr animal-list))))
	(animal-give-up animal-list)
      (list (car animal-list)
	    (car (cdr animal-list))
	    (parse-animal-tree (car (cdr (cdr animal-list))))))))

(defun animal-query-user (question terminal)
  "Query user about information on a particular animal"
  (y-or-n-p (if terminal
		(format "Is it %s? " question)
	      (format "%s? " question))))

(defun animal-give-up (animal-list)
  "Given an animal list, query the user for information on a new type
of animal"
  (let (new-animal new-question)
    (progn
      (setq new-animal
	    (animal-read-string "I give up.  I need to know a little bit about the animal you are thinking of
so I won't miss this one next time." "What animal where you thinking of? "))
      (setq new-question
	    (animal-read-string
	     (format
	      "I also need to know how to ask a yes or no question that
distinguishes %s from %s.  Please type in such
a question (ie, \"Does it have wings\" would be a suitable question to
distinguish a bird from a cat)."
	new-animal (car animal-list))  "Please type in a question: "))
      (list new-question (list new-animal nil nil) animal-list))))

(defun animal-read-string (buffer-string prompt-string)
  "Open a buffer up, spew some helpul advice and accept a string"
  (let (animal-help-buffer)
    (progn
      (setq animal-help-buffer (get-buffer "*Animal-Help*"))
      (if animal-help-buffer
	  nil
	(setq animal-help-buffer (generate-new-buffer "*Animal-Help*")))
      (set-buffer animal-help-buffer)
      (erase-buffer)
      (insert buffer-string)
      (goto-char (point-min))
      (display-buffer animal-help-buffer)
      (if (not (null prompt-string))
	  (read-string prompt-string)))))