;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: DEMO-MULTIFONT; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This file contains demo code for testing the text interactor
;;;
;;; This is intended as a test and demonstration of the text interactor
;;; as part of the Garnet project.
;;; 
;;; ** Call (Do-Go) to start and (Do-Stop) to stop **
;;;
;;; Designed by Brad A. Myers
;;; Implemented by Richard McDaniel

#|
============================================================
Change log:
        6/19/92 Rajan Parthasarathy - Added auto-scroll
        4/15/92 Andrew Mickish - Changed gv references of PULL-DOWN to g-value,
                  made background of outer window black
	4/12/92 Ed Pervin - destroy menubar in do-stop
         4/9/92 Richard McDaniel - added instructions
         3/5/92 Richard McDaniel - started
============================================================
|#

(in-package "DEMO-MULTIFONT" :use '("LISP" "KR"))

(export '(Do-Go Do-Stop))
(defvar *test-debug* NIL)

;; First we load required gadgets.  In this demo, we use the menubar and the
;; motif-scrolling-window-with-bars gadgets.

;; Load multifont stuff.
(unless (get :garnet-modules :multifont)
   (load (merge-pathnames "multifont-loader"
                          #+cmu "opal:"
                          #+(not cmu) user::Garnet-Opal-PathName)
         :verbose T)
)

;; Load menubar gadget.
(unless (get :garnet-modules :menubar)
   (load (merge-pathnames "menubar-loader"
                          #+cmu "gadgets:"
                          #+(not cmu) user::Garnet-Gadgets-PathName)
         :verbose T)
)

;; Load scrolling window gadget.
(unless (get :garnet-modules :motif-scrolling-window)
   (load (merge-pathnames "motif-scrolling-window-loader"
                          #+cmu "gadgets:"
                          #+(not cmu) user::Garnet-Gadgets-PathName)
         :verbose T)
)

  
;;; ================================================================

;; Following are functions used in the menubar.  Each function is used to
;; control either a menu or a submenu item.

(proclaim '(special focus-inter text1 text2))

;; This is used in the "New" submenu of "File."  This function clears the
;; two windows of text.
(defun new-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (opal:set-strings text1 nil)
   (opal:set-strings text2 nil)
   (inter:set-focus focus-inter text1)
)


;; The is the "Quit" selection of "File."  It exits the main loop.
(defun quit-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (Do-Stop)
)


;; This is used in the "Font" menu.  It changes the family of the current font.
(defun change-font (gadget menu-item value)
   (declare (ignore gadget menu-item))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (opal:change-font-of-selection multifont nil :family value)
	 (gg:auto-scroll multifont)
	 )
      )
   )


;; This is used in the "Size" menu.  It changes the size attribute of the
;; current font.
(defun change-size (gadget menu-item value)
   (declare (ignore gadget menu-item))
   (let ((multifont (g-value focus-inter :obj-to-change)))
     (when multifont
         (opal:change-font-of-selection multifont nil :size value)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Copy" selection of the "Edit" menu.  It copies whatever is
;; currently selected.  The copied item is put in the cut-buffer.
(defun copy-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (inter:copy-selection focus-inter)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Cut" selection of the "Edit" menu.  It deletes whatever is
;; currently selected.  The deleted item is put in the cut-buffer.
(defun cut-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (inter:cut-selection focus-inter)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Paste" selection of the "Edit" menu.  It copies whatever is
;; in the cut buffer at the current cursor position.
(defun paste-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (inter:paste-selection focus-inter)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Italic" selection of the "Edit" menu.  It toggles the current
;; font to be italic.
(defun italic-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (opal:change-font-of-selection multifont nil :italic :toggle-first)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Bold" selection of the "Edit" menu.  It toggles the current
;; font to be bold.
(defun bold-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (opal:change-font-of-selection multifont nil :bold :toggle-first)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Font Bigger" selection of the "Edit" menu.  It toggles the
;; current font to be one size larger.
(defun bigger-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (opal:change-font-of-selection multifont nil :size :bigger)
	 (gg:auto-scroll multifont)
      )
   )
)


;; This is the "Font Smaller" selection of the "Edit" menu.  It toggles the
;; current font to be one size smaller.
(defun smaller-fn (gadget menu-item value)
   (declare (ignore gadget menu-item value))
   (let ((multifont (g-value focus-inter :obj-to-change)))
      (when multifont
         (opal:change-font-of-selection multifont nil :size :smaller)
      )
   )
)


;; The main procedure.  Initializes all garnet gadgets and interactors.
(defun Do-Go (&key dont-enter-main-event-loop)

   ; Create the main window.
   (create-instance 'win inter:interactor-window
      (:title "Multifont Demonstration")
      (:top 200)
      (:left 400)
      (:background-color opal:black)
   )
   (create-instance 'top opal:aggregate)
   (s-value win :aggregate top)
   (opal:update win)

   ; Create the menubar.
   (create-instance 'pull-down garnet-gadgets:menubar
      (:items '(("File" nil
                   (("New" new-fn) ("Open") ("Save") ("Quit" quit-fn)))
                ("Edit" nil
                   (("Copy" copy-fn) ("Cut" cut-fn) ("Paste" paste-fn)
                    ("Italic" italic-fn) ("Bold" bold-fn)
                    ("Font Bigger" bigger-fn) ("Font Smaller" smaller-fn)))
                ("Font" change-font
                   ((:Fixed) (:Serif) (:Sans-Serif)))
                ("Size" change-size
                   ((:Small) (:Medium)
                    (:Large) (:Very-Large)))))
   )
   (opal:add-component top pull-down)
   (opal:notice-items-changed pull-down) ; This must be done to make it work.

   ; Create the top window of the demo.
   (create-instance 'text1 opal:multifont-text ; This is the internal multifont
      (:word-wrap-p t)                         ; text object.
      (:auto-scroll-p T)
      )
   
   (create-instance 'scroll-win1
         garnet-gadgets:motif-scrolling-window-with-bars
      (:left 0)
      (:top (g-value pull-down :height))
      (:width (o-formula (- (gv win :width) (* 2 (gvl :border-width)))))
      (:height (o-formula (- (floor
                  (/ (- (gv win :height) (g-value pull-down :height)) 2))
                                (* 2 (gvl :border-width)))))
      (:parent-window win)
      (:total-width (o-formula (+ (gv text1 :width) (gv text1 :left)) 200))
      (:total-height (o-formula (+ (gv text1 :top) (gv text1 :height)) 200))
      (:h-scroll-bar-p nil)
      (:v-scroll-bar-p t)
   )
   (s-value text1 :text-width (o-formula (gv scroll-win1 :clip-window :width)))
   (s-value text1 :scrolling-window scroll-win1)
   
   (opal:update scroll-win1)
   (opal:add-component (g-value scroll-win1 :inner-aggregate) text1)

   ; Create the lower window of the demo.
   (create-instance 'text2 opal:multifont-text
      (:word-wrap-p t)
      (:auto-scroll-p T)
   )
   (create-instance 'scroll-win2
         garnet-gadgets:motif-scrolling-window-with-bars
      (:left 0)
      (:top (o-formula (+ (g-value pull-down :height) (gv scroll-win1 :height)
                          (* 2 (gvl :border-width)))))
      (:width (o-formula (- (gv win :width) (* 2 (gvl :border-width)))))
      (:height (o-formula (- (gv win :height) (gvl :top)
                                (* 2 (gvl :border-width)))))
      (:parent-window win)
      (:total-width (o-formula (gv text2 :width) 200))
      (:total-height (o-formula (gv text2 :height) 200))
      (:h-scroll-bar-p nil)
      (:v-scroll-bar-p t)
   )
   (s-value text2 :text-width (o-formula (gv scroll-win2 :clip-window :width)))
   (s-value text2 :scrolling-window scroll-win2)

   (opal:update scroll-win2)
   (opal:add-component (g-value scroll-win2 :inner-aggregate) text2)

   ; Create a focus interactor so that keyboard events may be entered into
   ; the text objects.
   (create-instance 'focus-inter inter:focus-multifont-textinter
      (:window `(,win ,(g-value scroll-win1 :clip-window)
                 ,(g-value scroll-win1 :inner-window)
                 ,(g-value scroll-win2 :clip-window)
                 ,(g-value scroll-win2 :inner-window))))

   ; Create a selection interactor to handle mouse events on the text objects.
   (create-instance 'mouse-inter inter:selection-interactor
      (:window `(,win ,(g-value scroll-win1 :clip-window)
                 ,(g-value scroll-win1 :inner-window)
                 ,(g-value scroll-win2 :clip-window)
                 ,(g-value scroll-win2 :inner-window)))
      (:focus-interactor focus-inter)
      (:text-list `(,text2 ,text1))
      (:start-where `(:list-element-of ,mouse-inter :text-list :type
		      ,opal:multifont-text)))
      
   (inter:set-focus focus-inter text1)
   (opal:update win)

   ; Currently, open and save remain unimplemented.  Their corresponding
   ; menubar entries have been grayed to reflect this.
   (let ((bar (garnet-gadgets:get-bar-component pull-down "File")))
      (garnet-gadgets:menubar-disable-component
            (garnet-gadgets:get-submenu-component bar "Open"))
      (garnet-gadgets:menubar-disable-component
            (garnet-gadgets:get-submenu-component bar "Save"))
   )
   (Format T "~%Demo-Multifont:
  This creates and edits two multifont text objects within two motif-scrolling-
  window-with-bars.
  Clicking the cursor in the text objects will set the cursor to that object
  Dragging the cursor across text will select the text.
  Selecting any menu item will perform the action designated in that item.
  ~%")
  (format t "~%  Function key commands:
F1              exit main event loop
F2              toggle italics
F3              toggle bold
F4              make type face to one step smaller
F5              set type size one step bigger
F6              set type family to fixed
F7              set type family to serif
F8              set type family to sans-serif~%")
   (unless dont-enter-main-event-loop
      #-cmu (inter:main-event-loop)
   )
)


;; Do-stop kills the parent window which will destroy all internal garnet
;; objects and gadgets.
(defun Do-Stop ()
   (opal:remove-component top pull-down)
   (opal:destroy pull-down)
   (opal:destroy win)
  ;;for demo-controller
   (unless (and (fboundp 'User::Garnet-Note-Quitted)
                (User::Garnet-Note-Quitted "DEMO-MULTIFONT"))
   )
)

