(in-package "KPML-I")

;;; File: example-grapher-interface.lisp
;;; To provide structure graphing direct from example record information...
;;; Last update: 28.10.04
;;; Last update: 10.01.04
;;; Last update: 23.12.95

;;; --------------------------------------------------------
;;;    EXAMPLE STRUCTURE GRAPHER: ACCESS FROM THE WINDOW INTERFACE
;;; --------------------------------------------------------

;;; essentially copies everything necessary over 
;;; from structure-grapher-interface.lisp

;;; KPML 0.9: Allegro CLIM-2 only.
;;;           Uses multiprocessing facilities
;;;           in order to maintain proper behavior with multiple graphs.
;;; 2.0:      Updated for full consistency with multilingual example
;;;           structures and to use the extra information contained in
;;;           the selection expression slot.
;;; 4.0       More flexible graph renderings added.
;;;           Since we are moving over to including all the information
;;;           that we can in single example record structures in order
;;;           to provide easy XML export/import, we also add here
;;;           a new option for showing all of the selection expressions
;;;           directly in the graph. This is naturally a huge amount
;;;           of information and has to be printed small. Only works
;;;           on example records that have included the selection
;;;           expressions in the example record structures.
;;; ----------------------------------------------------------------------

;;; ----------------------------------------------------------------------
;;; Application frame definition and layout
;;; ......................................................................

(clim:define-application-frame example-graph ()
  ((lg :initform nil)
   (info :initform nil))
  (:top-level (clim:default-frame-top-level  :prompt kpml-prompt-function))
  (:panes (graph        :application
			:display-function 'example-displayer
		        :foreground interactor-fg
		        :background sentence-structure-bg
		        :text-style *structure-graphing-font*)
	  (menu         :command-menu
			:foreground menu-fg
			:background menu-bg			
		        :text-style *menu-font*))
  (:layouts (default (clim:horizontally () graph)))
  (:command-definer t))

