;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: DICT -*-

; Write a big word and pronunciation list from the Entire dictionary

; A P: can occur after First, Variant, or Runon.  We only care
; about First.  Some Firsts have no Pronunciation (e.g. affixes)

(defun copy-words-and-prons (stream listing)
  "Copy all words and prons from STREAM to LISTING, converting to Klattese"
  (let (word pron)
    (do ((line (read-line stream NIL NIL) (read-line stream NIL NIL)))
	((null line))
      (when (string-equal line "F:" :start1 0 :end1 2)
	(setf word (subseq line 2 (position #\; line :start 2)))
	(setf pron (read-line stream))
	(when (and
		(not
		  ;; filter out weird words
		  (find #\space word :test 'char=))
		(string-equal pron "P:" :start1 0 :end1 2))
	  (setf pron  (subseq pron 2))
	  (format listing "~A  ~A~%" word (webster-pron-to-klattese pron)))))))


(defun make-pron-lists ()
  "Make a set of files, extracting the pronunciations from Webster"
  (let ((pron-root (pathname "SPELL:DATA;*.P")))
    (dolist (file-name *word-file-names*)
      (with-open-file (stream (merge-pathnames file-name pron-root) :direction :output
			      :if-exists NIL)
	(with-open-file (words (pathname-for-word file-name) :direction :input)
	  (copy-words-and-prons words stream)
	  (terpri stream)))
      (princ file-name)
      (terpri))))

(defun make-big-pron-list ()
  (let ((pron-root (pathname "SPELL:DATA;WEBSTER.PRONS")))
    (with-open-file (stream pron-root :direction :output)
      (dolist (file-name *word-file-names*)
	(with-open-file (words (pathname-for-word file-name) :direction :input)
	  (copy-words-and-prons words stream)
	  (terpri stream))
	(princ file-name)
	(terpri)))))
#||
(with-open-file (in "DICTIONARY:WORDS;A.D"
		      :direction :input)
    (copy-words-and-prons in *standard-output*))

||#