(in-package "KPML-I")

;;; File: kpml-demo-setup.lisp
;;;
;;; Originally (KPML 0.9) provided a utility for helping with demos by
;;; resetting a number of fonts for the KPML windows so that text is large
;;; enough for overhead projection, etc.
;;; To do this, the application frames had to be redefined and the
;;; interface started anew.

;;; Apr99: KPML 2.1
;;; Changed completely so that font sizes can be set dynamically while
;;; running KPML or pre-configured so that a demoable version of the
;;; interface appears. No longer appears as a separately loaded system
;;; therefore.

;;; Setting the following in a configuration file forces a font size
;;; update after the configuration file has been loaded...
(defvar *font-size-update-pending* nil)

;;; ----------------------------------------------------------------------
;;; General default sizes for various kinds of information...
;;; ----------------------------------------------------------------------

(defvar *menu-font-size*       10)
(defvar *interactor-font-size* 12)
(defvar *inspector-font-size*  10)
(defvar *info-font-size*       12)
(defvar *minor-info-font-size*  8)
(defvar *major-info-font-size* 12)
(defvar *graph-font-size*      12)
(defvar *graph-major-info-size* 10)
(defvar *graph-info-size*       8)
(defvar *graph-minor-info-size* 6)
(defvar *structure-graph-major-info-size* 10)
(defvar *structure-graph-info-size*       8)
(defvar *structure-graph-minor-info-size* 6)


;;; ----------------------------------------------------------------------
;;; The following can therefore be cut and pasted into a configuration
;;; file for presetting of font sizes...
;;; ----------------------------------------------------------------------

#||
kpml-i::*menu-font-size*                  11
kpml-i::*interactor-font-size*            12
kpml-i::*inspector-font-size*             12
kpml-i::*info-font-size*                  10
kpml-i::*minor-info-font-size*            8
kpml-i::*major-info-font-size*            15
kpml-i::*graph-font-size*                 14
kpml-i::*graph-major-info-size*           16
kpml-i::*graph-info-size*                 5
kpml-i::*graph-minor-info-size*           12
kpml-i::*structure-graph-major-info-size* 15
kpml-i::*structure-graph-info-size*       10
kpml-i::*structure-graph-minor-info-size* 8

kpml-i::*font-size-update-pending* T
||#

(defun RESTORE-KPML-FONT-DEFAULTS ()
  (setf *menu-font-size*       10)
  (setf *interactor-font-size* 12)
  (setf *inspector-font-size*  10)
  (setf *info-font-size*       12)
  (setf *minor-info-font-size*  8)
  (setf *major-info-font-size  12)
  (setf *graph-major-info-size* 10)
  (setf *graph-info-size*       8)
  (setf *graph-minor-info-size* 6)
  (setf *structure-graph-major-info-size* 10)
  (setf *structure-graph-info-size*       8)
  (setf *structure-graph-minor-info-size* 6)
  t)


;;; ----------------------------------------------------------------------
;;; The frames to be effected are now recorded in the following list.
;;; This is a list of lists with the structure:
;;;   (name-of-frame-type variable-holding-frame list-of-panes)
;;; The list-of-panes has the structure:
;;;   (pane-name default-text-style variable-for-actual-size)
;;;
;;; This structure is then used to update the default fonts of the 
;;; corresponding panes. Updating is done by a dialogue menu. 
;;;
;;; For some font changes
;;; we do not bother with changing the default size of the pane, but
;;; just set a variable which is used in a with-text-size environment
;;; where appropriate in the display methods. In this case the variable
;;; holding frame is just nil and the pane-name can be any identifier
;;; for the use of the font.
;;; ----------------------------------------------------------------------

