(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")

(FILECREATED " 4-Feb-87 23:58:42" {ERIS}<LISPUSERS>LYRIC>COLOROBJ.;2
 7868   

      changes to%:  (VARS COLOROBJCOMS COLOROBJFNS)

      previous date%: "26-Feb-86 14:47:40" {ERIS}<LISPUSERS>LYRIC>COLOROBJ.;1)


(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT COLOROBJCOMS)

(RPAQQ COLOROBJCOMS
 [(FNS * COLOROBJFNS)
                     (FILES COLOR)
                     (INITVARS (COLOROBJ.DEFAULT.COLOR 'RED))
                     (VARS (COLOROBJFNS '(COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN 
                                                COLOROBJ.IMAGEBOXFN COLOROBJ.PUTFN COLOROBJ.COPYFN 
                                                COLOROBJ.WHENOPERATEDONFN))
                           (COLOROBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION COLOROBJ.DISPLAYFN)
                                                     (FUNCTION COLOROBJ.IMAGEBOXFN)
                                                     (FUNCTION COLOROBJ.PUTFN)
                                                     (FUNCTION COLOROBJ.GETFN)
                                                     (FUNCTION COLOROBJ.COPYFN)
                                                     (FUNCTION COLOROBJ.BUTTONEVENTFN)
                                                     (FUNCTION NILL)
                                                     (FUNCTION NILL)
                                                     (FUNCTION NILL)
                                                     (FUNCTION NILL)
                                                     (FUNCTION NILL)
                                                     (FUNCTION COLOROBJ.WHENOPERATEDONFN)
                                                     (FUNCTION NILL])

(RPAQQ COLOROBJFNS
 (COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN COLOROBJ.IMAGEBOXFN 
                          COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))
(DEFINEQ

(COLOROBJ.CREATE

  [LAMBDA (COLOR)
                                            (* gbn "13-Jan-86 16:00")

          
          (* * create a color object. color is anything acceptable to dspcolor

          (atoms on colornames, rgb triples, indices))


    (LET ((COLOROBJ (IMAGEOBJCREATE NIL COLOROBJ.IMAGEFNS)))
         (IMAGEOBJPROP COLOROBJ 'COLOR (OR COLOR COLOROBJ.DEFAULT.COLOR))
         COLOROBJ])

(COLOROBJ.DISPLAYFN

  [LAMBDA (COLOROBJ IMAGE.STREAM)
                            (* gbn "13-Jan-86 17:51")

          
          (* On the display a color object shows up as the color name, otherwise it has 

          no image. On any stream it has the sideeffect of changing the foreground color)


    (LET* ((COLOR (IMAGEOBJPROP COLOROBJ 'COLOR))
           (X (DSPXPOSITION NIL IMAGE.STREAM))
           (Y (DSPYPOSITION NIL IMAGE.STREAM)))
          (DSPCOLOR COLOR IMAGE.STREAM)
          (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
              (DISPLAY (DSPFONT '(WEIGHT BOLD) IMAGE.STREAM)
                       (LET* ((STRING (IMAGEOBJPROP COLOROBJ 'COLOR))
                              (STRINGREGION (STRINGREGION STRING IMAGE.STREAM))
                              (LEFT (ADD1 (fetch
 (REGION LEFT) of
 STRINGREGION)))
                              (BOTTOM (fetch
 (REGION BOTTOM) of
 STRINGREGION))
                              (REGION (create
 REGION
                                             LEFT _ LEFT
                                             BOTTOM _ BOTTOM
                                             HEIGHT _ (IPLUS (fetch
 (REGION HEIGHT) of
 STRINGREGION)
                                                             2)
                                             WIDTH _ (IPLUS (fetch
 (REGION WIDTH) of
 STRINGREGION)
                                                            6)))
                              (TOP (fetch
 (REGION TOP) of
 REGION))
                              (RIGHT (fetch
 (REGION RIGHT) of
 REGION)))
                             (IMAGEOBJPROP COLOROBJ 'REGION REGION)
                             (CENTERPRINTINREGION STRING REGION IMAGE.STREAM)
                             (DRAWLINE LEFT BOTTOM LEFT (SUB1 TOP)
                                    1
                                    'INVERT IMAGE.STREAM)
                             (DRAWLINE LEFT TOP (SUB1 RIGHT)
                                    TOP 1 'INVERT IMAGE.STREAM)
                             (DRAWLINE RIGHT TOP RIGHT (ADD1 BOTTOM)
                                    1
                                    'INVERT IMAGE.STREAM)
                             (DRAWLINE RIGHT BOTTOM (ADD1 LEFT)
                                    BOTTOM 1 'INVERT IMAGE.STREAM)))
              (NILL])

(COLOROBJ.GETFN

  [LAMBDA (INPUT.STREAM TEXTSTREAM)
                          (* gbn "13-Jan-86 15:42")

                                                             (* reads the COLOR and creates an 

                                                             COLOROBJ)

    (COLOROBJ.CREATE
 (READ INPUT.STREAM])

(COLOROBJ.IMAGEBOXFN

  [LAMBDA (COLOROBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN)
     (* gbn "13-Jan-86 16:01")

          
          (* * Returns a null imagebox, except to the display, where it returns the size 

          of the box)


    (LET NIL (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
                 (DISPLAY (create
 IMAGEBOX
                                 XSIZE _ (IPLUS (STRINGWIDTH (IMAGEOBJPROP COLOROBJ 'COLOR)
                                                       (DSPFONT NIL IMAGE.STREAM))
                                                8)
                                 YSIZE _ (IPLUS (FONTHEIGHT (DSPFONT NIL IMAGE.STREAM))
                                                4)
                                 YDESC _ 4
                                 XKERN _ 0))
                 (create
 IMAGEBOX
                        XSIZE _ 0
                        YSIZE _ 0
                        YDESC _ 0
                        XKERN _ 0])

(COLOROBJ.PUTFN

  [LAMBDA (COLOROBJ OUTPUT.STREAM)
                           (* gbn "13-Jan-86 15:57")

                                                             (* prints only the color to the file)

    (PRINT (IMAGEOBJPROP COLOROBJ 'COLOR)
           OUTPUT.STREAM])

(COLOROBJ.COPYFN

  [LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM)
                     (* gbn "13-Jan-86 15:58")

    (COLOROBJ.CREATE
 (IMAGEOBJPROP IMAGEOBJ 'COLOR)
           TOSTREAM])

(COLOROBJ.WHENOPERATEDONFN

  [LAMBDA (A B C C)
                                          (* gbn " 6-Jan-85 13:23")

                                                             (* DUMMY)

    ])
)
(FILESLOAD COLOR)

(RPAQ? COLOROBJ.DEFAULT.COLOR
 'RED)

(RPAQQ COLOROBJFNS
 (COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN COLOROBJ.IMAGEBOXFN 
                          COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))

(RPAQ COLOROBJ.IMAGEFNS
 (IMAGEFNSCREATE (FUNCTION COLOROBJ.DISPLAYFN)
                               (FUNCTION COLOROBJ.IMAGEBOXFN)
                               (FUNCTION COLOROBJ.PUTFN)
                               (FUNCTION COLOROBJ.GETFN)
                               (FUNCTION COLOROBJ.COPYFN)
                               (FUNCTION COLOROBJ.BUTTONEVENTFN)
                               (FUNCTION NILL)
                               (FUNCTION NILL)
                               (FUNCTION NILL)
                               (FUNCTION NILL)
                               (FUNCTION NILL)
                               (FUNCTION COLOROBJ.WHENOPERATEDONFN)
                               (FUNCTION NILL)))
(PUTPROPS COLOROBJ COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1994 6812 (COLOROBJ.CREATE 2004 . 2428) (COLOROBJ.DISPLAYFN 2430 . 4799) (
COLOROBJ.GETFN 4801 . 5136) (COLOROBJ.IMAGEBOXFN 5138 . 6118) (COLOROBJ.PUTFN 6120 . 6406) (
COLOROBJ.COPYFN 6408 . 6601) (COLOROBJ.WHENOPERATEDONFN 6603 . 6810)))))
STOP