;;; -*- 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:
    3/26/92 Andrew Mickish - Added Invalid-Pathname-p
     2/9/92 Brad Myers - broke off from gilt-gadgets and motif-gilt-gadgets.
============================================================
|#


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


;;; Set the value slot, but first make sure that formulas are set up by
;;; calling g-value
(defun Init-Value (obj new-val)
  (g-value obj :value) ; need to do this to set up the dependencies
  (s-value obj :value new-val))


;; This function pops up a font, line-style or filling-style dialog window
;; when the user presses on an icon.
(defun Pop-Up-Prop-Dialog (icon-gadget)
  (let ((func (g-value icon-gadget :creator-function)))
    (multiple-value-bind (left top)
      (opal:convert-coordinates (g-value icon-gadget :window)
				(g-value icon-gadget :left)
				(opal:bottom icon-gadget) NIL)
      (setq top (+ 10 top))
      (funcall func left top icon-gadget :value))))

;;This function creates a pop-up-from-icon gadget for a font
(defun Font-for ()
  (create-instance NIL Garnet-gadgets:Pop-Up-From-Icon
		   (:creator-function 'Show-Font-Dialog)
		   (:pop-up-function 'Pop-Up-Prop-Dialog)))

;;This function creates a pop-up-from-icon gadget for a line-style
(defun Line-style-for ()
  (create-instance NIL Garnet-gadgets:Pop-Up-From-Icon
		   (:creator-function 'Show-Line-Props-Dialog)
		   (:pop-up-function 'Pop-Up-Prop-Dialog)))

;;This function creates a pop-up-from-icon gadget for a filling-style
(defun Fill-style-for ()
  (create-instance NIL Garnet-gadgets:Pop-Up-From-Icon
		   (:creator-function 'Show-Fill-Props-Dialog)
		   (:pop-up-function 'Pop-Up-Prop-Dialog)))


(defun Color-DB-for ()
  (create-instance NIL Garnet-gadgets:Pop-Up-From-Icon
     (:creator-function 'Show-Color-Dialog-For)
     (:pop-up-function 'Pop-Up-Prop-Dialog)))

;; return T if error (not number or nil)
(defun nil-or-num (val)
  (unless (or (null val)
	      (numberp val))
    (gilt-error "Value must be a number or NIL.")
    T))

;; return T if error (not number)
(defun num-only (val)
  (unless (numberp val)
    (gilt-error "Value must be a number.")
    T))

;; return T if error (file not found)
(defun invalid-pathname-p (p)
  (unless (probe-file p)
    (gilt-error (format NIL "File not found:~%~S" p))
    T))

;;; Need a point to leaf in the text object, so can find the string (since
;;; it is in the string itself and not in a leaf).
(Defun Fake-Point-to-Leaf (agg x y &key type)
  (let ((ret (if (and (or (null type) (is-a-p agg type))
		      (opal:point-in-gob agg x y))
		 agg
		 NIL)))
    ret))


;;; Used to make title of gadget window

(create-instance 'title-font opal:font 
		 (:constant '(T))
		 (:size :large)(:face :italic)(:family :serif))

;;; This function loads the bitmap specified from the Gilt directory
(defun Get-Gilt-Bitmap (bitmapname)
  (opal:read-image (merge-pathnames bitmapname
			 user::Garnet-Gilt-Bitmap-PathName)))

