(in-package "KPML")

;;; File: waiting-generate.lisp
;;; Author: John Bateman, Feb 2000.
;;; 
;;;         Illustrative black box generator capability for KPML
;;;         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;
;;; ======================================================================
;;; Provides a simple function that goes into a loop waiting for input
;;; to appear in a particular file.  When the input (as SPL) appears
;;; there, it generates with the currently loading linguistic
;;; resources and places the output in a specified output file.  When
;;; *waiting-verbose* is set, you get a bunch of tracing messages to
;;; see what is going on. Interaction is assumed to be as follows:
;;; (1) some program makes an SPL specification for a sentence and
;;; writes it to the input file; (2) the black box generator sees this
;;; and writes the generated string to the output file; (3) some program
;;; (possibly the same as in (1)) detects that a string has appeared
;;; in the output file and does something with it; (4) go back to (1).
;;; In order to stop the entire process, the single item ":stop" must
;;; be placed in the input file.
;;;
;;; One easy way of using this is to load up KPML, load some linguistic
;;; resources for generating, and then to make a standalone executable
;;; image. The application function for starting up the image should
;;; be the WAITING-GENERATE function defined below. A trivial delivery
;;; call example for Lispworks could be:
;;; 
;;;            (lispworks::deliver 
;;;                  'kpml::waiting-generate "kpml-black-box" 0
;;;                  :multiprocessing T :keep-clos T :keep-eval T)
;;; 
;;; Better would be something more space-efficient, etc. but this would
;;; minimally do the job.
;;;
;;; ======================================================================

  ;; ----------------------------------------------------------------------
  ;; Determine where the input comes from, where the output goes, and
  ;; a few other aspects of the generator's behaviour...
  ;; ----------------------------------------------------------------------
  ;;
(defvar *spls-input-file* "C:\\tmp\\spls-in.lisp")
(defvar *kpml-output-file* "C:\\tmp\\kpml-out.txt")

(defvar *waiting-language* :english) 
     ;; change this if other language resources
     ;; are loaded

(defvar *waiting-verbose* T)  ;; tracing on/off

(defvar *poling-frequency* 1) ;; should be more than zero if any other
                              ;; processes are going to get a look-in.

  ;; ----------------------------------------------------------------------
  ;; The main looping function itself...
  ;; ----------------------------------------------------------------------
  ;;
(defun WAITING-GENERATE ()
  (loop 
   do
   (sleep *poling-frequency*)
   (let ((input-spl
	  (with-open-file 
	   (stream *spls-input-file* 
		   :direction :input :if-does-not-exist nil)
	    (when (streamp stream)
	      (when *waiting-verbose*
		;; ----------------------------------------
		;; provide the tracing information for debugging and
		;; seeing what is going on...
		;; ----------------------------------------
		(format *trace-output* 
			"~%;;; SPL input file found, loading..."))
	      
	      (let ((input-spl 
		     ;; ----------------------------------------
		     ;; be nice and cautious about failures to 
		     ;; read some SPL, i.e., including
		     ;; garbage input...
		     ;; ----------------------------------------
		     (unwind-protect
			 (multiple-value-bind
			  (value error)
			  (ignore-errors 
			   (let ((*package* (find-package "KPML")))
			     (read stream :eof-error-p nil)))
			  (progn
			    (when error
			      (setf value nil)
			      (format *trace-output* "~%;;; SPL read error."))
			    value)))))
		input-spl)))))
     ;; ----------------------------------------
     ;; more tracing...
     ;; ----------------------------------------
     (when *waiting-verbose*
       (format *trace-output* "~%;;; Following read: ~A" input-spl))

     ;; ----------------------------------------
     ;; when something found, actually do some generating... 
     ;; ----------------------------------------
     (when input-spl
       (delete-file *spls-input-file*) ;; get rid of the input file
       (cond ((equal input-spl :stop)  ;; see if we are done
	      (when *waiting-verbose*
		(format *trace-output* "~%;;; Stop found. Exiting..."))
	      (return-from WAITING-GENERATE T))
	     (t
	      (when *waiting-verbose*  ;; tracing
		(format *trace-output* "~%;;; Something found: ~S" input-spl))

	      ;; ----------------------------------------
	      ;; Generation...
	      ;; ----------------------------------------
	      (let ((result
		     (unwind-protect
			 ;; ----------------------------------------
			 ;; Again be VERY cautious about anything 
			 ;; blowing up during generation...
			 ;; ----------------------------------------
			 (multiple-value-bind
			  (value error)
			  (ignore-errors
			   (say input-spl :language *waiting-language*))
			  (progn
			    (when error
			      ;; ----------------------------------------
			      ;; If we get here, then generation failed...
			      ;; ----------------------------------------
			      (setf value nil)
			      (format 
			       *trace-output* "~%;;; Generation failure.")
			      (format 
			       *trace-output* "~%;;; SPL was ~S" input-spl))

			    ;; ----------------------------------------
			    ;; Otherwise we were fine
			    ;; ----------------------------------------
			    ;;
			    value)))))
		
		;; ----------------------------------------
		;; Write the generated result (if anything) to the
		;; output file
		;; ----------------------------------------
		(when result
		  (when *waiting-verbose*  ;; tracing
		    (format 
		     *trace-output* "~%;;; Something generated: ~S" result))
		  (with-open-file (stream *kpml-output-file*
					  :direction :output
					  :if-exists :new-version)
				  (print result stream))))))))))