(defvar *kpml-frame-panes-info*
    '((KPML-INTERFACE
       *resource-manager-frame*
       (menu *menu-font* *menu-font-size*)
       (interactor *fix--bold--10*  *interactor-font-size*))

      (KPML-RESOURCE-DEVELOPMENT
       *resource-development-frame*
       (interactor *fix--roman--12* *interactor-font-size*)
       (inspector  *fix--bold--10*  *inspector-font-size*)
       (menu *menu-font*            *menu-font-size*))

      (RESULTS-DISPLAY-FRAME 
       *display-frame*
       (info *results-display-font* *major-info-font-size*))

      (INFO-DISPLAY-FRAME 
       *info-frame*
       (info  *fix--bold--10* *info-font-size*))

      (SYSTEMIC-RESOURCE-GRAPH 
       nil
       (system-names *graph-font* *resource-graph-system-name-size*)
       (systems-features *graph-font* *resource-graph-feature-size*)
       (realizations *graph-font* *resource-graph-rs-size*)
       ;; (collecteds *sans-serif--italic--8* *minor-info-font-size*)
       )

      (STRUCTURE-GRAPH 
       nil
       (constituents 
	*structure-graphing-font* *structure-graph-major-info-size*)
       (constraints *structure-details-font* *structure-graph-info-size*))

      (EXAMPLE-OPERATIONS-FRAME
       *ex-op-frame*
       (exset-list *sans-serif--bold--10* *minor-info-font-size*)
       (example-list *sans-serif--bold--10* *info-font-size*))

      (EXAMPLE-MISMATCHES-FRAME
       *ex-mismatch-frame*
       (exset-list *sans-serif--bold--10* *minor-info-font-size*)
       (example-list *sans-serif--bold--10* *info-font-size*))

      (FAT-FRAME
       *fat-frame*
       (fat *sans-serif--roman--12* *info-font-size*))

      (GENERATION-HISTORY-FRAME
       *generation-history-frame*
       (system  *fix--bold--12*     *info-font-size*)
       (system-history  *sans-serif--roman--12* *info-font-size*)
       (inquiry-gloss *fix--bold--12* *info-font-size*)
       (inquiry *fix--bold--12*     *info-font-size*)
       (inquiry-history  *sans-serif--roman--12* *info-font-size*))

      (USER-RESPONSE-FRAME
       *yes-no-frame*
       (question  *fix--bold--12* *info-font-size*))))

;;; ----------------------------------------------------------------------
;;; Utilities for taking styles apart, setting the default variables,
;;; and changing the pane defaults...
;;; ----------------------------------------------------------------------

(defun UNPARSE-TEXT-STYLE (parsed-style)
  (list (clim:text-style-family parsed-style) 
	(clim:text-style-face parsed-style) 
	(clim:text-style-size parsed-style)))

(defun MAKE-TEXT-STYLE-WITH-SIZE (style size)
  (clim:parse-text-style
   (append
    (subseq (unparse-text-style style) 0 2)
    (list size))))
    
;;; ----------------------------------------------------------------------
;;; The following functions sets the default font size of the given pane
;;; of the given frame-name. If no size is given, then it is set
;;; to the value of the variable given in the info list. Calling this
;;; function for all the panes of the list at the outset, therefore
;;; configures the sizes of the affected panes as the info list specifies.
;;; ----------------------------------------------------------------------

(defun SET-PANE-DEFAULT (frame-name pane-name &optional (size nil))
  (let ((pane-style (assoc frame-name *kpml-frame-panes-info*)))
    (when pane-style
      (let ((frame-var (second pane-style))
	    (pane-info (assoc pane-name (cddr pane-style))))
	(when pane-info
	  (let ((default-style (second pane-info))
		(size-var      (third pane-info)))
	    (when size (set size-var size))
	    (when (and frame-var
		       (symbol-value frame-var))
	      (let ((pane (clim::get-frame-pane (symbol-value frame-var) pane-name :errorp nil)))
		(when pane
		  (setf (clim:medium-default-text-style pane)
		    (clim:parse-text-style 
		     (make-text-style-with-size 
		      (symbol-value default-style)
		      (symbol-value size-var)))))))))))))

;;; ----------------------------------------------------------------------
;;; A dialog box that sets everything up...
;;; ----------------------------------------------------------------------

