;;; -*- 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. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This file originally created by Gilt, then hacked

#|
============================================================
Change log:
     2/18/92 Brad Myers - added constant definitions
     2/20/91 Osamu Hashimoto - separated it from "implementation"
    12/8/90 Brad Myers - made to work with Gilt
    11/1/90 Osamu Hashimoto - created
============================================================
|#

(in-package "GILT" :use '("LISP" "KR"))
(create-instance 'my-color opal:color
        (:red 0.0)(:green 0.0)(:blue 0.0))
(create-instance 'my-filling1 opal:filling-style)
(create-instance 'my-filling2 opal:filling-style)

(create-instance 'label-texts opal:aggregadget
  (:parts `(	   
    (:COLOR-SELECTION ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:GILT-REF "TYPE-TEXT")
      (:BOX (10 15 3 3 ))
      (:STRING "Color-Selection")
      (:FONT ,(create-instance nil OPAL:FONT
	    (:CONSTANT '(T))
            (:SIZE :LARGE)
            (:FACE :BOLD)))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 10))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 15)))
    (:WHITE-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:STRING "White")
      (:BOX (100 42 35 14 ))
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 42)))
    (:BLACK-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:BOX (100 72 35 14 ))
      (:STRING "Black")
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 72)))
    (:RED-LABEL ,OPAL:MULTI-TEXT 
      (:CONSTANT (T))
      (:STRING "Red")
      (:BOX (100 102 35 14 ))
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 102)))
    (:GREEN-LABEL ,OPAL:MULTI-TEXT 
      (:CONSTANT (T))
      (:BOX (100 132 35 14 ))
      (:STRING "Green")
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 132)))
    (:BLUE-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:BOX (100 162 35 14 ))
      (:STRING "Blue")
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 162)))
    (:YELLOW-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:STRING "Yellow")
      (:BOX (100 192 35 14 ))
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 192)))
    (:PURPLE-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:BOX (100 222 35 14 ))
      (:STRING "Purple")
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 222)))
    (:CYAN-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:STRING "Cyan")
      (:BOX (100 252 35 14 ))
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 252)))
    (:ORANGE-LABEL ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:BOX (100 282 35 14 ))
      (:STRING "Orange")
      (:GILT-REF "TYPE-TEXT")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 100))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 282)))
    (:red-slider-label ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:GILT-REF "TYPE-TEXT")
      (:BOX (202 290 3 3 ))
      (:STRING "RED")
      (:FONT ,(create-instance nil OPAL:FONT
            (:CONSTANT '(T))
            (:FACE :BOLD)))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 183))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 77)))
    (:green-slider-label ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:GILT-REF "TYPE-TEXT")
      (:BOX (275 290 3 3 ))
      (:STRING "GREEN")
      (:FONT ,(create-instance nil OPAL:FONT
            (:CONSTANT '(T))
            (:FACE :BOLD)))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 264))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 78)))
    (:blue-slider-label ,OPAL:MULTI-TEXT
      (:CONSTANT (T))
      (:GILT-REF "TYPE-TEXT")
      (:BOX (359 290 3 3 ))
      (:STRING "BLUE")
      (:FONT ,(create-instance nil OPAL:FONT
            (:CONSTANT '(T))
            (:FACE :BOLD)))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 342))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 75)))
)))


;;;**** TEMP *** white-fill has color black now??
(s-value opal:white-fill :foreground-color opal:white)

(create-instance 'color-boxes opal:aggregadget
  (:parts `(	   
    (:WHITE-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 40 55 20 ))
      (:FILLING-STYLE ,OPAL:WHITE-FILL)
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 40))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:BLACK-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 70 55 20 ))
      (:FILLING-STYLE ,OPAL:BLACK-FILL)
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 70))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:RED-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 100 55 20 ))
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:FILLING-STYLE ,OPAL:RED-FILL)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 100))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:GREEN-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 130 55 20 ))
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:FILLING-STYLE ,OPAL:GREEN-FILL)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 130))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:BLUE-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 160 55 20 ))
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:FILLING-STYLE ,OPAL:BLUE-FILL)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 160))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:YELLOW-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:BOX (30 190 55 20 ))
      (:GILT-REF "TYPE-RECTANGLE")
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:FILLING-STYLE ,OPAL:YELLOW-FILL)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 190))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:PURPLE-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:DRAW-FUNCTION :COPY)
      (:FILLING-STYLE ,OPAL:PURPLE-FILL)
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 220 55 20 ))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 220))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:CYAN-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:BOX (30 250 55 20 ))
      (:GILT-REF "TYPE-RECTANGLE")
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:FILLING-STYLE ,OPAL:CYAN-FILL)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 250))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
    (:ORANGE-BOX ,OPAL:RECTANGLE
      (:CONSTANT (T))
      (:DRAW-FUNCTION :COPY)
      (:FILLING-STYLE ,OPAL:ORANGE-FILL)
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (30 280 55 20 ))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 30))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 280))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 20)))
)))