;;;
(defmethod EXAMPLE-DISPLAYER ((frame example-graph) stream)
  (let ((gen-sep *inter-subconstituent-scaling*)
	(inter-gen-sep *inter-sibling-scaling*)
	(*example-structure-node* (slot-value frame 'info)))
    (with-possible-font-changes-for-language 
	(stream (slot-value frame 'lg) *structure-graphing-font*)
      (clim:format-graph-from-roots
       (list *example-structure-node*)
       #'example-structure-print-nodes
       #'example-constit-children
       :generation-separation gen-sep
       :within-generation-separation inter-gen-sep
       :merge-duplicates nil
       :move-cursor nil
       :orientation *hardcopy-structure-orientation*
       :stream stream))))

(define-example-graph-command (com-EXSTRUCTURE-GRAPH-CYCLE-NUMBER
				 :name "Toggle showing cycles" :menu t)
  ()
  (setf *show-cycle-numbers-in-graph* (not *show-cycle-numbers-in-graph*)))


 ;; set the following to :selexp in order 
 ;; to see selection expressions...
 ;;
(defvar *show-selexpr-in-graph* nil)

(define-example-graph-command (com-EXSTRUCTURE-SELEXP
				 :name "Toggle showing selection expressions" :menu t)
  ()
  (if (equal *show-selexpr-in-graph* :selexp)
      (setf *show-selexpr-in-graph* nil)
    (setf *show-selexpr-in-graph* :selexp)))

(define-example-graph-command (com-EXSTRUCTURE-GRAPH-OPTIONS
				 :name "Layout Options" :menu t)
  ()
  (structure-grapher-display-options))

(define-example-graph-command (com-EXSTRUCTURE-ACTIVATE-SELXPR
				 :name "Toggle Selection Expression Tool Use" :menu t)
  ()
  (setf *selection-expression-tool* (not *selection-expression-tool*)))

#-(or acl3.0 lispworks4.0)
(define-example-graph-command (com-PRINT-EXAMPLE-GRAPH :name t :menu t)
  ()
  (hardcopy-example-graph 
   (merge-pathnames *default-kpml-hardcopy-directory* 
		    (make-structure-hardcopy-filename))
   (not *suitable-for-figures?*)))

(define-example-graph-command 
  (com-QUIT-EXAMPLE-GRAPHER :name t :menu t)
  ()
  (close-a-window clim:*application-frame*))

;;; ----------------------------------------------------------------------
;;; Following is the initialization and startup for a grapher frame
;;; and accompanying process. Unlike the other windows, resource and
;;; structure graphs always create a new frame/process.

(defvar *example-structure-process* nil)
(defvar *example-structure-node* nil)
(defvar *example-grapher* nil)

(defun GRAPH-EXAMPLE-STRUCTURE (example-structure-node)
  (let ((grapher-application-frame (clim:make-application-frame
				    'example-graph
				    :left 10 :top 10
				    :width *structure-graph-width*
				    :height *structure-graph-height*)))
    (setf *example-structure-node* example-structure-node)
    (setf (slot-value grapher-application-frame 'info) example-structure-node)
    (setf (slot-value grapher-application-frame 'lg) kpml::curlan)
    
    (setq *example-structure-process*
      (process-run-function 
       "KPML-EX-STRUCT-GR"
       #'run-example-grapher 
       grapher-application-frame (find-package "PENMAN")))
    
    (undo-lg-based-font-decision *structure-graphing-font*)))

;;; Wraps the special binding of *example-grapher* within each
;;; grapher process, also the state of generation is frozen within
;;; each grapher process...
(defun RUN-EXAMPLE-GRAPHER 
  (*example-grapher* *package*)
  (declare (special *example-grapher*))
  (clim:run-frame-top-level *example-grapher*))


;;; --------------------------------------------------
;;;
;;;  Presentations...
;;;
;;; --------------------------------------------------

(clim:define-presentation-type example-graph-node ())

;;; ----------------------------------------------------------------------
;;; Printing nodes and recursing down through the structure for graphing
;;; ......................................................................

 ;; 2.1 variable font size added.
 ;; 4.0 change the actual display formatting to a method for easier
 ;;     parameterisation. Method specialises on a display mode:
 ;;     kpml::*example-constituent-display-mode*.
 ;;
(defun EXAMPLE-STRUCTURE-PRINT-NODES (object stream)
  (clim:with-output-as-presentation 
      (stream object 'example-graph-node)
    (clim:with-text-size 
        (stream *structure-graph-major-info-size*)
      (if (kpml::printable-constituent-p object)
	  (kpml::fundle-display-method-new 
	   (kpml::printable-constituent-functions object)
	   (kpml::printable-constituent-features object)
	   stream
	   (or kpml::*example-constituent-display-mode*
	       *show-selexpr-in-graph*)
	   )
        (if (stringp object)
	    (case *hardcopy-structure-orientation*
	      (:horizontal (format stream "~a" object))
	      (:vertical
	       (if (and (find #\[ object)(find #\] object))
		   (format stream "~a"
			   (substitute #\newline #\+ (string-downcase object)))
	         (format stream "~a" object))))
	  (format stream "~a"))))))
  
(defun EXAMPLE-CONSTIT-CHILDREN (example-node)
  (if (kpml::printable-constituent-p example-node)
      (loop for x in (kpml::printable-constituent-spelling example-node)
	  unless (and (stringp x)
		      (string= x " "))
	  collect x)
    nil))

;;; ----------------------------------------------------------------------
;;; Commands and support functions...
;;; ----------------------------------------------------------------------

;; 4.0 : note that there is currently only one option here, so 
;;       we change the documentation string for now.

(clim:define-presentation-action options-example-graph-node
  (example-graph-node nil example-graph 
		      :documentation ;; "Constituent inspection options"
		                        "Show SPL in Development window"
                      :gesture :menu)
  (object)
  (example-graph-options-menu object))

(clim:define-presentation-action present-example-graph-node
  (example-graph-node nil example-graph :documentation "Selection expression")
  (object)
  (let ((node object)
        (message-stream (clim:get-frame-pane *resource-inspector-frame* 'inspector)))
    ;; 2.0 following changed to use the fundle information that is
    ;; now maintained in the selection expression lists...
    (if (kpml::printable-constituent-p node)
        (let* ((fundle (kpml::printable-constituent-functions node))
               (concept (kpml::printable-constituent-concept node))
               (example (find-example concept))
               (selexpr 
                (if example
                    (find-sel-expr concept fundle example)
                  (format message-stream
                          "~%No information maintained for this node.")))
               (preselections
                (if example
                    (loop for (f . p) 
                          in (kpml::fetch-example-info example 
                                                       'kpml::preselections)
                          until (member f fundle :test #'equal)
                          finally (return p)))))
          (if selexpr
              (if (member :selection-expressions kpml::*pop-ups*)
                  (loop for s in selexpr
                        do 
                        (if  kpml-i::*selection-expression-tool*
                            ;; 2.1 extra option...
                            (startup-selexpression-tool-on-example-record 
                             example node s preselections)
                          (kpml::pop-up-a-selection-expression 
                           (kpml::function-pack 
                            (kpml::printable-constituent-functions node)) s
                           :preselections preselections)))
                (loop for s in selexpr
                      as n from 1
                      do (format message-stream "~%Selection expression: ~A" n)
                      (pen-pprint-for-clim s nil message-stream)))
            (format message-stream "~%No selection expression.")))
      (format message-stream "~%Terminal: no selection expression"))))
  

(defun EXAMPLE-GRAPH-OPTIONS-MENU (node)
  (let ((message-stream 
	 (clim:get-frame-pane 
	  *resource-inspector-frame* 'inspector)))
    ;; only one option at present!! so do away with the menu...
    #+ignore(case
                (menu-choose 
                 '(
	           |Semantic expression|
	           )
                 :associated-window (clim:frame-top-level-sheet 
			             *example-grapher*) 
                 :label "Example Graph Options")
              (|Semantic expression|))

    (if (kpml::printable-constituent-p node)
        (kpml::describe-spl-term
         (kpml::printable-constituent-concept node))
      (format message-stream "~%Terminal: no semantic expression"))))


;;; 2.0 now returns the example name not the structure...
(defun FIND-EXAMPLE (concept)
  ;; 2.0.49
  (maphash #'(lambda (ex value)
	       (cond ((kpml::example-includedhubs value)
		      (let ((included (kpml::example-includedhubs value)))
			(unless (consp included) 
			  (setf included (list included)))
			(when (member concept (kpml::flatten included))
			  (return-from FIND-EXAMPLE ex))))
		     ((kpml::example-selectionexpressions value)
		      (when (member concept
				    (mapcar #'first
					    (kpml::fetch-example-info 
					     ex 'kpml::selectionexpressions)))
			(return-from FIND-EXAMPLE ex)))))
	   kpml::penexamples)
  nil)

;;; 2.0 now also checks the grammatical constituent so that we definitely
;;;     get the right one...
(defun FIND-SEL-EXPR (concept fundle example)
  (when (equal fundle '(kpml::sentence)) (setf fundle '(kpml::-top-)))
  (loop for pass in (kpml::fetch-example-info 
		     example 'kpml::selectionexpressions)
      when (and (eq (first pass) concept)
		(member (second pass) fundle))
      collect (cddr pass))  ;; 2.0 changed for changed selexpr structure
  )

;;; ----------------------------------------------------------------------
;;; 0.8 hardcopy for example graphs.... As for structure graphs.
;;; 4.0 changes of 2.0 for structure graphs made here too.

#-acl3.0
(defun HARDCOPY-EXAMPLE-GRAPH (filename multipage?)
  (with-open-file 
   (fstr filename 
	 :direction :output :if-exists :overwrite :if-does-not-exist :create)
   (clim::with-output-to-postscript-stream 
    (*standard-output* fstr :multi-page multipage?)

    (when multipage?
      (clim:with-text-style 
	  (*standard-output* kpml-i::*fix--bold--16*)
	(format *standard-output* "Example structure graph; Language: ~A; ~A~10%~0T"
		kpml::curlan (kpml::time-stamp))))
    (clim:format-graph-from-roots
     (list *example-structure-node*)
     #'example-structure-print-nodes
     #'example-constit-children
     :generation-separation *inter-subconstituent-hc* 
     :within-generation-separation  *inter-sibling-hc* 
     :merge-duplicates nil
     :move-cursor nil
     :orientation *hardcopy-structure-orientation*
     :stream *standard-output*)
    fstr))
  (when *auto-print*
    (auto-print filename)))

