;;; -*- Mode:Lisp; Syntax:Common-lisp; Package:GG; Base:10 -*-

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

(export '(SCORED-RECT HEAVY-SCORED-RECT SCORED-HRULE SCORED-VRULE))

;;; SCORED-RECT.LISP
;;; 2 February 95 by Philpot
;;; This code developed by Andrew Philpot, Recom Tech/NASA Ames
;;; philpot@ptolemy.arc.nasa.gov
;;;
;;; Attempt to make a "scored" rectangle gadget.
;;; "Scored" is the term I use for a simpler motif-like effect than
;;; that of motif-rect.  Rather than making the rectangle's interior
;;; appear to be inset or projected, the surrounding line appears to
;;; be inset slightly into the screen.  This gives a less ornate
;;; appearance when this rectangle is used for grouping than would the
;;; MOTIF-RECT.  HEAVY-SCORED-RECT, also in this file, gives a more
;;; hearty rectangle of the basic same design.  This code was modeled
;;; on MOTIF-RECT.  Use should be similar.

(create-instance 'SCORED-LIGHT-GRAY opal:motif-light-gray)

(create-instance 'SCORED-LIGHT-GRAY-FILL opal:motif-light-gray-fill)

(create-instance 'SCORED-LIGHT-GRAY-LINE opal:line-style
  (:constant t)
  (:foreground-color scored-light-gray)
  )

(create-instance 'SCORED-DARK-GRAY opal:color
  (:constant t)
  (:red 0.435)
  (:blue 0.435)
  (:green 0.435)
  )

(create-instance 'SCORED-DARK-GRAY-FILL opal:filling-style
  (:constant t)
  (:foreground-color scored-dark-gray)
  )

(create-instance 'SCORED-DARK-GRAY-LINE opal:line-style
  (:constant t)
  (:foreground-color scored-dark-gray)
  )

;;; SCORED-RECT

(create-instance 'SCORED-RECT motif-gadget-prototype
   :declare ((:parameters :left :top :width :height :foreground-color
			  :visible :depressed-p)
	    (:type (kr-boolean :visible :depressed-p)
		   ((is-a-p opal:color) :foreground-color)
		   )
	    (:maybe-constant :left :top :width :height
			     :foreground-color :visible :depressed-p))
   (:left 0)(:top 0)(:width 50)(:height 50)
   (:right (o-formula (+ (gvl :left) (gvl :width))))
   (:bottom (o-formula (+ (gvl :top) (gvl :height))))
   ;; Something doesn't look right for :DEPRESSED-P NIL
   ;; Probably, the black box in that case should be continuous
   (:depressed-p t)
   (:parts
    `((:outer-box ,opal:rectangle
		  (:left ,(o-formula (gv (kr-path 0 :parent) :left)))
		  (:top ,(o-formula (gv (kr-path 0 :parent) :top)))
		  (:width ,(o-formula (gv (kr-path 0 :parent) :width)))
		  (:height ,(o-formula (gv (kr-path 0 :parent) :height)))
		  (:line-style NIL)
		  (:filling-style ,(o-formula
				    (if (gv (kr-path 0 :parent)
					    :depressed-p)
					scored-light-gray-fill
					scored-dark-gray-fill))))
      (:dark-box ,opal:rectangle
		 (:left ,(o-formula (gv (kr-path 0 :parent) :left)))
		 (:top ,(o-formula (gv (kr-path 0 :parent) :top)))
		 (:width ,(o-formula (- (gv (kr-path 0 :parent) :width) 1)))
		 (:height ,(o-formula (- (gv (kr-path 0 :parent) :height) 1)))
		 (:line-style NIL)
		 (:filling-style ,(o-formula
				   (if (gv (kr-path 0 :parent)
					   :depressed-p)
				       scored-dark-gray-fill
				       scored-light-gray-fill))))
      (:inner-box ,opal:rectangle
		  (:left ,(o-formula (+ (gv (kr-path 0 :parent) :left) 1)))
		  (:top ,(o-formula (+ (gv (kr-path 0 :parent) :top) 1)))
		  (:width ,(o-formula (- (gv (kr-path 0 :parent)
					     :width) 3)))
		  (:height ,(o-formula (- (gv (kr-path 0 :parent)
					      :height) 3)))
		  (:line-style NIL)
		  (:filling-style ,(o-formula
				    (if (gv (kr-path 0 :parent)
					    :depressed-p)
					scored-light-gray-fill
					scored-dark-gray-fill))))
      (:gray-box ,opal:rectangle
	     (:left ,(o-formula (+ 2 (gv (kr-path 0 :parent) :left))))
	     (:top ,(o-formula (+ 2 (gv (kr-path 0 :parent) :top))))
	     (:width ,(o-formula (- (gv (kr-path 0 :parent) :width) 4)))
	     (:height ,(o-formula (- (gv (kr-path 0 :parent) :height) 4)))
	     (:line-style NIL)
	     (:filling-style ,(o-formula
			       (gv (kr-path 0 :parent) :foreground-fill))))
      )
    )
   )

;;; HEAVY-SCORED-RECT

(create-instance 'HEAVY-SCORED-RECT gg::motif-gadget-prototype
   :declare ((:parameters :left :top :width :height :foreground-color
			  :visible)
	    (:type (kr-boolean :visible)
		   ((is-a-p opal:color) :foreground-color)
		   )
	    (:maybe-constant :left :top :width :height
			     :foreground-color :visible))
   (:left 0)(:top 0)(:width 50)(:height 50)
   (:right (o-formula (+ (gvl :left) (gvl :width))))
   (:bottom (o-formula (+ (gvl :top) (gvl :height))))
   (:parts
    `((:outer-box ,opal:rectangle
		  (:left ,(o-formula (gv (kr-path 0 :parent) :left)))
		  (:top ,(o-formula (gv (kr-path 0 :parent) :top)))
		  (:width ,(o-formula (gv (kr-path 0 :parent) :width)))
		  (:height ,(o-formula (gv (kr-path 0 :parent) :height)))
		  (:line-style NIL)
		  (:filling-style ,scored-light-gray-fill))
      (:dark-box ,opal:rectangle
		 (:left ,(o-formula (gv (kr-path 0 :parent) :left)))
		 (:top ,(o-formula (gv (kr-path 0 :parent) :top)))
		 (:width ,(o-formula (- (gv (kr-path 0 :parent) :width) 2)))
		 (:height ,(o-formula (- (gv (kr-path 0 :parent) :height) 2)))
		 (:line-style NIL)
		 (:filling-style ,scored-dark-gray-fill))
      (:inner-box ,opal:rectangle
		  (:left ,(o-formula (+ (gv (kr-path 0 :parent) :left) 2)))
		  (:top ,(o-formula (+ (gv (kr-path 0 :parent) :top) 2)))
		  (:width ,(o-formula (- (gv (kr-path 0 :parent)
					     :width) 6)))
		  (:height ,(o-formula (- (gv (kr-path 0 :parent)
					      :height) 6)))
		  (:line-style NIL)
		  (:filling-style ,scored-light-gray-fill))
      (:gray-box ,opal:rectangle
	     (:left ,(o-formula (+ 4 (gv (kr-path 0 :parent) :left))))
	     (:top ,(o-formula (+ 4 (gv (kr-path 0 :parent) :top))))
	     (:width ,(o-formula (- (gv (kr-path 0 :parent) :width) 8)))
	     (:height ,(o-formula (- (gv (kr-path 0 :parent) :height) 8)))
	     (:line-style NIL)
	     (:filling-style ,(o-formula
			       (gv (kr-path 0 :parent) :foreground-fill))))
      )
    )
   )

;;; SCORED-HRULE
;;; A scored horizontal line, similar to that used in NCSA mosaic when
;;; implementing HTML's <HR> directive.

(create-instance 'SCORED-HRULE opal:aggregadget
  :declare ((:parameters :left :top :width :visible)
	    (:type (kr-boolean :visible)
		   )
	    (:maybe-constant :left :top :width :height
			     :foreground-color :visible))
  (:left 10)
  (:top 10)
  (:width 50)
  (:height 2)
  (:parts
   `((:dark-line ,opal:line
		 (:x1 ,(o-formula (gv (kr-path 0 :parent) :left)))
		 (:y1 ,(o-formula (gv (kr-path 0 :parent) :top)))
		 (:x2 ,(o-formula (let ((p (kr-path 0 :parent)))
				    (+ (gv p :left)
				       (gv p :width)))))
		 (:y2 ,(o-formula (gv (kr-path 0 :parent) :top)))
		 (:line-style ,scored-dark-gray-line))
     (:light-line ,opal:line
		  (:x1 ,(o-formula (gv (kr-path 0 :parent) :left)))
		  (:y1 ,(o-formula (+ 1 (gv (kr-path 0 :parent) :top))))
		  (:x2 ,(o-formula (let ((p (kr-path 0 :parent)))
				    (+ (gv p :left)
				       (gv p :width)))))
		  (:y2 ,(o-formula (+ 1 (gv (kr-path 0 :parent) :top))))
		  (:line-style ,scored-light-gray-line))
     )
   )
  )

;;; SCORED-VRULE
;;; A scored vertical line

(create-instance 'SCORED-VRULE opal:aggregadget
  :declare ((:parameters :left :top :height :visible)
	    (:type (kr-boolean :visible)
		   )
	    (:maybe-constant :left :top :width :height
			     :foreground-color :visible))
  (:left 10)
  (:top 10)
  (:width 2)
  (:height 20)
  (:parts
   `((:dark-line ,opal:line
		 (:x1 ,(o-formula (gv (kr-path 0 :parent) :left)))
		 (:y1 ,(o-formula (gv (kr-path 0 :parent) :top)))
		 (:x2 ,(o-formula (gv (kr-path 0 :parent) :left)))
		 (:y2 ,(o-formula (let ((p (kr-path 0 :parent)))
				    (+ (gv p :top)
				       (gv p :height)))))
		 (:line-style ,scored-dark-gray-line))
     (:light-line ,opal:line
		  (:x1 ,(o-formula (+ 1 (gv (kr-path 0 :parent) :left))))
		  (:y1 ,(o-formula (gv (kr-path 0 :parent) :top)))
		  (:x2 ,(o-formula (+ 1 (gv (kr-path 0 :parent) :left))))
		  (:y2 ,(o-formula (let ((p (kr-path 0 :parent)))
				     (+ (gv p :top)
					(gv p :height)))))
		  (:line-style ,scored-light-gray-line))
     )
   )
  )