;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GARNET-GADGETS; 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 the parts used to construct the gadgets in the
;;; box constraint menu
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Change Log
;;;
;;; 5/10/93 bvz Created
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "GARNET-GADGETS" :use '("LISP" "KR"))


(create-instance 'SLOT-BOX garnet-gadgets:labeled-box
   (:left (o-formula (opal:gv-center-x-is-center-of (gvl :parent))))
   (:top (o-formula (gvl :parent :top)))
   (:label-font *slot-font*)
   (:slot nil)
   (:value (o-formula (let ((selected (gv *constraint-gadget* :obj-to-constrain))
			    (slot (gvl :slot)))
			(if (and selected (not (is-a-line-p selected)))
			    (princ-to-string (gv selected slot))
			    "0"))))
   (:interactors `((:text-inter :modify
		     (:active ,(o-formula (eq (gv *constraint-gadget*
						  :selection-type)
					      'one-zero))))))
   (:min-frame-width 30))


(create-instance 'OFFSET-BOX garnet-gadgets:labeled-box
   (:maybe-constant (append (g-value garnet-gadgets:labeled-box :maybe-constant)
			    '(:label-string :label-font)))
   (:left (o-formula (opal:gv-center-x-is-center-of (gvl :parent))))
   (:top (o-formula (+ 5 (opal:gv-bottom (gvl :parent :slot-box)))))
   (:label-string "offset")
   (:label-font opal:default-font)
   (:old-value "0")
   (:value "0")
   (:min-frame-width 30))


(create-instance 'CON-PANEL garnet-gadgets:text-button-panel
   (:width (o-formula (+ (gvl :shadow-offset) (gvl :fixed-width-size))))
   (:height (o-formula (+ (* 2 (+ (gvl :fixed-height-size)
				  (gvl :shadow-offset)))
			  (gvl :v-spacing))))
   (:shadow-offset 5) (:gray-width 3) (:text-offset 3)
   (:value (o-formula (progn 
			(or (gv *constraint-gadget* :obj-to-constrain)
			    (gv *constraint-gadget* :obj-to-reference))
			nil)))
   (:final-feedback-p t)
   (:items `(("unconstrain" remove-constraint)
	     ("customize" create-custom-constraint)))
   (:interactors `(
     (:text-button-press :modify
   	(:final-function
	 ,#'(lambda (interactor final-obj-over)
	      (let* ((action (g-value final-obj-over :action))
		     (gadget (g-value interactor :operates-on))
		     (selected (g-value final-obj-over :selected))
		     (string (when selected
			       (g-value final-obj-over :string))))
	   
		;; Propagate new selection toward :value slot
		(s-value gadget :value-obj (when selected final-obj-over))
		
		;; Actually store the new value in the value slot
		(s-value gadget :value string)

		;; Global function for all items
		(kr-send gadget :selection-function gadget string)

		;; Local function assigned to item
		(when action
		  (funcall action gadget string)))))))))



(create-instance 'SCALE-BOX garnet-gadgets:labeled-box
   (:label-string "Scale")
   (:label-font opal:default-font)
   (:value "1")
   (:old-value "1")
   (:min-frame-width 30))


(create-instance 'DIFFERENCE-BOX garnet-gadgets:labeled-box
   (:left (o-formula (opal:gv-center-x-is-center-of (gvl :parent))))
   (:top (o-formula (+ 5 (opal:gv-bottom (gvl :parent :scale-box)))))
   (:label-string "Difference
in pixels")
   (:label-font opal:default-font)
   (:old-value "0")
   (:value "0")
   (:min-frame-width 30)
   (:parts `((:label-text ,opal:multi-text :inherit (:left :top :string :font))
	     :field-text :frame)))


(create-instance 'BOX-CONSTRAINT-BUTTON opal:aggregadget
   (:maybe-constant :left :top :width :height :where-attach :visible)
   (:floating-left (o-formula (+ (gvl :left)
				 (if (gvl :interim-selected) 4 0))))
   (:floating-top (o-formula (+ (gvl :top)
				(if (gvl :interim-selected) 4 0))))
   (:width 23) (:height 23)
   (:selected (o-formula (progn (or (gv *constraint-gadget* :obj-to-constrain)
				    (gv *constraint-gadget* :obj-to-reference))
				nil)))
   (:where-attach (o-formula (nth (gvl :rank)
				  (gvl :parent :parent :where-attach))))
   (:parts
    `((:shadow ,opal:rectangle
	   (:constant (:visible))
	   (:left ,(o-formula (+ 4 (gvl :parent :left))))
	   (:top ,(o-formula (+ 4 (gvl :parent :top))))
	   (:width 19) (:height 19)
	   (:filling-style ,opal:black-fill)
	   (:line-style NIL))
      (:gray-outline ,opal:rectangle
	   (:constant (:visible))
	   (:left ,(o-formula (gvl :parent :floating-left)))
	   (:top ,(o-formula (gvl :parent :floating-top)))
	   (:width 19) (:height 19)
	   (:filling-style ,opal:gray-fill))
      (:white-field ,opal:rectangle
	   (:constant (:visible))
	   (:left ,(o-formula (+ 4 (gvl :parent :floating-left))))
	   (:top ,(o-formula (+ 4 (gvl :parent :floating-top))))
	   (:width 11) (:height 11)
	   (:filling-style ,(o-formula (if (gvl :parent :selected)
					   opal:black-fill
					   opal:white-fill))))
      (:label ,opal:rectangle
	   (:left ,(o-formula (+ 7 (gvl :parent :floating-left))))
	   (:top ,(o-formula (+ 7 (gvl :parent :floating-top))))
	   (:width 5) (:height 5)
	   (:line-style NIL)
	   (:filling-style ,opal:black-fill)
	   (:visible ,(o-formula (not (gvl :parent :selected))))))))


(create-instance 'BOX-CONSTRAINT-INTER inter:button-interactor
   (:window (o-formula (gvl :operates-on :window)))
   (:start-where (o-formula (list :element-of (gvl :operates-on)
				  :type BOX-CONSTRAINT-BUTTON)))
   (:how-set :set))


(create-instance 'CONSTRAINT-ARROW garnet-gadgets:arrow-line
   (:filling-style opal:black-fill)
   (:parts
    `(:line
      (:arrowhead :modify (:diameter 7)))))


(create-instance 'DIMENSION-ARROW garnet-gadgets:double-arrow-line
   (:parts
    `(:line
      (:arrowhead1 :modify (:diameter 7) (:length 7))
      (:arrowhead2 :modify (:diameter 7) (:length 7)))))


(create-instance 'SEL-BOX opal:rectangle
   (:left (o-formula (- (gvl :center-x) 2)))
   (:top (o-formula (- (gvl :center-y) 2)))
   (:width 10) (:height 10))