(create-instance 'COLOR-PROP OPAL:AGGREGADGET
  (:WINDOW-TITLE "Color Properties")
  (:WINDOW-LEFT 0)
  (:WINDOW-TOP 0)
  (:WINDOW-WIDTH 450)
  (:WINDOW-HEIGHT 330)
  (:PACKAGE-NAME "GILT")
  (:FUNCTION-FOR-OK `color-prop-ok)
  (:LEFT 0)
  (:TOP 0)
  (:WIDTH (o-formula (GVL :WINDOW :WIDTH) 450))
  (:HEIGHT (o-formula (GVL :WINDOW :HEIGHT) 330))
  (:parts `(
    (:OKCANCEL-BUTTON ,GARNET-GADGETS:TEXT-BUTTON-PANEL
      (:CONSTANT (T))
      (:SELECTION-FUNCTION OKCANCEL-FUNCTION)
      (:GILT-REF "TYPE-OKCANCEL")
      (:INDENT 0)
      (:V-ALIGN :TOP)
      (:V-SPACING 5)
      (:H-ALIGN :CENTER)
      (:FIXED-HEIGHT-P T)
      (:H-SPACING 5)
      (:PIXEL-MARGIN NIL)
      (:RANK-MARGIN NIL)
      (:FIXED-WIDTH-P T)
      (:SELECT-FUNCTION OKCANCEL-FUNCTION)
      (:ITEMS ("OK" "Cancel" ))
      (:GRAY-WIDTH 3)
      (:FINAL-FEEDBACK-P NIL)
      (:TEXT-OFFSET 2)
      (:SHADOW-OFFSET 5)
      (:DIRECTION :HORIZONTAL)
      (:BOX (300 30 117 29 ))
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 300))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 30)))

    (:CURRENT-COLOR ,OPAL:RECTANGLE
      (:CONSTANT (T :EXCEPT :filling-style))
      (:GILT-REF "TYPE-RECTANGLE")
      (:BOX (210 20 55 35 ))
      (:LINE-STYLE ,OPAL:DEFAULT-LINE-STYLE)
      (:FILLING-STYLE ,my-filling1)
      (:OTHER-FILLING-STYLE ,my-filling2)
      (:DRAW-FUNCTION :COPY)
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 200))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 20))
      (:WIDTH ,(o-formula (THIRD (GVL :BOX)) 55))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 35)))

    (:RED-SLIDER ,GARNET-GADGETS:V-SLIDER
      (:CONSTANT (T))
      (:BOX (180 80 39 205 ))
      (:selection-function slider-value)
      (:color-type :red)
      (:val-1 0)
      (:VAL-2 100)
      (:page-incr 10)
      (:NUM-MARKS 6)
      (:GILT-REF "TYPE-V-SLIDER")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 170))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 100))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 205)))
    (:GREEN-SLIDER ,GARNET-GADGETS:V-SLIDER 
      (:CONSTANT (T))
      (:BOX (260 80 39 205 ))
      (:selection-function slider-value)
      (:color-type :GREEN)
      (:val-1 0)
      (:VAL-2 100)
      (:page-incr 10)
      (:NUM-MARKS 6)
      (:GILT-REF "TYPE-V-SLIDER")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 250))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 100))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 205)))
    (:BLUE-SLIDER ,GARNET-GADGETS:V-SLIDER
      (:CONSTANT (T))
      (:BOX (340 80 39 205 ))
      (:selection-function slider-value)
      (:color-type :BLUE)
      (:val-1 0)
      (:VAL-2 100)
      (:page-incr 10)
      (:NUM-MARKS 6)
      (:GILT-REF "TYPE-V-SLIDER")
      (:LEFT ,(o-formula (FIRST (GVL :BOX)) 330))
      (:TOP ,(o-formula (SECOND (GVL :BOX)) 100))
      (:HEIGHT ,(o-formula (FOURTH (GVL :BOX)) 205)))

    (:labels ,label-texts)
    (:colors ,color-boxes)
    (:i-feedback ,opal:rectangle
      (:obj-over NIL)
      (:visible ,(o-formula (gvl :obj-over)))
      (:left ,(o-formula (- (gvl :obj-over :left) 4)))
      (:top ,(o-formula (- (gvl :obj-over :top) 4)))
      (:width ,(o-formula (+ (gvl :obj-over :width) 8)))
      (:height ,(o-formula (+ (gvl :obj-over :height) 8)))
      (:fast-redraw-p T)
      (:line-style ,opal:dashed-line)
      (:draw-function :xor))
    (:feedback ,opal:rectangle
      (:obj-over NIL)
      (:visible ,(o-formula (gvl :obj-over)))
      (:left ,(o-formula (- (gvl :obj-over :left) 3)))
      (:top ,(o-formula (- (gvl :obj-over :top) 3)))
      (:width ,(o-formula (+ (gvl :obj-over :width) 6)))
      (:height ,(o-formula (+ (gvl :obj-over :height) 6)))
      (:fast-redraw-p T)
      (:line-style ,opal:line-2)
      (:draw-function :xor))))
  (:interactors `(
    (:press ,inter:menu-interactor
      (:start-where
        ,(o-formula (list :element-of (gvl :operates-on :colors))))
      (:feedback-obj ,(o-formula (gvl :operates-on :i-feedback)))
      (:final-feedback-obj ,(o-formula (gvl :operates-on :feedback)))
      (:final-function definite-color)
      (:window ,(o-formula (gvl :operates-on :window)))))))

