Received: by ATHENA-PO-2.MIT.EDU (5.45/4.7) id AA03197; Tue, 13 Dec 88 20:08:56 EST Received: by ATHENA.MIT.EDU (5.45/4.7) id AA06458; Tue, 13 Dec 88 20:08:45 EST Received: by media-lab.media.mit.edu (5.59/4.8) id AA08685; Tue, 13 Dec 88 19:56:06 EST Date: Tue, 13 Dec 88 19:56:06 EST From: Brian Gardner Message-Id: <8812140056.AA08685@media-lab.media.mit.edu> To: bgardner@ATHENA.MIT.EDU Subject: zoo2.l ;; (sys:on 'listener-read-macro) ; /u/russell/bwindow/lib ; /u/russell/bwindow/win.l ; /u/suguru/DESIGN/WINDOW/win-utils.l (print (load "/u/russell/bwindow/win-lucid")) (print (load "/u/suguru/bwindow/zoo.l")) ; create global variables (defvar *our-root-prompt-window* nil) (defvar *our-prompt-window* nil) (defvar *our-output-window* nil) (defvar *zoo-database* '(poodle)) (defvar *sketch-pad-counter* 0) (loadem) (setup_pid) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; top level function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun run-zoo () (setq *zoo-database* '("poodle")) (starter 0) (setup-files) (load-stuff) (make-windows) (echo-icon-do) (start)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun zoo-do (&rest args) (open-window "our-root-prompt-window") (setq *zoo-database* (apply 'investigate *zoo-database*))) (defun investigate (nodename &optional (truelist nil) (falselist nil)) (cond ((and (null truelist) (null falselist)) (guess nodename)) ((does-it-have-a? nodename) (list nodename (apply 'investigate truelist) falselist)) (t (list nodename truelist (apply 'investigate falselist))))) (defun guess (animal) (install-window animal) (open-window animal) (cond ((string= (get-prompted (format nil "Is it a ~A? (yes or no)" animal)) "yes") (cursor-off) (close-window "our-output-window") (close-window animal) (change-do animal "DoLisp" "pointer" :fname "do-nothing" :button "JUSTDOWN") (close-window "our-root-prompt-window") (cursor-on) `(,animal)) (t ; It isn't an animal we know yet, so learn it. (close-window animal) (let ((new-animal (get-prompted "What is the name of the animal?"))) (let ((prop (get-prompted (format nil "What does a ~A have that a ~A doesn't? (one word)" new-animal animal)))) (make-sketch-pad new-animal "our-root-prompt-window") (list prop `(,new-animal) `(,animal))))))) (defun does-it-have-a? (property) (string= (get-prompted (format nil "Does it have a ~A? (yes or no)" property)) "yes")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun make-windows () (make-root-window) ; create window to dynamically prompt user (setq *our-root-prompt-window* "our-root-prompt-window") (make-window "our-root-prompt-window" "Root" 110 168 1050 625 "our-root-prompt-window") (rectify "our-root-prompt-window" 50 50 130 0 0 0 0 0) (install-window "our-root-prompt-window") (move-self "our-root-prompt-window" "grabber") (unstall-window "our-root-prompt-window") ; Make text input box under user prompt window (setq *our-prompt-window* "our-prompt-window") (make-get-string-win "our-prompt-window" "our-root-prompt-window" 50 50 150 30 254 254 254 2 1 3 3 3 "24x8" 0 0 0 0 0 0) (install-window "our-prompt-window") ; Make text output box under user prompt window (setq *our-output-window* "our-output-window") (make-window "our-output-window" "our-root-prompt-window" 50 14 150 30 "our-output-window") (clipped-string-draw "our-output-window" "24x8" " " 0 0 0 255 255 255 nil) (install-window "our-output-window") ;; Make instruction window (make-window "our-instr-window" "our-root-prompt-window" 700 115 300 300 "our-instr-window") (wrapped-string-draw "our-instr-window" "24x8" "blah" 0 0 0 214 172 0 "/u/suguru/zoo-instr.txt") (install-window "our-instr-window") ;; Create Initial default animal sketch. (make-sketch-pad "poodle" "our-root-prompt-window") (change-string "our-output-window" " ") (make-window "scrib" "poodle-sketch" 0 0 475 475 "scrib") (scribbler "scrib" "suki.1" 100) (move-self "scrib" "grabber") (install-window "scrib") (close-window "poodle") ; Create initial buttons for break-ing (make-window "our-break-window" "Root" 1060 800 100 30 "our-break-window") (rectify "our-break-window" 200 0 200 0 0 0 0 0) (install-window "our-break-window") (change-do "our-break-window" "DoLisp" "pointer" :fname "break" :button "JUSTDOWN") ; Create label for break button (make-window "our-break-button-label" "our-break-window" 20 5 100 30 "our-break-button-label") (clipped-string-draw "our-break-button-label" "24x8" "BREAK" 0 0 0 255 255 255 nil) (install-window "our-break-button-label") (wimp "our-break-button-label") ; Create quit button (make-window "our-quit-window" "Root" 940 800 100 30 "our-quit-window") (rectify "our-quit-window" 200 0 200 0 0 0 0 0) (install-window "our-quit-window") (change-do "our-quit-window" "DoQuit" "pointer") ; Create label for quit button (make-window "our-quit-button-label" "our-quit-window" 20 5 100 30 "our-quit-button-label") (clipped-string-draw "our-quit-button-label" "24x8" "QUIT" 0 0 0 255 255 255 nil) (install-window "our-quit-button-label") (wimp "our-quit-button-label") ; Create start button (make-window "our-start-window" "Root" 820 800 100 30 "our-start-window") (rectify "our-start-window" 200 0 200 0 0 0 0 0) (install-window "our-start-window") (change-do "our-start-window" "DoLisp" "pointer" :fname "get-prompted" :button "JUSTDOWN") ; Create label for start button (make-window "our-start-button-label" "our-start-window" 20 5 100 30 "our-start-button-label") (clipped-string-draw "our-start-button-label" "24x8" "START" 0 0 0 255 255 255 nil) (install-window "our-start-button-label") (wimp "our-start-button-label") ; Create button to invoke dialog box (make-window "our-invoke-prompt-window" "Root" 110 73 1050 78 "our-invoke-prompt-window") (rectify "our-invoke-prompt-window" 0 0 90 0 0 0 0 0) (install-window "our-invoke-prompt-window") (change-do "our-invoke-prompt-window" "DoLisp" "pointer" :fname "get-prompted" :button "JUSTDOWN") (open-window "Root") (process-commands)) ;; tell interpreter that set up is done (defun make-sketch-pad (animal-name parent-window) ; Create a sketch window for user. (set-color 1 1 1) (set-trans 0) (set-width 2) ; Prompt user for sketch. (change-string "our-output-window" "Please sketch your animal. (Press DONE when finished.)") (open-window "our-output-window") ; Make a sketch-pad root window with the name of the animal. (make-window animal-name parent-window 50 100 475 475 animal-name) (rectify animal-name 250 250 250 0 0 0 2 0) (install-window animal-name) ; Make a text label with the animal's name. (make-window (format nil "~A-text" animal-name) animal-name 25 15 50 30 (format nil "~A-text" animal-name)) (clipped-string-draw (format nil "~A-text" animal-name) "24x8" animal-name 0 0 0 3 3 3 nil) (install-window (format nil "~A-text" animal-name)) ; Make the actual sketch pad to draw in. (make-window (format nil "~A-sketch" animal-name) animal-name 0 0 475 475 (format nil "~A-sketch" animal-name)) (sketcher (format nil "~A-sketch" animal-name) "pencil" 5000) (install-window (format nil "~A-sketch" animal-name)) ; Make a done button, for signalling that drawing is finished. (make-window (format nil "~A-done" animal-name) animal-name 405 15 40 50 (format nil "~A-done" animal-name)) (clipped-string-draw (format nil "~A-done" animal-name) "24x8" "DONE" 0 0 0 3 3 3 nil) (change-do (format nil "~A-done" animal-name) "DoLisp" "pointer" :fname "done" :button "JUSTDOWN") (install-window (format nil "~A-done" animal-name)) (open-window animal-name)) (defun done-do (self-window &rest args) (let ((parent (report-parent self-window))) (cursor-off) (close-window "our-output-window") (close-window parent) (change-do parent "DoLisp" "pointer" :fname "do-nothing" :button "JUSTDOWN") (unstall-window parent) (close-window "our-root-prompt-window") (cursor-on))) (defun break-do (&rest args) (break)) (defun do-nothing-do (&rest args)) (defun get-prompted-do (&rest args) (zoo-do)) (defun make-root-window () (create-window "Root" "none" 0 0 "DisplayWidth" "DisplayHeight" "Root") (rectify "Root" 150 150 150 0 0 0 0 1) (printer "Root" "pointer") (Root-window "Root")) (defun get-prompted (str) (change-string "our-output-window" str) (open-window "our-output-window") (open-window "our-prompt-window") (let ((new-atom ; read user input from type-in window (car (get-string *our-prompt-window*)))) ; (close-window "our-root-prompt-window") (close-window "our-output-window") (close-window "our-prompt-window") new-atom)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun load-stuff () (make-echo "pointer" "/lisp/vlw/cgw/icons/point_cursor" 0 0 100) (make-echo "grabber" "/lisp/vlw/cgw/icons/grab_cursor" 0 0 100) (make-echo "pencil" "/lisp/vlw/cgw/icons/pencil_cursor" 0 22 50)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c () (clean-up) :a) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;