;;
;;  LMORPH,  edited version of MORPHO, part of SHRDLU
;;

(declare (genprefix morpho))

(defun etaoin nil
  (prog (word newword char altn already-blging-newwrd wrd last next
 	 y word1 x rd poss)
   thru (setq sent (setq word (setq punct (setq poss nil))))
	(print 'READY)
	(terpri)
	(and mobyread (ioc q))
   char (cond ((equal (tyipeek) 24.) (readch) (ert) (go thru)))
	(cond ((equal (tyipeek)  3.)
	       (or (and mobyread (end-of-file-condition))
		   (bug etaoin: about to read eof))))
	(setq char
          (cond ((greaterp 123. (setq char (tyi)) 96.)  (- char 32.))
	  	((greaterp  91. char 64.)               char)
                (t char))
          char (ascii char))
        (cond ((eq char '/) (go word))
              ((memq char altmode)
               (setq char (ascii (uppercase-ify-char (tyi))))
               (cond ((memq char altmode)
                      (ert)
                      (go thru))
                     ((eq char 'C)
                      (tyo 12.)
                      (go do))
                     ((eq char 'R) 
                      (terpri)
                      (go do))
                     ((and (eq char 'S) savesent)
                      (setq sent  (car savesent))
                      (setq punct (cdr savesent))
                      (%)
                      (return sent))
                     ((eq char 'N)
                      (setq newword (not newword)
                            altn    (not altn))
                      (go char))
                     ((eq char 'Q)
                      (ioc q)
                      (setq ignore nil)
                      (go thru))
                     ((eq char 'M)
                      (ioc q)
                      (setq ignore   nil
                            mobyread t)
                      (go thru))
                     ((eq char 'I)
                      (setq ignore t)
                      (ioc q)
                      (go thru))
                     ((go thru))) )
              ((eq char rubout)
               (cond (word
                      (princ (car word))
                      (setq word (cdr word)))
                     (sent
                      (print (car sent))
                      (setq sent (cdr sent))))
               (go char))
              ((eq char carret)
               (go word))
              ((memq char puncl)
               (setq punct char)
               (and word (go word))
               (go func)))