*

1 files changed, 66 insertions, 0 deletions

diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Lib/animal.scm b/js/games/nluqo.github.io/~bh/61a-pages/Lib/animal.scm
new file mode 100644
index 0000000..424cacc
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/61a-pages/Lib/animal.scm
@@ -0,0 +1,66 @@
+(define (animal node)
+  (define (type node) (car node))
+  (define (question node) (cadr node))
+  (define (yespart node) (caddr node))
+  (define (nopart node) (cadddr node))
+  (define (answer node) (cadr node))
+  (define (leaf? node) (eq? (type node) 'leaf))
+  (define (branch? node) (eq? (type node) 'branch))
+  (define (set-yes! node x)
+    (set-car! (cddr node) x))
+  (define (set-no! node x)
+    (set-car! (cdddr node) x))
+
+  (define (yorn)
+    (let ((yn (read)))
+      (cond ((eq? yn 'yes) #t)
+	    ((eq? yn 'no) #f)
+	    (else (display "Please type YES or NO")
+		  (yorn)))))
+
+  (display (question node))
+  (display " ")
+  (let ((yn (yorn)) (correct #f) (newquest #f))
+    (let ((next (if yn (yespart node) (nopart node))))
+      (cond ((branch? next) (animal next))
+	    (else (display "Is it a ")
+		  (display (answer next))
+		  (display "? ")
+		  (cond ((yorn) "I win!")
+			(else (newline)
+			      (display "I give up, what is it? ")
+			      (set! correct (read))
+			      (newline)
+ 			      (display "Please tell me a question whose answer ")
+			      (display "is YES for a ")
+			      (display correct)
+			      (newline)
+			      (display "and NO for a ")
+			      (display (answer next))
+			      (display ".")
+			      (newline)
+			      (display "Enclose the question in quotation marks.")
+			      (newline)
+			      (set! newquest (read))
+			      (if yn
+				  (set-yes! node (make-branch newquest
+							   (make-leaf correct)
+							   next))
+				  (set-no! node (make-branch newquest
+							  (make-leaf correct)
+							  next)))
+			      "Thanks.  Now I know better.")))))))
+
+(define (make-branch q y n)
+  (list 'branch q y n))
+
+(define (make-leaf a)
+  (list 'leaf a))
+
+(define animal-list
+  (make-branch "Does it have wings?"
+	       (make-leaf 'parrot)
+	       (make-leaf 'rabbit)))
+
+
+(define (animal-game) (animal animal-list))