;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: LAPIDARY; 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. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; -*- Mode: Lisp; Package: LAPIDARY -*-
;;; This file contains definitions of objects needed by lapidary

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

;;; =================================================================
;;;
;;; CHANGE LOG
;;;
;;; 8/7/89 -- added an aggregadget for printing error messages
;;;
;;; =================================================================

;;; special lapidary aggregadget; the aggregadget uses the same formulas
;;; as a regular aggregate to compute its bounding box, but it references
;;; it children using g-cached-value so that no dependencies will be
;;; established between the aggregadget and its children. This allows
;;; the children to depend on the aggregadget without creating any
;;; circularities. The formulas will be automatically reevaluated when
;;; a component is added to or removed from the aggregadget

(create-instance 'lapidary-agg opal:aggregadget
  (:left (o-formula
          (let ((min-x 999999))
	    (dolist (child (gvl :components))
	      (when (g-cached-value child :visible)
		(setf min-x (min min-x (g-cached-value child :left)))))
	    (if (= min-x 999999) 0 min-x))))

  (:top (o-formula
	 (let ((min-y 999999))
	   (dolist (child (gvl :components))
	     (when (g-cached-value child :visible)
	       (setf min-y (min min-y (g-cached-value child :top)))))
	   (if (= min-y 999999) 0 min-y))))
  (:width (o-formula
	   (let ((max-x -999999)
		 (min-x 999999))
	     (dolist (child (gvl :components))
	       (when (g-cached-value child :visible)
		 (setf max-x (max max-x (+ (g-cached-value child :left)
					   (g-cached-value child :width))))
		 (setf min-x (min min-x (g-cached-value child :left)))))
	     (max 0 (- max-x min-x)))))
  (:height (o-formula
	    (let ((max-y -999999)
		  (min-y 999999))
	      (dolist (child (gvl :components))
                 (when (g-cached-value child :visible)
                   (setf max-y (max max-y (+ (g-cached-value child :top)
					     (g-cached-value child :height))))
		   (setf min-y (min min-y (g-cached-value child :top)))))
	      (max 0 (- max-y min-y))))))

;;;
;;; INPUT TEXT  (with an interactor -> can be edited)
;;;
(create-instance 'input-text opal:aggregadget
     (:left 0) (:top 0)
     (:frame-width 50)
     (:height 17)
     (:parts
      `((:frame ,opal:rectangle
	      (:left ,(o-formula (gvl :parent :left)))
	      (:filling-style ,opal:white-fill)
	      (:top ,(o-formula (gvl :parent :top)))
	      (:width ,(o-formula (max (gvl :parent :frame-width)
				       (gvl :parent :text :width))))
	      (:height ,(o-formula (gvl :parent :height))))
	(:text ,opal:cursor-text
	     (:left ,(o-formula (+ (gvl :parent :left) 2)))
	     (:top ,(o-formula (+ (gvl :parent :top) 2)))
	     (:cursor-index NIL)
	     (:string ,(o-formula (princ-to-string (gvl :parent :string))))
	     (:font ,*fnt*))))
     (:interactors
      `((:feel ,inter:text-interactor
	    (:window ,(o-formula (gvl :operates-on :window)))
	    (:feedback-obj NIL)
	    (:obj-to-change ,(o-formula (gvl :operates-on :text)))
	    (:stop-action 
	      ,#'(lambda (interactor objover event)

		 (call-prototype-method interactor objover event)
		 
		 ;; stop-function allows special user-defined processing 
		 ;;to be performed

		 (let* ((operates-on (g-value interactor :operates-on))
			(stop-function (g-value operates-on :stop-function)))
		   (when stop-function
		     ;; kr won't sent a message properly to a slot that
		     ;; has a formula, so put stop-function in a new slot
		     ;; that doesn't have a formula

		     (s-value operates-on :stop-function-wof stop-function)
		     (kr-send operates-on :stop-function-wof interactor objover event)))))
	    (:start-where ,(o-formula (list :in (gvl :operates-on :frame))))
	    (:abort-event ,:control-\g) ; \g so lower case
	    (:stop-event (:leftdown #\RETURN))))))


;;;;;;;;;;;;;;;;;;;;;;;;
;;; COMPOSED GADGETS ;;;
;;;;;;;;;;;;;;;;;;;;;;;;
 

;;;
;;; INPUT TEXT WITH TITLE
;;; 

(create-instance 'input-text-with-title opal:aggregadget
   (:left 0) (:top 0)
   (:width (o-formula (+ (gvl :title :width) (gvl :text :width) 5)))
   (:height (o-formula (gvl :text :height)))
   (:parts
    `((:title ,opal:text
		 (:left ,(o-formula (gvl :parent :left)))
		 (:top ,(o-formula (+ (gvl :parent :top) 2)))
		 (:font ,*fnt*)
		 (:string ,(o-formula (gvl :parent :label-string))))
      (:text ,input-text
		 (:left ,(o-formula (+ (gvl :parent :title :left)
				       (gvl :parent :title :width) 5)))
		 (:top ,(o-formula (gvl :parent :top)))
		 (:string ,(o-formula (gvl :parent :string)))
		 (:stop-function ,(o-formula (gvl :parent
						:stop-function)))))))

;; interactor for moving objects between windows

(create-instance 'multi-win-interactor inter:move-grow-interactor
	 (:running-where T)
	 (:old-feedback NIL)
	 (:start-where nil)
	 (:waiting-priority inter:high-priority-level)
	 (:attach-point :where-hit)
	 (:running-action
	  #'(lambda (inter obj new-box)
	     (let ((old-f (g-value inter :old-feedback))
		   (cur-f (g-value inter :feedback-obj)))
	       (when (not (eq old-f cur-f))
		 (when old-f (s-value old-f :obj-over NIL))
		 (when cur-f (s-value cur-f :obj-over obj))
		 (s-value inter :old-feedback cur-f)))
	     (call-prototype-method inter obj new-box))))
