;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GILT; 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. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; Designed and implemented by Brad Myers

#|
============================================================
Change log:
    09/07/92 Andrew Mickish - Switched order of parameters to merge-pathname
               for giltbitmap bitmap.
    08/19/92 Andrew Mickish - Bitmap pathnames now use namestring function
      4/4/92 Brad Myers - new specialrun and build forms
    03/25/92 Andrew Mickish - Get-Values ---> G-Value
    03/25/92 Andrew Mickish - Added Invalid-Pathname-p filter to
               :properties-slots list of TYPE-BITMAP.
    02/18/92 Brad Myers - new constant definitions, and more type checking
                        - moved common to gilt-gadget-utils
    01/06/92 Andrew Mickish - Instead of adding type names to
               opal:*standard-names* with setf in this file, the names now
               appear in the defparameter in save-agg.lisp.
    04/11/91 Brad Myers - fixed bug in function-for-ok-name for save
    03/27/91 Andrew Mickish - Removed :fixed-width-size and :fixed-height-size
               from property lists
    03/13/91 Osamu Hashimoto - Moved Show-Save-Dialog & Show-Read-Dialog here
                               from gilt.lisp
    03/07/91 Osamu Hashimoto - Moved *prop-sheet* here from gilt.lisp
    03/04/91 Osamu Hashimoto - Moved Make-Main-Menu here from gilt.lisp
    03/04/91 Andrew Mickish - Added :min-width and :min-height to gadgets
               that grow
    02/27/91 Andrew Mickish - Moved *load-file* here from gilt.lisp;
               Moved IB-WINDOW here from gilt.lisp
    02/21/91 Andrew Mickish - Moved IB-OBJS here from gilt.lisp
    02/06/90 Andrew Mickish - Changed gauge slots so that :width can be set
             directly but :radius cannot (due to change in gauge gadget).
    11/13/90 Brad Myers - Split from gilt.lisp
============================================================
|#


(in-package "GILT" :use '("LISP" "KR"))

(proclaim '(special *Selection-Obj* *Run-Build-Obj* *Objs-Agg*
	            *Top-Gadget-Name* *Last-Filename* Linepform
	            RunGadgetActiveForm *Main-Win* *IB-Win*
	            Save-File Read-File))

(create-instance 'gray-out opal:rectangle
		 (:draw-function :and)
		 (:obj-over NIL)
		 (:line-style NIL)
		 (:filling-style opal:gray-fill)
		 (:left (o-formula (gvl :obj-over :left)))
		 (:top (o-formula (gvl :obj-over :top)))
		 (:width (o-formula (gvl :obj-over :width)))
		 (:height (o-formula (gvl :obj-over :height)))
		 (:visible NIL)) ; usually replace this with a formula

;;; An association list which the save function uses to get the correct
;;; loader file names
(defparameter *load-file*
 '(("V-SCROLL-BAR" "V-SCROLL")("H-SCROLL-BAR" "H-SCROLL")
   ("TEXT-BUTTON-PANEL" "TEXT-BUTTONS")("X-BUTTON-PANEL" "X-BUTTONS")
   ("RADIO-BUTTON-PANEL" "RADIO-BUTTONS")))