(defun FONT-SIZE-DIALOGUE 
    (&optional
     (stream (clim::frame-top-level-sheet clim:*application-frame*)))
  (clim:accepting-values
      (#-acl3.0 stream #+acl3.0 *query-io* :own-window t
		:height 300
		:scroll-bars :vertical
		:resynchronize-every-pass t
		:label "Font size configuration dialogue" :exit-boxes 
		'((:exit "Click here to exit")))
    (let ((stream #-acl3.0 stream #+acl3.0 *query-io*)
	  (prompt-number 0))
      (clim:formatting-table (stream)
	(loop for (frame frame-var . pane-info) in *kpml-frame-panes-info*
	    as frame-name = (string frame)
	    do
	      ;; note that we can only set the pane-size if the frame has
	      ;; been created, so we always change the value of the size
	      ;; variable, and only change the pane-size if it already
	      ;; exists...
	      (loop for (pane default-style size-var) in pane-info
		  as pane-name = (concatenate 
				     'string frame-name "->" (string pane))
				 
		  do
		    (setf prompt-number (1+ prompt-number))
		    (clim:formatting-row (stream)
		      (clim:formatting-cell (stream)
			(clim:with-text-style 
			    (stream (symbol-value default-style))
                          (clim:with-text-size (stream (symbol-value size-var))
			    (format stream "~A" pane-name)
                            #+lispworks (format stream " (now: ~2D)" (symbol-value size-var))
                            )))
		      (clim:formatting-cell (stream)
			(set size-var
			     (clim:accept 
			      '(integer 4 20) :stream stream
			      :default (symbol-value size-var)
			      :prompt #-lispworks (format nil "(~2D)"  prompt-number)
                                      #+lispworks (format nil "(~2D)" prompt-number)
			      :view '(clim:slider-view :show-value-p t))))
		      ))))))
  (update-kpml-font-sizes))

;;; 2.1 ... following broken out of the above...

(defun UPDATE-KPML-FONT-SIZES ()
  (loop for (frame frame-var . pane-info) in *kpml-frame-panes-info*
      when (and (boundp frame-var)
		(symbol-value frame-var))
      do
	(loop for (pane default-style size-var) in pane-info
	    do 
	      (set-pane-default 
	       frame pane (symbol-value size-var)))))

;;; ----------------------------------------------------------------------
;;; Make this configuration dialogue available from the window interface...
;;; ----------------------------------------------------------------------

(define-kpml-interface-command 
    (com-DEMO-CONFIGURATION :name T :menu nil)
    ()
  (font-size-dialogue
   (clim::frame-top-level-sheet clim:*application-frame*)))

;;; ----------------------------------------------------------------------
;;; 4.0 restore the damage... or save and create new damage!...
;;; ----------------------------------------------------------------------

(define-kpml-interface-command 
    (com-RESET-DEMO-CONFIGURATION :name T :menu nil)
    ()
    (restore-kpml-font-defaults)
    (configure-kpml-font-sizes))

(define-kpml-interface-command 
    (com-SAVE-DEMO-CONFIGURATION :name T :menu nil)
    ()
    (save-kpml-demo-configuration-file))

(define-kpml-interface-command 
    (com-LOAD-DEMO-CONFIGURATION :name T :menu nil)
    ()
    (load-kpml-demo-configuration-file))

;;; ----------------------------------------------------------------------
;;; Or run and set the defaults from the info structure without 
;;; user interaction... (Now included in the above)
;;; ----------------------------------------------------------------------

(defun CONFIGURE-KPML-FONT-SIZES ()
  (update-kpml-font-sizes))
  
;;; ----------------------------------------------------------------------
;;; 4.0 record a set of new settings...
;;; ----------------------------------------------------------------------

(defun SAVE-KPML-DEMO-CONFIGURATION-FILE ()
  (let* ((kpml::*configure-file-name* "kpmldemoconf")
	 (tmpdir  (kpml::coerce-directory kpml::*BASE-DEFAULT-DIRECTORY*)) 
	 (configfile (merge-pathnames tmpdir kpml::*configure-file-name*)))
    (with-open-file 
     (stream configfile :direction :output :if-exists :supersede)
     (format stream ";; Font size settings... ~2%
kpml-i::*menu-font-size*                  ~A
kpml-i::*interactor-font-size*            ~A
kpml-i::*inspector-font-size*             ~A
kpml-i::*info-font-size*                  ~A
kpml-i::*minor-info-font-size*            ~A
kpml-i::*major-info-font-size*            ~A
kpml-i::*graph-font-size*                 ~A
kpml-i::*graph-major-info-size*           ~A
kpml-i::*graph-info-size*                 ~A
kpml-i::*graph-minor-info-size*           ~A
kpml-i::*structure-graph-major-info-size* ~A
kpml-i::*structure-graph-info-size*       ~A
kpml-i::*structure-graph-minor-info-size* ~A
"
	kpml-i::*menu-font-size*        
	kpml-i::*interactor-font-size*  
	kpml-i::*inspector-font-size*   
	kpml-i::*info-font-size*        
	kpml-i::*minor-info-font-size*  
	kpml-i::*major-info-font-size*  
	kpml-i::*graph-font-size*       
	kpml-i::*graph-major-info-size* 
	kpml-i::*graph-info-size*       
	kpml-i::*graph-minor-info-size*          
	kpml-i::*structure-graph-major-info-size*
	kpml-i::*structure-graph-info-size*      
	kpml-i::*structure-graph-minor-info-size*
	)
     )))

;;; ----------------------------------------------------------------------
;;; Get a bunch of new settings...
;;; ----------------------------------------------------------------------

(defun LOAD-KPML-DEMO-CONFIGURATION-FILE ()
  (let ((kpml::*configure-file-name* "kpmldemoconf"))
    (declare (special kpml::*configure-file-name*))
    (kpml::load-kpml-configuration-file)
    (update-kpml-font-sizes)))