(defparameter *prop-sheet*
  (create-instance NIL garnet-gadgets:prop-sheet-for-obj-with-OK
		   (:constant '(T :except :obj :slots))
		   (:OK-Function 'Prop-Sheet-Finish)
		   (:Apply-Function 'Prop-Sheet-Finish)))

(defun Make-Main-Menu ()
  (let* ((win (create-instance NIL inter:interactor-window
			       (:top 25)(:left 550)(:width 365)(:height 225)
			       (:title "Gilt Commands")))
	(agg (create-instance NIL opal:aggregate))
	(obj (create-instance NIL garnet-gadgets:radio-button-panel
			      (:CONSTANT '(T))
			      (:left 5)(:top 5)(:items '(:Build :Run))
			       (:selection-function
				#'(lambda (gad val)
				    (declare (ignore gad))
				    (if (eq val :Run)
					(Garnet-Gadgets:Set-Selection
					 *Selection-Obj* NIL))))))
	(menu (create-instance NIL garnet-gadgets:text-button-panel
		 (:left 100)(:top 5)
		 (:CONSTANT '(T))
		 (:final-feedback-p NIL)
		 (:rank-margin 6)
		 (:font opal:default-font)
		 (:shadow-offset 6)(:text-offset 2)(:gray-width 2)
		 (:items `(("Save..." ,#'Show-Save-Dialog)
			   ("Read..." ,#'Show-Read-Dialog)
			   ("To Top" ,#'To-Top-Func)
			   ("To Bottom" ,#'To-Bottom-Func)
			   ("Duplicate" ,#'Duplicate-Func)
			   ("Select All" ,#'Select-All-Func)
			   ("Delete Selected" ,#'Delete-Func)
			   ("Delete All" ,#'Delete-All-Func)
			   ("Undo Last Delete" ,#'Undo-Delete-Func)
			   ("Properties..." ,#'Properties-Func)
			   ("Align..." ,#'Align-Func)
			   ("Quit" ,#'Quit-Func)))))
	 (left-number (create-instance NIL garnet-gadgets:labeled-box
			    (:CONSTANT '(T :EXCEPT :active-p :label-string))
			    (:left 5)(:top 80)
			    (:line-p (formula LinepForm))
			    (:Label-string (o-formula
					    (if (gvl :line-p)
						"X1" "  LEFT") "  LEFT"))
			    (:value (o-formula (Sel-Obj-Value (if (gvl :line-p)
							       :x1 :left))))
			    (:selection-function #'LeftX1-Set-Func)
			    (:field-offset 2)
			    (:min-frame-width 40)))
	(top-number (create-instance NIL garnet-gadgets:labeled-box
		       (:left 5)(:top 100)
		       (:CONSTANT '(T :EXCEPT :active-p :label-string))
		       (:line-p (o-formula (gv left-number :line-p)))
		       (:Label-string
			(o-formula (if (gvl :line-p)
				       "Y1" "   TOP") "   TOP"))
		       (:value (o-formula (Sel-Obj-Value (if (gvl :line-p)
							     :y1 :top))))
		       (:selection-function #'TopY1-Set-Func)
		       (:field-offset 2)
		       (:min-frame-width 40)))
	(width-number (create-instance NIL garnet-gadgets:labeled-box
			 (:left 4)(:top 120)
			 (:CONSTANT '(T :EXCEPT :active-p :label-string))
			 (:line-p (o-formula (gv left-number :line-p)))
			 (:Label-string
			  (o-formula
			   (if (gvl :line-p) "X2" " WIDTH") " WIDTH"))
			 (:value
			  (o-formula (Sel-Obj-Value (if (gvl :line-p)
							:X2 :width))))
			 (:selection-function #'WidthX2-Set-Func)
			 (:field-offset 2)
			 (:min-frame-width 40)))
	(height-number (create-instance NIL garnet-gadgets:labeled-box
			  (:left 5)(:top 140)
			  (:CONSTANT '(T :EXCEPT :active-p :label-string))
			  (:line-p (o-formula (gv left-number :line-p)))
			  (:Label-string
			   (o-formula
			    (if (gvl :line-p) "Y2" "HEIGHT") "HEIGHT"))
			  (:value
			   (o-formula (Sel-Obj-Value (if (gvl :line-p)
							 :y2 :height))))
			  (:selection-function #'HeightY2-Set-Func)
			  (:field-offset 2)
			  (:min-frame-width 40)))
	(selected (create-instance NIL opal:aggregadget
			  (:parts
			   `((:label ,opal:text (:string "Selected Object: ")
			      (:CONSTANT (:left :string :top :font :parent))
			      (:left 5)(:top 205)
			      (:font ,(g-value
				       garnet-gadgets:labeled-box
				       :label-font)))
			     (:value ,opal:text
				     (:draw-function :xor)
				     (:fast-redraw-p T)
				     (:string
				      ,(o-formula
					(let ((objs (gv *selection-obj*
							:value))
					      obj)
					  (cond
					    ((cdr objs) "<multiple>")
					    ((setq obj (car objs))
					     (let ((kr::*print-as-structure*
						    NIL))
					       (format NIL "~s" obj)))
					    (T "<none>")))))
				     (:left
				      ,(o-formula (+ 3 (opal:gv-right
							(gvl :parent :label)))))
				     (:top 205))))))
	 menu-active type-in-active)
    (Init-value obj :build) ; start in Build mode
    (setq *main-win* win)
    (s-value win :aggregate agg)
    (fix-all-interactors menu T NIL)
    (setq *Run-Build-Obj* obj) ; this must be set before menu-active
			       ; created so the RunGadgetActiveForm will
			       ; have the correct reference
    (setq menu-active (create-instance NIL gray-out
			 (:obj-over menu)
			 (:visible (formula RunGadgetActiveForm))))
    (setq type-in-active
	  (create-instance NIL gray-out
		(:left 5)(:top 80)
		(:width (+ 2 (g-value left-number :width)))
		(:filling-style opal:dark-gray-fill)
		(:height (- (opal:bottom height-number) 78))
		;; visible if more than one object is selected
		(:visible (o-formula (cdr (gv *Selection-obj* :value))))))

    (opal:add-components agg obj menu Menu-active left-number top-number
			 width-number height-number type-in-active selected)
    (opal:update win)))


;;; This pops up the save dialog box, after determining the default values 
(defun Show-Save-Dialog (gadget stringsel)
  (declare (ignore gadget stringsel))
  (let ((filename *Last-Filename*)
	(package (g-value *objs-agg* :package-name))
	(window-title (g-value *objs-agg* :window-title))
	(export-p (if (g-value *objs-agg* :export-p)
		      "Export Top-level Gadget?"))
	(gadget-name *Top-Gadget-Name*)
	(function-for-ok-name (or (g-value *objs-agg* :FUNCTION-FOR-OK) ""))
	(function-for-ok-invalid (Check-Ask-OK)))
    (unless (stringp function-for-ok-name)
      (setq function-for-ok-name (write-to-string function-for-ok-name)))
    (set-initial-value save-file :filename filename)
    (set-initial-value save-file :gadget-name gadget-name)
    (set-initial-value save-file :win-title window-title)
    (set-initial-value save-file :package-name package)
    (set-initial-value save-file :FUNCTION-FOR-OK-NAME function-for-ok-name)
    (set-initial-value save-file :export-p export-p)
		       
    (s-value (g-value save-file :FUNCTION-FOR-OK-VALIDP) :visible
	     function-for-ok-invalid)
    (show-in-window save-file)))


;;; This pops up the read dialog box, after determining the default values 
(defun Show-Read-Dialog (gadget stringsel)
  (declare (ignore gadget stringsel))
  (let ((filename *Last-Filename*)
	(add-replace-invalid (if (g-value *objs-agg* :components) NIL T)))
    (set-initial-value read-file :filename filename)
    (s-value (g-value read-file :add-replace-valid) :visible
	     add-replace-invalid)
    (set-initial-value read-file :add-replace "Replace existing objects")
    (show-in-window read-file)))


(defparameter *List-Item* (List :items))
(defparameter *aggrelist-slots* (List '(:known-as NIL "(keyword)")
				      :select-function 
				      '(:direction (:Vertical :Horizontal))
				      (list :v-spacing #'num-only)
				      (list :h-spacing #'num-only)
				      '(:fixed-width-p (T NIL))
				      '(:fixed-height-p (T NIL))
				      '(:h-align (:left :center :right))
				      (list :rank-margin #'nil-or-num)
				      (list :pixel-margin #'nil-or-num)
				      (list :indent #'num-only)))
(defparameter *shadow-slots* (List (list :shadow-offset #'num-only)
				   (list :text-offset #'num-only)
				   (list :gray-width #'num-only)))
(defparameter *all-scroll-slots* (List (list :scr-incr #'num-only)
				       (list :page-incr #'num-only)
				       '(:scr-trill-p (T NIL))
				       '(:page-trill-p (T NIL))
				       '(:indicator-text-p (T NIL))))
(defparameter *all-slider-slots* (List '(:known-as NIL "(keyword)")
					 (list :val-1 #'num-only)
					 (list :val-2 #'num-only)
					 :select-function
					 (list :scr-incr #'num-only)
					 (list :page-incr #'num-only)
					 '(:scr-trill-p (T NIL))
					 '(:page-trill-p (T NIL))
					 (list :num-marks #'num-only)
					 '(:tic-marks-p (T NIL))
					 '(:enumerate-p (T NIL))
					 '(:value-feedback-p (T NIL))
					 (list :value-feedback-font (Font-for))
					 (list :enum-font (Font-for))))


(proclaim '(special user::Garnet-Gilt-Bitmap-PathName))

(defparameter leftform (o-formula (first (gvl :box))))
(defparameter topform (o-formula (second (gvl :box))))
(defparameter widthform (o-formula (third (gvl :box))))
(defparameter heightform (o-formula (fourth (gvl :box))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now define the top-level aggregadget for the gadget menu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; never run the objects in the gadget selection window
(defparameter RunGadgetActiveForm
  (o-formula (and (not (eq (gvl :window) *Ib-Win*))
		  (eq :run (gv *Run-Build-Obj* :value)))))
(defparameter BuildGadgetActiveForm
  (o-formula (eq :build (gv *Run-Build-Obj* :value))))


;; These are used to make sure the object isn't active if it didn't
;; used to be active.  The old active value is stored in the slot
;;   :gilt-temp-active
;; never run the objects in the gadget selection window
(defparameter SpecialRunGadgetActiveForm
  (o-formula (and (not (eq (gvl :window) *Ib-Win*))
		  (eq :run (gv *Run-Build-Obj* :value))
		  (gvl :gilt-temp-active))))
(defparameter SpecialBuildGadgetActiveForm
  (o-formula (and (gvl :gilt-temp-active)
		  (eq :build (gv *Run-Build-Obj* :value)))))


(create-instance 'IB-OBJS opal:aggregadget
    (:parts
     `((:title-line ,opal:line
		    (:x1 2)
	            (:constant (:x1 :line-style))
		    (:y1 ,(o-formula (opal:gv-center-y (gvl :parent :title-string))))
		    (:x2 ,(o-formula (let ((win (gvl :window)))
			      (- (gv win :width)(gv win :RIGHT-BORDER-WIDTH)
				 (gv win :LEFT-BORDER-WIDTH) 2))))
		    (:y2 ,(o-formula (gvl :y1))))
       (:title-string ,opal:text (:string "Gadgets")
		      (:font ,title-font)
	              (:constant (T :except :left))
		      (:fill-background-p T)
		      (:left ,(o-formula (floor (- (gvl :window  :width)
						   (gvl :width)) 2)))
		      (:top 0))
       (:selectable-objs ,opal:aggregate)  ; filled explicitly below
       (:feedback ,opal:rectangle
		       (:obj-over NIL)
		       (:line-style ,opal:line-2)
		       (:visible
			;; visible if obj-over and in build mode
			,(o-formula (and (gvl :obj-over)
					 (eq :build (gv *Run-Build-Obj* :value)))))
		       (:left ,(o-formula (- (gvl :obj-over :left) 5)))
		       (:top ,(o-formula (- (gvl :obj-over :top) 5)))
		       (:width ,(o-formula (+ (gvl :obj-over :width) 10)))
		       (:height ,(o-formula (+ (gvl :obj-over :height)
					       10))))
       (:cover-up ,gray-out
		       (:obj-over ,(o-formula (gvl :window)))
		       (:left 0) ; override left and top, so will be zero
		       (:top 0)
		       (:visible
			;; visible if in run mode
			,(o-formula (eq :run (gv *Run-Build-Obj* :value)))))))
    (:interactors
     `((:select ,inter:button-interactor
		(:window ,(o-formula  (gv-local :self :operates-on :window)))
		(:how-set :set)
		(:continuous NIL)
		(:final-feedback-obj ,(o-formula (gvl :operates-on :feedback)))
		(:active ,(formula BuildGadgetActiveForm))
		(:start-event :any-mousedown)
		(:start-where
		 ,(o-formula (list :element-of
				   (gvl :operates-on :selectable-objs))))))))


(defun Make-IB-Window ()
  (create-instance NIL inter:interactor-window
		   (:left 550)(:top 300)(:width 450)(:height 420)
		   (:title "Gilt Gadgets"))
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now define the extra information needed for each type of object
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(create-instance 'type-text-button-panel NIL
		  (:line-p NIL)
		  (:changeable-slots '(T T NIL NIL))
		  (:String-Set-Func 'Text-Button-String-Func)
		  (:aggrelist-slots *List-Item*)
		  (:properties-slots (append *aggrelist-slots* *shadow-slots*
				       (list '(:final-feedback-p (T NIL))
					     (list :font (font-for))
					     :items)))
		  (:props-title "Text Button Properties")
		  (:slots-to-copy *List-Item*))

(create-instance 'type-x-button-panel NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T NIL NIL))
	    (:String-Set-Func 'X-Button-String-Func)
	    (:slots-to-copy *List-Item*)
	    (:aggrelist-slots *List-Item*)
	    (:props-title "X Button Properties")
	    (:properties-slots (append *aggrelist-slots* *shadow-slots*
				       (list (list :button-width #'num-only)
					     (list :button-height #'num-only)
					     '(:text-on-left-p (T NIL))
					     (list :font (font-for))
					     :items))))

(create-instance 'type-radio-button-panel NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T NIL NIL))
	    (:String-Set-Func 'Radio-Button-String-Func)
	    (:slots-to-copy *List-Item*)
	    (:aggrelist-slots *List-Item*)
	    (:properties-slots (append *aggrelist-slots* *shadow-slots*
				       (list (list :button-diameter #'num-only)
					     '(:text-on-left-p (T NIL))
					     (list :font (font-for))
					     :items)))
	    (:props-title "Radio Button Properties"))

(create-instance 'type-scrolling-menu NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func 'Scroll-Menu-String-Func)
		 (:properties-slots
		  (append (list '(:known-as NIL "(keyword)")
				:title
				:menu-selection-function
				:scroll-selection-function
				(list :num-visible #'num-only)
				)
			  *all-scroll-slots*
			  (list '(:scroll-on-left-p (T NIL))
				(list :min-scroll-bar-width #'num-only)
				'(:int-scroll-feedback-p (T NIL))
				(list :min-frame-width #'num-only)
				(list :v-spacing #'num-only)
				'(:h-align (:left :center :right))
				'(:multiple-p (T NIL))
				(list :indicator-font (font-for))
				(list :item-font (font-for))
				(list :title-font (font-for))
				'(:int-menu-feedback-p (T NIL))
				'(:final-feedback-p (T NIL))
				(list :text-offset #'num-only)
				:items)))
		 (:props-title "Scrolling Menu Properties")
		 (:slots-to-copy *List-Item*)
		 (:aggrelist-slots *List-Item*))

(create-instance 'type-okcancel NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func NIL) ; must stay OK-CANCEL
		 (:props-title "OK-Cancel Properties")
		 ; no selection function - set action in save-box.
		 (:properties-slots (append (List '(:known-as NIL "(keyword)")
				      '(:direction (:Vertical :Horizontal))
				      (list :v-spacing #'num-only)
				      (list :h-spacing #'num-only)
				      '(:fixed-width-p (T NIL))
				      '(:fixed-height-p (T NIL))
				      '(:h-align (:left :center :right))
				      (list :rank-margin #'num-only)
				      (list :pixel-margin #'num-only)
				      (list :indent #'num-only)
				      )
				    *shadow-slots*))
		 (:aggrelist-slots *List-Item*)
		 (:slots-to-copy *List-Item*))

(create-instance 'type-okapplycancel NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func NIL) ; must stay OK-APPLY-CANCEL
		 (:props-title "OK-Apply-Cancel Properties")
		 ; no selection function - set action in save-box.
		 (:properties-slots (append (List '(:known-as NIL "(keyword)")
				      '(:direction (:Vertical :Horizontal))
				      (list :v-spacing #'num-only)
				      (list :h-spacing #'num-only)
				      '(:fixed-width-p (T NIL))
				      '(:fixed-height-p (T NIL))
				      '(:h-align (:left :center :right))
				      (list :rank-margin #'num-only)
				      (list :pixel-margin #'num-only)
				      (list :indent #'num-only)
				      )
				    *shadow-slots*))
		 (:aggrelist-slots *List-Item*)
		 (:slots-to-copy *List-Item*))

(create-instance 'type-menu NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func 'Menu-String-Func)
		 (:props-title "Menu Properties")
		 (:properties-slots (append (List '(:known-as NIL "(keyword)")
					     :title
					     :select-function
					     (list :v-spacing #'num-only)
					     '(:h-align (:left :center :right))
					     (list :title-font (font-for))
					     (list :item-font (font-for))
					     :items)
				       *shadow-slots*))
		 (:slots-to-copy (cons :title *List-Item*))
		 (:aggrelist-slots *List-Item*))

(create-instance 'type-h-scroll-bar NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T T NIL))
		 (:props-title "Horizontal Scroll Bar Properties")
		 (:properties-slots (append (List '(:known-as NIL "(keyword)")
						  :select-function
						  (list :val-1 #'num-only)
						  (list :val-2 #'num-only)
						  (list :min-height #'num-only)
						  '(:int-feedback-p (T NIL)))
				       *all-scroll-slots*)))

(create-instance 'type-h-slider NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T T NIL))
		 (:props-title "Horizontal Slider Properties")
		 (:properties-slots (append *all-slider-slots*
				       (list (list :shaft-height #'num-only)
					     )))
		 (:aggrelist-slots '(:num-marks)))

(create-instance 'type-v-scroll-bar NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T NIL T))
	    (:props-title "Vertical Scroll Bar Properties")
	    (:properties-slots (append (List '(:known-as NIL "(keyword)")
					     :select-function
					     (list :val-1 #'num-only)
					     (list :val-2 #'num-only)
					     (list :min-width #'num-only)
					     '(:int-feedback-p (T NIL)))
				       *all-scroll-slots*)))

(create-instance 'type-v-slider NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL T))
		 (:props-title "Vertical Slider Properties")
		 (:properties-slots (append *all-slider-slots*
					    (list (list :shaft-width #'num-only)
						  )))
		 (:aggrelist-slots '(:num-marks)))

(create-instance 'type-gauge NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T T NIL))
		 (:String-Set-Func 'Gauge-String-Func)
		 (:props-title "Gauge Properties")
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  :select-function
					  (list :val-1 #'num-only)
					  (list :val-2 #'num-only)
					  (list :num-marks #'num-only)
					  '(:tic-marks-p (T NIL))
					  '(:enumerate-p (T NIL))
					  '(:value-feedback-p (T NIL))
					  '(:polygon-needle-p (T NIL))
					  '(:int-feedback-p (T NIL))
					  :title
					  (list :title-font (font-for))
					  (list :value-font (font-for))
					  (list :enum-font  (font-for))))
		 (:aggrelist-slots '(:num-marks))
		 (:slots-to-copy (list :title)))

(create-instance 'type-trill-device NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:props-title "Trill Device Properties")
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  :select-function
					  (list :val-1 #'num-only)
					  (list :val-2 #'num-only)
					  (list :min-frame-width #'num-only)
					  (list :min-height #'num-only)
					  (list :scr-incr #'num-only)
					  (list :page-incr #'num-only)
					  '(:scr-trill-p (T NIL))
					  '(:page-trill-p (T NIL))
					  '(:value-feedback-p (T NIL))
				     (list :value-feedback-font (font-for)))))

(create-instance 'type-labeled-box NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:props-title "Labeled Box Properties")
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  :select-function
					  :label-string
					  (list :min-frame-width #'num-only)
					  (list :label-offset #'num-only)
					  (list :field-offset #'num-only)
					  (list :field-font (font-for))
					  (list :label-font (font-for))))
		 (:String-Set-Func 'Labeled-Box-String-Func))

(create-instance 'type-scrolling-labeled-box NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T T NIL))
	    (:props-title "Scrolling Labeled Box Properties")
	    (:properties-slots (list '(:known-as NIL "(keyword)")
				     :select-function
				     :label-string
				     (list :min-frame-width #'num-only)
				     (list :label-offset #'num-only)
				     (list :field-offset #'num-only)
				     (list :field-font (font-for))
				     (list :label-font (font-for))))
	    (:String-Set-Func 'Labeled-Box-String-Func))

(create-instance 'type-rectangle NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T T T))
	    (:props-title "Rectangle Properties")
	    (:properties-slots (list '(:known-as NIL "(keyword)")
				     (list :line-style (Line-style-for))
				     (list :filling-style (fill-style-for))
				     :draw-function)))

(create-instance 'type-line NIL
		 (:line-p T)
		 (:changeable-slots '(T T T T))
		 (:props-title "Line Properties")
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  (list :line-style (Line-style-for))
					  :draw-function)))

(create-instance 'type-text NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:properties-func 'String-Props)
		 (:props-title "Text Properties")
		 (:String-Set-Func 'String-string-Func))

(create-instance 'type-bitmap NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  (list :image-name #'invalid-pathname-p
						"(pathname)")
					  :draw-function))
		 (:props-title "Bitmap Properties"))

;;; The next one is used for objects read from the disk.  Don't know
;;; what properties are available so just allow position to be changed.
(create-instance 'type-generic NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:properties-slots NIL)
		 (:props-title "Generic Properties"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now define the gadgets;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun add-std-gadgets (ib-win)
  (let ((agg (g-value ib-win :aggregate :selectable-objs))
	lab-box scroll-box)
    (opal:add-components agg
       (create-instance NIL garnet-gadgets:text-button-panel
	    (:box '(10 30 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:items '("Label1" "Label2" "Label3"))
	    (:gilt-type type-text-button-panel))
       (create-instance NIL garnet-gadgets:x-button-panel
	    (:box '(100 30 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:items '("Label1" "Label2" "Label3"))
	    (:gilt-type type-x-button-panel))
       (create-instance NIL garnet-gadgets:radio-button-panel
	    (:box '(100 135 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:items '("Label1" "Label2" "Label3"))
	    (:gilt-type type-radio-button-panel))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "scrolling-menu.bitmap"))
	    (:gilt-type type-scrolling-menu) ;must be in both bitmap and obj
	    (:left 10)(:top 200)
	    (:loaded 'garnet-gadgets::scrolling-menu)
	    (:load-file "scrolling-menu-loader")
	    (:maker '((create-instance NIL garnet-gadgets::scrolling-menu
	    (:box '(10 200 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:items '("Label1" "Label2" "Label3" "Label4" "Label5" "Label6"
		      "Label7" "Label8"))
	    (:title "Title")
	    (:gilt-type type-scrolling-menu)))))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "okcancel.bitmap"))
	    (:gilt-type type-okcancel) ;must be in both bitmap and obj
	    (:left 11)(:top 350)
	    (:loaded T)
	    (:maker '((create-instance NIL GARNET-GADGETS:TEXT-BUTTON-PANEL
	    (:box '(11 350 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:DIRECTION :HORIZONTAL)
	    (:SHADOW-OFFSET 5)
	    (:TEXT-OFFSET 2)
	    (:final-feedback-p NIL)
	    (:GRAY-WIDTH 3)
	    (:ITEMS '("OK" "Cancel"))
	    (:SELECT-FUNCTION 'OKCancel-Function)
	    (:gilt-type type-okcancel)))))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "okapplycancel.bitmap"))
	    (:gilt-type type-okapplycancel) ;must be in both bitmap and obj
	    (:left 11)(:top 385)
	    (:loaded T)
	    (:maker '((create-instance NIL GARNET-GADGETS:TEXT-BUTTON-PANEL
	    (:box '(11 385 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:DIRECTION :HORIZONTAL)
	    (:SHADOW-OFFSET 5)
	    (:TEXT-OFFSET 2)
	    (:final-feedback-p NIL)
	    (:GRAY-WIDTH 3)
	    (:ITEMS '("OK" "Apply" "Cancel"))
	    (:SELECT-FUNCTION 'OKCancel-Function)
	    (:gilt-type type-okapplycancel)))))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "menu.bitmap"))
	    (:gilt-type type-menu) ;must be in both bitmap and obj
	    (:load-file "menu-loader")
	    (:loaded 'garnet-gadgets::menu)
	    (:left 110)(:top 240)
	    (:maker '((create-instance NIL garnet-gadgets::menu
	    (:box '(110 240 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:items '("Label1" "Label2" "Label3"))
	    (:title "Title")
	    (:gilt-type type-menu)))))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "h-scroll-bar.bitmap"))
	    (:gilt-type type-h-scroll-bar) ;must be in both bitmap and obj
	    (:load-file "h-scroll-loader")
	    (:loaded 'garnet-gadgets::h-scroll-bar)
	    (:left 185)(:top 30)
	    (:min-width 120)
	    (:maker '((create-instance NIL garnet-gadgets::h-scroll-bar
	    (:box '(185 30 200 NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:grow-p T)
	    (:width (formula widthform))
	    (:gilt-type type-h-scroll-bar)) 25)))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "h-slider.bitmap"))
	    (:gilt-type type-h-slider) ;must be in both bitmap and obj
	    (:load-file "h-slider-loader")
	    (:loaded 'garnet-gadgets::h-slider)
	    (:left 185)(:top 65)
	    (:min-width 130)
	    (:maker '((create-instance NIL garnet-gadgets::h-slider
	    (:box '(185 65 200 NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:grow-p T)
	    (:width (formula widthform))
	    (:val-2 10)(:num-marks 6)
	    (:gilt-type type-h-slider)) 3)))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "v-scroll-bar.bitmap"))
	    (:gilt-type type-v-scroll-bar) ;must be in both bitmap and obj
	    (:loaded 'garnet-gadgets::v-scroll-bar)
	    (:load-file "v-scroll-loader")
	    (:left 185)(:top 110)
	    (:min-height 120)
	    (:maker '((create-instance NIL garnet-gadgets::v-scroll-bar
	    (:box '(185 110 NIL 250))
	    (:left (formula leftform))(:top (formula topform))
	    (:grow-p T)
	    (:height (formula heightform))
	    (:gilt-type type-v-scroll-bar)) 25)))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "v-slider.bitmap"))
	    (:gilt-type type-v-slider) ;must be in both bitmap and obj
	    (:loaded 'garnet-gadgets::v-slider)
	    (:load-file "v-slider-loader")
	    (:left 225)(:top 110)
	    (:min-height 120)
	    (:maker '((create-instance NIL garnet-gadgets::v-slider
	    (:box '(225 110 NIL 250))
	    (:left (formula leftform))(:top (formula topform))
	    (:grow-p T)
	    (:height (formula heightform))
	    (:val-2 10)(:num-marks 6)
	    (:gilt-type type-v-slider)) 3)))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "gauge.bitmap"))
	    (:gilt-type type-gauge) ;must be in both bitmap and obj
	    (:loaded 'garnet-gadgets::gauge)
	    (:load-file "gauge-loader")
	    (:left 280)(:top 110)
	    (:min-width 100)
	    (:maker '((create-instance NIL garnet-gadgets::gauge
	    (:box '(280 110 100 NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:width (formula widthform))
	    (:int-feedback-p NIL)
	    (:val-1 10)(:val-2 0)
	    (:num-marks 6)(:title "Title")(:value-feedback-p NIL)
	    (:int-feedback-p NIL)
	    (:gilt-type type-gauge)) 3)))
       (create-instance NIL opal:bitmap
	    (:image (Get-Gilt-Bitmap "trill-device.bitmap"))
	    (:gilt-type type-trill-device) ;must be in both bitmap and obj
	    (:load-file "trill-device-loader")
	    (:loaded 'garnet-gadgets::trill-device)
	    (:left 290)(:top 210)
	    (:min-width 100)
	    (:maker '((create-instance NIL garnet-gadgets::trill-device
	    (:box '(290 210 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:gilt-type type-trill-device)) 25)))
       (setq lab-box (create-instance NIL garnet-gadgets:labeled-box
	    (:box '(280 245 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:min-width 120)
	    (:label-string "Title:")
	    (:gilt-type type-labeled-box)))
       (setq scroll-box (create-instance NIL
					 garnet-gadgets:scrolling-labeled-box
	    (:box '(280 275 130 NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:min-width 120)
	    (:grow-p T)
	    (:width (formula widthform))
	    (:label-string "Title:")
	    (:gilt-type type-scrolling-labeled-box)))
       (create-instance NIL opal:rectangle
	    (:box '(280 318 50 40))
	    (:left (formula leftform))(:top (formula topform))
	    (:grow-p T)
	    (:width (formula widthform))(:height (formula heightform))
	    (:gilt-type type-rectangle))
       (create-instance NIL opal:line
	    (:points '(340 318 365 358))
	    (:line-p T)
	    (:grow-p T)
	    (:x1 (o-formula (first (gvl :points))))
	    (:y1 (o-formula (second (gvl :points))))
	    (:x2 (o-formula (third (gvl :points))))
	    (:y2 (o-formula (fourth (gvl :points))))
	    (:gilt-type type-line))
       (create-instance NIL opal:multi-text
	    (:box '(375 305 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:point-to-leaf 'Fake-Point-to-Leaf) ; needed for text-interactor
	    (:string "Label")
	    (:gilt-type type-text))
       (create-instance NIL opal:bitmap
	    (:box '(375 330 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:image (o-formula (opal:read-image (gvl :image-name))))
	    (:gilt-type type-bitmap)
	    ;; want this to be a string, not a pathname.  *** PROBABLY NEED
	    ;; something different for Apple.
	    (:image-name
	     (namestring (merge-pathnames "giltbitmap.bitmap"
					  user::Garnet-Gilt-Bitmap-PathName))))
       )
    ;; not supposed to set the :value field when creating an object since it
    ;; might contain a formula.

    (Init-Value lab-box "String")
    (Init-Value scroll-box "Very long String")
    (s-value (g-value scroll-box :field-text :string) :first-vis-char 4)

    (Fix-All-Interactors agg T T)
    ))

;;; changeable-slots tell which of (:left :top :width :height) can be changed in
;;; the gadget.  Should contain at least '(:left :top).  There should not be
;;; formulas in any of the changeable slots.
;;(defun add-gadget (obj w changeable-slots)
;;  (opal:add-component (g-value w :aggregate :selectable-objs) obj)
;;  (s-value obj :box (list (g-value obj :left)
;;			  (g-value obj :top)
;;			  (g-value obj :width)
;;			  (g-value obj :height)))
;;  (when (member :left changeable-slots)
;;      (s-value obj :left (formula leftform)))
;;  (when (member :top changeable-slots)
;;      (s-value obj :top (formula topform)))
;;  (when (member :width changeable-slots)
;;      (s-value obj :width (formula widthform)))
;;  (when (member :height changeable-slots)
;;      (s-value obj :height (formula heightform)))
;;  (Fix-All-Interactors obj T T))

