(FILECREATED "30-Oct-85 11:56:04" {ERIS}<LISPCORE>LIBRARY>COLOR.;5 48824  

      changes to:  (VARS COLORCOMS)

      previous date: "29-Oct-85 14:33:36" {ERIS}<LISPCORE>LIBRARY>COLOR.;4)


(* Copyright (c) 1982, 1983, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT COLORCOMS)

(RPAQQ COLORCOMS ((FNS DISPLAYCOLORLEVELS DISPLAYHLSLEVEL DISPLAYHLSLEVELS HLSLEVEL HLSTORGB 
			 HLSVALUEFN HLSVALUEFROMLEVEL LEVELFROMHLSVALUE RAINBOWMAP RGBTOHLS)
	(FNS OVERPAINT BITMAPFROMSTRING SHADEBITMAP)
	(FNS EDITCOLORMAP ADJUSTCOLORMAP EDITCOLORMAP1 EDITCOLORMAP2 GETCOLOR#FROMUSER 
	     GETCOLOR#FROMSCREEN DISPLAYCOLORLEVEL FILLINREGION AREAFILL CENTEREDLEFT OUTLINEAREA 
	     OUTLINEREGION SHOWCOLORTESTPATTERN SHOWCOLORBLOCKS MAPOFACOLOR)
	(VARS EditColorMapHeight EditColorMapWidth (COLOR#MENUSAVE)
	      (CONTROLMENUSAVE)
	      (EDIT8BITCOLORMAPMENU)
	      (EDIT8BITCOLORMAPNUMBERREADER))
	(GLOBALVARS COLOR#MENUSAVE CONTROLMENUSAVE EDIT8BITCOLORMAPMENU EDIT8BITCOLORMAPNUMBERREADER 
		    EditColorMapHeight EditColorMapWidth)
	(COMS (* * support for global naming and querying of colors.)
	      (FNS CNSMENUINIT CNSTOCSL CNSTORGB CSLTOCNS DICOLOR.FROM.USER GETCNS HLSTOCSL CSLTOHLS 
		   RGBTOCNS)
	      (VARS DICOLOR.hueMapping DICOLOR.lightnessMapping DICOLOR.saturationMapping 
		    NEWCOLORITEM)
	      (INITVARS (COLORNAMEMENU))
	      (FNS DICOLOR.hueN DICOLOR.hueNvalue DICOLOR.hueNname DICOLOR.lightnessN 
		   DICOLOR.lightnessNvalue DICOLOR.lightnessNname DICOLOR.saturationN 
		   DICOLOR.saturationNvalue DICOLOR.saturationNname)
	      (DECLARE: EVAL@LOAD DONTCOPY (*)
			(RECORDS hueRecord lightnessRecord saturationRecord)
			(CONSTANTS * DICOLOR.hueConstants)
			(CONSTANTS * DICOLOR.saturationConstants)
			(CONSTANTS * DICOLOR.lightnessConstants))
	      (P (CNSMENUINIT)))
	(FILES LLCOLOR READNUMBER)))
(DEFINEQ

(DISPLAYCOLORLEVELS
  [LAMBDA (WIN)                                              (* rrb "25-OCT-82 13:58")
    (DISPLAYCOLORLEVEL (QUOTE RED)
		       NIL WIN)
    (DISPLAYCOLORLEVEL (QUOTE GREEN)
		       NIL WIN)
    (DISPLAYCOLORLEVEL (QUOTE BLUE)
		       NIL WIN])

(DISPLAYHLSLEVEL
  [LAMBDA (HLS WHICHHLS NEWLEVEL WINDOW)                     (* rrb "25-OCT-82 16:28")
    (PROG [(REGION (SELECTQ WHICHHLS
			    (HUE HUEREGION)
			    (LIGHTNESS LIGHTNESSREGION)
			    (SATURATION SATURATIONREGION)
			    (\ILLEGAL.ARG WHICHHLS]
          (MOVETO (fetch LEFT of REGION)
		  VALBTM WINDOW)                             (* if there is a new level given, set it.)
          (AND NEWLEVEL (HLSLEVEL HLS WHICHHLS NEWLEVEL))    (* overstrike extra digits in case the old value was 
							     larger.)
          (COND
	    ((FIXP (SETQ NEWLEVEL (HLSLEVEL HLS WHICHHLS)))
	      (PRIN1 NEWLEVEL WINDOW)
	      (PRIN1 "   " WINDOW))
	    (T (printout WINDOW .F5.3 NEWLEVEL)))
          (FILLINREGION REGION (LEVELFROMHLSVALUE WHICHHLS NEWLEVEL)
			GRAYSHADE WINDOW])

(DISPLAYHLSLEVELS
  [LAMBDA (HLS WIN)                                          (* rrb "25-OCT-82 14:08")
                                                             (* displays a hue lightness saturation triple in the 
							     edit window.)
    (DISPLAYHLSLEVEL HLS (QUOTE HUE)
		     NIL WIN)
    (DISPLAYHLSLEVEL HLS (QUOTE LIGHTNESS)
		     NIL WIN)
    (DISPLAYHLSLEVEL HLS (QUOTE SATURATION)
		     NIL WIN])

(HLSLEVEL
  [LAMBDA (HLS FIELD NEWLEVEL)                               (* rrb "25-OCT-82 13:29")
                                                             (* returns the value of the named field from a hue 
							     lightness saturation record.)
    (SELECTQ FIELD
	     [HUE (PROG1 (fetch (HLS HUE) of HLS)
			 (AND NEWLEVEL (replace (HLS HUE) of HLS with NEWLEVEL]
	     [LIGHTNESS (PROG1 (fetch (HLS LIGHTNESS) of HLS)
			       (AND NEWLEVEL (replace (HLS LIGHTNESS) of HLS with NEWLEVEL]
	     [SATURATION (PROG1 (fetch (HLS SATURATION) of HLS)
				(AND NEWLEVEL (replace (HLS SATURATION) of HLS with NEWLEVEL]
	     (SHOULDNT])

(HLSTORGB
  [LAMBDA (HLS)                                              (* rrb "25-OCT-82 16:21")

          (* converts from a hue saturation lightness triple into red green blue triple. HUE is in range 0 to 360, lightness
	  and saturation are in the range 0 to 1.0 NIL)

                                                             (* this algorithm was taken from siggraph vol 13 number 
							     3 August 1979: Status report on graphics standards 
							     planning committee.)
    (PROG ((H (fetch (HLS HUE) of HLS))
	   (L (fetch (HLS LIGHTNESS) of HLS))
	   (S (fetch (HLS SATURATION) of HLS))
	   Max Min)
          [SETQ Max (COND
	      ((FGREATERP .5 L)
		(FTIMES L (FPLUS 1.0 S)))
	      (T (FDIFFERENCE (FPLUS L S)
			      (FTIMES L S]
          (SETQ Min (FDIFFERENCE (FTIMES L 2)
				 Max))
          (RETURN (create RGB
			  RED ←(HLSVALUEFN Min Max H)
			  GREEN ←(HLSVALUEFN Min Max (IDIFFERENCE H 120))
			  BLUE ←(HLSVALUEFN Min Max (IDIFFERENCE H 240])

(HLSVALUEFN
  [LAMBDA (MIN MAX HUE)                                      (* rrb "25-OCT-82 10:47")
                                                             (* internal value function for converting from HLS to 
							     RGB.)
    [COND
      ((ILESSP HUE 0)
	(SETQ HUE (IPLUS HUE 360]
    (FIX (FTIMES (COND
		   ((ILESSP HUE 60)
		     (FPLUS MIN (FQUOTIENT (FTIMES (FDIFFERENCE MAX MIN)
						   HUE)
					   60)))
		   ((ILESSP HUE 180)
		     MAX)
		   ((ILESSP HUE 240)
		     (FPLUS MIN (FQUOTIENT (FTIMES (FDIFFERENCE MAX MIN)
						   (FDIFFERENCE 240 HUE))
					   60)))
		   (T MIN))
		 255])

(HLSVALUEFROMLEVEL
  [LAMBDA (HLS LEVEL)                                        (* rrb "25-OCT-82 13:26")
                                                             (* returns the scaled value of the hls marker on a scale
							     from 0 to 255)
    (SELECTQ HLS
	     (HUE (IQUOTIENT (ITIMES LEVEL 360)
			     255))
	     (FQUOTIENT LEVEL 255])

(LEVELFROMHLSVALUE
  [LAMBDA (HLS LEVEL)                                        (* rrb "25-OCT-82 14:06")
                                                             (* returns the level on a scale from 0 to 255 that this 
							     value would have.)
    (SELECTQ HLS
	     (HUE (IQUOTIENT (ITIMES LEVEL 255)
			     360))
	     (FIX (FTIMES LEVEL 255])

(RAINBOWMAP
  [LAMBDA (NBITS)                                            (* rrb "21-OCT-82 18:14")
    [OR NBITS (NULL (COLORDISPLAYP))
	(SETQ NBITS (COLORMAPBITS (SCREENCOLORMAP]
    (COLORMAPCREATE (COND
		      [(EQ NBITS 8)
			(PROG ((MAXINTENSITY 255)
			       (MINVISIBLERED 69)
			       (MINVISIBLEBLUE 38)
			       (MINVISIBLEGREEN 38)
			       (NSTEPS (IQUOTIENT (EXPT 2 NBITS)
						  8))
			       REDSTEPSIZE GREENSTEPSIZE BLUESTEPSIZE)

          (* determine how many steps are available for each transition from one color to the next. There are 8 such 
	  transitions. red up, green up, red down, blue up, green down, red up, green up, all down)



          (* minimum visible intensity values were emperically determined but will differ depending upon the brightness 
	  setting of the individual display. They are also diddled to make the numer of steps come out right.)


			      (RETURN (NCONC (for I from MINVISIBLERED to MAXINTENSITY
						by (SETQ REDSTEPSIZE (IQUOTIENT (IPLUS (IDIFFERENCE
											 MAXINTENSITY 
										    MINVISIBLERED)
										       NSTEPS -2)
										NSTEPS))
						collect      (* red up)
							(LIST I 0 0))
					     (for I from MINVISIBLEGREEN to MAXINTENSITY
						by (SETQ GREENSTEPSIZE
						     (IQUOTIENT (IPLUS (IDIFFERENCE MAXINTENSITY 
										  MINVISIBLEGREEN)
								       -1 NSTEPS)
								NSTEPS))
						collect      (* GREEN UP)
							(LIST 255 I 0))
					     (for I from REDSTEPSIZE to (IDIFFERENCE MAXINTENSITY 
										    MINVISIBLERED)
						by REDSTEPSIZE collect 
                                                             (* red down)
								       (LIST (IDIFFERENCE 
										     MAXINTENSITY I)
									     255 0))
					     (CONS (QUOTE (0 255 0)))
					     (for I from MINVISIBLEBLUE to MAXINTENSITY
						by (SETQ BLUESTEPSIZE (IQUOTIENT (IPLUS (IDIFFERENCE
											  
										     MAXINTENSITY 
										   MINVISIBLEBLUE)
											-1 NSTEPS)
										 NSTEPS))
						collect      (* BLUE UP)
							(LIST 0 255 I))
					     (for I from GREENSTEPSIZE to (IDIFFERENCE MAXINTENSITY 
										  MINVISIBLEGREEN)
						by GREENSTEPSIZE collect 
                                                             (* GREEN down)
									 (LIST 0 (IDIFFERENCE 
										     MAXINTENSITY I)
									       255))
					     (CONS (QUOTE (0 0 255)))
					     (for I from MINVISIBLERED to MAXINTENSITY by REDSTEPSIZE
						collect      (* red up)
							(LIST I 0 255))
					     (for I from MINVISIBLEGREEN to MAXINTENSITY
						by GREENSTEPSIZE collect 
                                                             (* GREEN UP)
									 (LIST 255 I 255))
					     (for I from GREENSTEPSIZE to (IDIFFERENCE MAXINTENSITY 
										  MINVISIBLEGREEN)
						by GREENSTEPSIZE collect 
                                                             (* all down)
									 (LIST (IDIFFERENCE 
										     MAXINTENSITY I)
									       (IDIFFERENCE 
										     MAXINTENSITY I)
									       (IDIFFERENCE 
										     MAXINTENSITY I)))
					     (CONS (QUOTE (0 0 0]
		      (T RAINBOWINTENSITIES))
		    NBITS])

(RGBTOHLS
  [LAMBDA (RGB GREEN BLUE)                                   (* rrb "25-OCT-82 13:18")
                                                             (* converts from a red green blue triple of color 
							     information into a hue lightness saturation triple.)
                                                             (* this algorithm was taken from siggraph vol 13 number 
							     3 August 1979: Status report on graphics standards 
							     planning committee.)
    (PROG ((RED (COND
		  ((LISTP RGB)
		    (fetch (RGB RED) of RGB))
		  (T RGB)))
	   (GREEN (COND
		    ((LISTP RGB)
		      (fetch (RGB GREEN) of RGB))
		    (T GREEN)))
	   (BLUE (COND
		   ((LISTP RGB)
		     (fetch (RGB BLUE) of RGB))
		   (T BLUE)))
	   R G B MAX MIN L)
          (SETQ MAX (MAX RED GREEN BLUE))
          (SETQ MIN (MIN RED GREEN BLUE))
          (RETURN (COND
		    ((EQ MAX MIN)
		      (create HLS
			      HUE ← 0
			      LIGHTNESS ←(FQUOTIENT MAX 255.0)
			      SATURATION ← 0.0))
		    (T (SETQ R (FQUOTIENT (IDIFFERENCE MAX RED)
					  (IDIFFERENCE MAX MIN)))
		       (SETQ G (FQUOTIENT (IDIFFERENCE MAX GREEN)
					  (IDIFFERENCE MAX MIN)))
		       (SETQ B (FQUOTIENT (IDIFFERENCE MAX BLUE)
					  (IDIFFERENCE MAX MIN)))
		       (create HLS
			       HUE ←(IMOD (FIX (FTIMES [COND
							 ((EQ MAX RED)
							   (FPLUS 2.0 (FDIFFERENCE B G)))
							 ((EQ MAX GREEN)
							   (FPLUS 4.0 (FDIFFERENCE R B)))
							 (T (FPLUS 6.0 (FDIFFERENCE G R]
						       60.0))
					  360)
			       LIGHTNESS ←(FQUOTIENT (SETQ L (FQUOTIENT (FPLUS MIN MAX)
									2))
						     255)
			       SATURATION ←(COND
				 ((FGREATERP .5 L)
				   (FQUOTIENT (IDIFFERENCE MAX MIN)
					      (IPLUS MAX MIN)))
				 (T (FQUOTIENT (IDIFFERENCE MAX MIN)
					       (IDIFFERENCE 510 (IPLUS MAX MIN])
)
(DEFINEQ

(OVERPAINT
  [LAMBDA (BM1 BM2 X Y TXT SCR)                              (* rrb "21-DEC-82 22:16")
                                                             (* Uses BM1 as a mask thru which it paints the INVERSE 
							     of texture onto BM2 at position X Y)
    (PROG ((BMW (BITMAPWIDTH BM1))
	   (BMH (fetch BITMAPHEIGHT of BM1)))
          (OR SCR (SETQ SCR (BITMAPCOPY BM1)))               (* We need a scratch BM. Most demos cache one)
          (BITBLT BM1 0 0 SCR 0 0 BMW BMH (QUOTE INPUT)
		  (QUOTE REPLACE))
          (BITBLT NIL NIL NIL SCR 0 0 BMW BMH (QUOTE TEXTURE)
		  (QUOTE ERASE)
		  TXT)
          (BITBLT BM1 0 0 BM2 X Y BMW BMH (QUOTE INPUT)
		  (QUOTE ERASE))
          (BITBLT SCR 0 0 BM2 X Y BMW BMH (QUOTE INPUT)
		  (QUOTE PAINT])

(BITMAPFROMSTRING
  [LAMBDA (STR FONT)                                         (* rrb "17-DEC-82 13:16")
    (OR STR (SETQ STR "Interlisp-D"))
    [OR (FONTP FONT)
	(SETQ FONT (FONTCREATE (QUOTE TIMESROMAND)
			       (QUOTE 36]
    (PROG ((SCR (DSPCREATE))
	   (SW (STRINGWIDTH STR FONT))
	   (FH (FONTPROP FONT (QUOTE HEIGHT)))
	   BM)
          (SETQ BM (BITMAPCREATE SW FH))
          (DSPDESTINATION BM SCR)
          (DSPFONT FONT SCR)
          (MOVETO 0 (FONTPROP FONT (QUOTE DESCENT))
		  SCR)
          (PRIN3 STR SCR)
          (RETURN BM])

(SHADEBITMAP
  [LAMBDA (BM T0 T1)                                         (* bas: "25-APR-82 15:02")
                                                             (* Shades bitmap BM with T0 into 0 areas and T1 into 1 
							     areas)
    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    (LOGAND T0 (LOGXOR T0 T1)))
    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE PAINT)
	    (LOGAND T0 T1))
    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE ERASE)
	    (LOGXOR (LOGOR T0 T1)
		    65535])
)
(DEFINEQ

(EDITCOLORMAP
  [LAMBDA (VAR NOQFLG)                                       (* rrb "21-OCT-82 18:15")
                                                             (* edits a color map.)
    (RESETLST (PROG (CM)
		    [COND
		      ((COLORMAPP VAR)
			(SETQ CM VAR))
		      [(LITATOM VAR)
			(COND
			  ([COLORMAPP (SETQ CM (EVALV VAR (QUOTE EDITCOLORMAP]
                                                             (* use value.)
			    )
			  (T (SETQ CM (COLORMAPCREATE]
		      (T                                     (* otherwise create a colormap)
			 (SETQ CM (COLORMAPCREATE]
		    [COND
		      ((COLORDISPLAYP)                       (* colordisplay is on, ask if use want test pattern)
			[COND
			  ([AND (NOT NOQFLG)
				(ASKUSER NIL NIL
					 (QUOTE (Would you like a test pattern on the color screen 
						       while you are editting))
					 (QUOTE ((Y "es
" RETURN T)
						  (N "o
" RETURN NIL]                                                (* if so, put up the test pattern and make the colormap 
							     being editted the one used in the display.)
			    (COND
			      ((EQ (COLORMAPBITS (SCREENCOLORMAP))
				   8)                        (* if * bit mode, put up blocks)
				(SHOWCOLORBLOCKS))
			      (T (SHOWCOLORTESTPATTERN]      (* and make the editted colormap be the screencolormap)
			(RESETSAVE (SCREENCOLORMAP CM]
		    (RETURN (COND
			      ((EDITCOLORMAP1 CM)
				[COND
				  ((AND VAR (LITATOM VAR))   (* set the variable.)
				    (STKEVAL (QUOTE EDITCOLORMAP)
					     (LIST (QUOTE SAVESET)
						   (KWOTE VAR)
						   (KWOTE CM]
				CM])

(ADJUSTCOLORMAP
  [LAMBDA (PRIMARY DELTA COLORMAP)                           (* rrb "16-NOV-82 15:05")
                                                             (* adds DELTA points of intensity to all values of 
							     PRIMARY color in COLORMAP.)
    (PROG [(CM (OR COLORMAP (SCREENCOLORMAP]
          [for I from 1 to (MAXIMUMCOLOR CM)
	     do (COLORLEVEL CM I PRIMARY (IMIN 255 (IMAX 0 (IPLUS (COLORLEVEL CM I PRIMARY)
								  DELTA]
          (RETURN CM])

(EDITCOLORMAP1
  [LAMBDA (CM)                                               (* rrb "25-OCT-82 15:47")
                                                             (* displays a colormap in a window and allows the user 
							     to change it.)
    (PROG ((WIN (PROGN (PROMPTPRINT "Select location of colormap editting window")
		       (CREATEW (GETBOXREGION EditColorMapWidth EditColorMapHeight)
				"ColorMap editor")))
	   XPOS REDREGION GREENREGION BLUEREGION HUEREGION LIGHTNESSREGION SATURATIONREGION SETBTM)
          (CLRPROMPT)
          (WINDOWPROP WIN (QUOTE COLORMAP)
		      CM)
          (MOVETO 35 4 WIN)
          (SETQ XPOS (DSPXPOSITION NIL WIN))
          (PRIN1 "RED" WIN)
          (OUTLINEREGION (SETQ REDREGION (create REGION
						 LEFT ←(CENTEREDLEFT 10 XPOS (SETQ XPOS
								       (DSPXPOSITION NIL WIN)))
						 BOTTOM ←(SETQ SETBTM (IDIFFERENCE (DSPYPOSITION
										     NIL WIN)
										   (DSPLINEFEED
										     NIL WIN)))
						 WIDTH ← 10
						 HEIGHT ← 256))
			 2 NIL WIN)
          (MOVETO XPOS 4 WIN)
          (PRIN1 "  " WIN)
          (SETQ XPOS (DSPXPOSITION NIL WIN))
          (PRIN1 "GREEN" WIN)
          (OUTLINEREGION (SETQ GREENREGION (create REGION
						   LEFT ←(CENTEREDLEFT 10 XPOS (SETQ XPOS
									 (DSPXPOSITION NIL WIN)))
						   BOTTOM ← SETBTM
						   WIDTH ← 10
						   HEIGHT ← 256))
			 2 NIL WIN)
          (MOVETO XPOS 4 WIN)
          (PRIN1 "  " WIN)
          (SETQ XPOS (DSPXPOSITION NIL WIN))
          (PRIN1 "BLUE" WIN)
          (OUTLINEREGION (SETQ BLUEREGION (create REGION
						  LEFT ←(CENTEREDLEFT 10 XPOS (SETQ XPOS
									(DSPXPOSITION NIL WIN)))
						  BOTTOM ← SETBTM
						  WIDTH ← 10
						  HEIGHT ← 256))
			 2 NIL WIN)
          (PROGN (MOVETO (IPLUS XPOS 20)
			 4 WIN)
		 (PRIN1 "  " WIN)
		 (SETQ XPOS (DSPXPOSITION NIL WIN))
		 (PRIN1 "hue" WIN)
		 (OUTLINEREGION (SETQ HUEREGION (create REGION
							LEFT ←(CENTEREDLEFT 10 XPOS
									    (SETQ XPOS
									      (DSPXPOSITION NIL WIN)))
							BOTTOM ← SETBTM
							WIDTH ← 10
							HEIGHT ← 256))
				2 NIL WIN))
          (PROGN (MOVETO XPOS 4 WIN)
		 (PRIN1 "  " WIN)
		 (SETQ XPOS (DSPXPOSITION NIL WIN))
		 (PRIN1 "lightness" WIN)
		 (OUTLINEREGION (SETQ LIGHTNESSREGION (create REGION
							      LEFT ←(CENTEREDLEFT 10 XPOS
										  (SETQ XPOS
										    (DSPXPOSITION
										      NIL WIN)))
							      BOTTOM ← SETBTM
							      WIDTH ← 10
							      HEIGHT ← 256))
				2 NIL WIN))
          (PROGN (MOVETO XPOS 4 WIN)
		 (PRIN1 "  " WIN)
		 (SETQ XPOS (DSPXPOSITION NIL WIN))
		 (PRIN1 " sat " WIN)
		 (OUTLINEREGION (SETQ SATURATIONREGION (create REGION
							       LEFT ←(CENTEREDLEFT 10 XPOS
										   (DSPXPOSITION
										     NIL WIN))
							       BOTTOM ← SETBTM
							       WIDTH ← 10
							       HEIGHT ← 256))
				2 NIL WIN))
          (PROMPTPRINT 

"Left in rectangle sets the corresponding level.
Middle button in window brings up color number selection menu.
Middle in title brings up control menu (to STOP).")
          (EDITCOLORMAP2 WIN)
          (CLRPROMPT)
          (CLOSEW WIN)
          (RETURN CM])

(EDITCOLORMAP2
  [LAMBDA (WIN)                                              (* hdj "19-Jun-85 17:27")
                                                             (* internal function to EDITCOLORMAP which polls mouse 
							     and updates fields.)
    (PROG ((COLOR# 0)
	   (VALBTM (IPLUS (fetch (REGION BOTTOM) of REDREGION)
			  264))
	   COLOR#MENU CONTROLMENU (COLORMAP (WINDOWPROP WIN (QUOTE COLORMAP)))
	   LEVEL LASTX LASTY HLS)
          (COND
	    [(type? 4BITCOLORMAP COLORMAP)
	      [SETQ COLOR#MENU
		(COND
		  ((TYPENAMEP COLOR#MENUSAVE (QUOTE MENU))
		    COLOR#MENUSAVE)
		  (T (SETQ COLOR#MENUSAVE
		       (create MENU
			       ITEMS ←(QUOTE (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
			       MENUROWS ← 2
			       CENTERFLG ← T
			       CHANGEOFFSETFLG ← T]
	      (SETQ CONTROLMENU (COND
		  ((TYPENAMEP CONTROLMENUSAVE (QUOTE MENU))
		    CONTROLMENUSAVE)
		  (T (create MENU
			     ITEMS ←(QUOTE ((STOP (QUOTE STOP)
						  "Stops the color map editor.")
					     (PickPt (GETCOLOR#FROMSCREEN)
						     "prompts for a color from the color screen."]
	    [(type? 8BITCOLORMAP COLORMAP)
	      (SETQ CONTROLMENU (SETQ COLOR#MENU (COND
		    ((TYPENAMEP EDIT8BITCOLORMAPMENU (QUOTE MENU))
		      EDIT8BITCOLORMAPMENU)
		    (T (create MENU
			       ITEMS ←(QUOTE ((STOP (QUOTE STOP)
						    "Stops the color map editor.")
					       (Input# (GETCOLOR#FROMUSER)
						       
						  "prompts for a new color number via numberpad.")
					       (PickPt (GETCOLOR#FROMSCREEN)
						       "prompts for a color from the color screen."]
	    (T (SHOULDNT)))
      COLORLP
          (MOVETO 8 250 WIN)
          (printout WIN .I3 COLOR#)                          (* show color number.)
          (DISPLAYCOLORLEVELS WIN)
          (DISPLAYHLSLEVELS [SETQ HLS (RGBTOHLS (COLORLEVEL COLORMAP COLOR# (QUOTE RED))
						(COLORLEVEL COLORMAP COLOR# (QUOTE GREEN))
						(COLORLEVEL COLORMAP COLOR# (QUOTE BLUE]
			    WIN)
      WAITLP
          (GETMOUSESTATE)
          [COND
	    [(LASTMOUSESTATE MIDDLE)
	      (COND
		[(EQ COLOR#MENU CONTROLMENU)                 (* in 8 bit mode, both menus are the same.)
		  (COND
		    ((NUMBERP (SETQ LEVEL (MENU COLOR#MENU)))
		      (SETQ COLOR# LEVEL)
		      (GO COLORLP))
		    ((EQ LEVEL (QUOTE STOP))
		      (RETURN]
		(T (COND
		     ((INSIDEP (DSPCLIPPINGREGION NIL WIN)
			       (LASTMOUSEX WIN)
			       (LASTMOUSEY WIN))             (* cursor is in interior)
		       (AND (SETQ LEVEL (MENU COLOR#MENU))
			    (SETQ COLOR# LEVEL)
			    (GO COLORLP)))
		     ((EQ (SETQ LEVEL (MENU CONTROLMENU))
			  (QUOTE STOP))
		       (RETURN))
		     ((NUMBERP LEVEL)
		       (SETQ COLOR# LEVEL)
		       (GO COLORLP]
	    ((LASTMOUSESTATE RED)
	      (COND
		[[SETQ COLOR (COND
		      ((INSIDEP REDREGION (SETQ LASTX (LASTMOUSEX WIN))
				(SETQ LASTY (LASTMOUSEY WIN)))
			(QUOTE RED))
		      ((INSIDEP GREENREGION LASTX LASTY)
			(QUOTE GREEN))
		      ((INSIDEP BLUEREGION LASTX LASTY)
			(QUOTE BLUE]
		  (until (MOUSESTATE (NOT RED))
		     do                                      (* as long as red is down, adjust the color.)
			(COND
			  ((NEQ [SETQ LEVEL (IMIN 255 (IMAX 0 (IDIFFERENCE (LASTMOUSEY WIN)
									   (fetch (REGION BOTTOM)
									      of REDREGION]
				(COLORLEVEL COLORMAP COLOR# COLOR))
                                                             (* see if color level has changed.)
			    (DISPLAYCOLORLEVEL COLOR LEVEL WIN)
			    (DISPLAYHLSLEVELS [SETQ HLS (RGBTOHLS (COLORLEVEL COLORMAP COLOR#
									      (QUOTE RED))
								  (COLORLEVEL COLORMAP COLOR#
									      (QUOTE GREEN))
								  (COLORLEVEL COLORMAP COLOR#
									      (QUOTE BLUE]
					      WIN]
		([SETQ COLOR (COND
		      ((INSIDEP HUEREGION (SETQ LASTX (LASTMOUSEX WIN))
				(SETQ LASTY (LASTMOUSEY WIN)))
			(QUOTE HUE))
		      ((INSIDEP LIGHTNESSREGION LASTX LASTY)
			(QUOTE LIGHTNESS))
		      ((INSIDEP SATURATIONREGION LASTX LASTY)
			(QUOTE SATURATION]
		  (until (MOUSESTATE (NOT RED))
		     do                                      (* as long as red is down, adjust the color.)
			(COND
			  ((NEQ [SETQ LEVEL (HLSVALUEFROMLEVEL
				    COLOR
				    (IMIN 255 (IMAX 0 (IDIFFERENCE (LASTMOUSEY WIN)
								   (fetch (REGION BOTTOM)
								      of REDREGION]
				(HLSLEVEL HLS COLOR))        (* see if color level has changed.)
			    (DISPLAYHLSLEVEL HLS COLOR LEVEL WIN)
                                                             (* set the color levels of the current color and update
							     that display also.)
			    (for COLOR in (QUOTE (RED GREEN BLUE)) as LEVEL in (HLSTORGB HLS)
			       do (COLORLEVEL COLORMAP COLOR# COLOR LEVEL)
				  (DISPLAYCOLORLEVEL COLOR LEVEL WIN]
          (GO WAITLP])

(GETCOLOR#FROMUSER
  [LAMBDA NIL                                                (* edited: " 8-SEP-82 21:44")
                                                             (* reads a color number from the user.)
    (PROG (RESPONSE)
          (MOVEW [COND
		   ((TYPENAMEP EDIT8BITCOLORMAPNUMBERREADER (QUOTE WINDOW))
		     EDIT8BITCOLORMAPNUMBERREADER)
		   (T (SETQ EDIT8BITCOLORMAPNUMBERREADER
			(CREATE.NUMBERPAD.READER (QUOTE (Enter color number to edit:))
						 (CREATE POSITION
							 XCOORD ← LASTMOUSEX
							 YCOORD ← LASTMOUSEY]
		 (CREATE POSITION
			 XCOORD ← LASTMOUSEX
			 YCOORD ← LASTMOUSEY))
      LP  (COND
	    ([NULL (ERSETQ (SETQ RESPONSE (NUMBERPAD.READ EDIT8BITCOLORMAPNUMBERREADER]
                                                             (* currently there is no way NIL can be returned from 
							     NUMBERPAD.READ but there should be a way to quit.)
	      (RETURN NIL))
	    ((OR (ILESSP RESPONSE 0)
		 (IGREATERP RESPONSE 255))
	      (PROMPTPRINT "Color numbers must be between 0 and 255.")
	      (GO LP))
	    (T (RETURN RESPONSE])

(GETCOLOR#FROMSCREEN
  [LAMBDA NIL                                                (* rrb " 3-NOV-82 13:57")
                                                             (* returns the color number of a point selected by the 
							     user.)
    (RESETFORM (CHANGECURSORSCREEN (COLORSCREENBITMAP))
	       (PROG ((POS (GETPOSITION)))
		     (RETURN (AND POS (BITMAPBIT (COLORSCREENBITMAP)
						 (fetch XCOORD of POS)
						 (fetch YCOORD of POS])

(DISPLAYCOLORLEVEL
  [LAMBDA (PRIMARYCOLOR NEWLEVEL WINDOW)                     (* rrb "25-OCT-82 14:03")
    (PROG [(REGION (SELECTQ PRIMARYCOLOR
			    (RED REDREGION)
			    (BLUE BLUEREGION)
			    (GREEN GREENREGION)
			    (\ILLEGAL.ARG PRIMARYCOLOR]
          (MOVETO (fetch LEFT of REGION)
		  VALBTM WINDOW)                             (* if there is a new level given, set it.)
          (AND NEWLEVEL (COLORLEVEL (WINDOWPROP WIN (QUOTE COLORMAP))
				    COLOR# PRIMARYCOLOR NEWLEVEL))
                                                             (* overstrike extra digits in case the old value was 
							     larger.)
          (PRIN1 (SETQ NEWLEVEL (COLORLEVEL (WINDOWPROP WIN (QUOTE COLORMAP))
					    COLOR# PRIMARYCOLOR))
		 WINDOW)
          (PRIN1 "   " WINDOW)
          (FILLINREGION REGION NEWLEVEL GRAYSHADE WINDOW])

(FILLINREGION
  [LAMBDA (REGION HEIGHT GRAY WINDOW)                        (* rrb "23-FEB-82 12:26")
                                                             (* fills part of a region with gray.)
    (DSPFILL REGION WHITESHADE (QUOTE REPLACE)
	     WINDOW)
    (AREAFILL (fetch (REGION LEFT) of REGION)
	      (fetch (REGION BOTTOM) of REGION)
	      (fetch (REGION WIDTH) of REGION)
	      HEIGHT GRAY (QUOTE REPLACE)
	      WINDOW])

(AREAFILL
  [LAMBDA (LFT BTM WDTH HGTH SHADE OPERATION WINDOW)         (* fills an area of a window with shade.)
    (BITBLT NIL NIL NIL WINDOW LFT BTM WDTH HGTH (QUOTE TEXTURE)
	    OPERATION SHADE])

(CENTEREDLEFT
  [LAMBDA (WIDTH LEFT RIGHT)                                 (* rrb "16-FEB-82 14:58")
                                                             (* returns the left point that would leave WIDTH 
							     centered between LEFT and RIGHT)
    (IQUOTIENT (IDIFFERENCE (IPLUS LEFT RIGHT)
			    WIDTH)
	       2])

(OUTLINEAREA
  [LAMBDA (LFT BTM WDTH HGHT LINEWIDTH OPERATION WIN)        (* rrb "17-FEB-82 10:59")
                                                             (* outlines an area of a window.)
    (PROG (LEFTPLUSWIDTH RIGHTLINELEFT VERTLINETOP TOPY (LINEWIDTH (OR (NUMBERP LINEWIDTH)
								       1)))
          (SETQ LFT (IDIFFERENCE LFT LINEWIDTH))
          (SETQ BTM (IDIFFERENCE BTM LINEWIDTH))
          (SETQ WDTH (IPLUS WDTH (ITIMES LINEWIDTH 2)))
          (SETQ HGHT (IPLUS HGHT (ITIMES LINEWIDTH 2)))
          (DRAWLINE LFT BTM LFT (SETQ VERTLINETOP (SUB1 (IPLUS BTM HGHT)))
		    LINEWIDTH OPERATION WIN)
          (DRAWLINE (SETQ RIGHTLINELEFT (IDIFFERENCE (IPLUS LFT WDTH)
						     LINEWIDTH))
		    BTM RIGHTLINELEFT VERTLINETOP LINEWIDTH OPERATION WIN)
          (DRAWLINE (SETQ LEFTPLUSWIDTH (IPLUS LFT LINEWIDTH))
		    BTM
		    (SETQ RIGHTLINELEFT (SUB1 RIGHTLINELEFT))
		    BTM LINEWIDTH OPERATION WIN)
          (DRAWLINE LEFTPLUSWIDTH (SETQ TOPY (ADD1 (IDIFFERENCE VERTLINETOP LINEWIDTH)))
		    RIGHTLINELEFT TOPY LINEWIDTH OPERATION WIN])

(OUTLINEREGION
  [LAMBDA (REGION OUTLINEWIDTH OPERATION WIN)                (* rrb "17-FEB-82 10:58")
                                                             (* outlines the region REGION with a width wide line)
    (OUTLINEAREA (fetch (REGION LEFT) of REGION)
		 (fetch (REGION BOTTOM) of REGION)
		 (fetch (REGION WIDTH) of REGION)
		 (fetch (REGION HEIGHT) of REGION)
		 OUTLINEWIDTH OPERATION WIN])

(SHOWCOLORTESTPATTERN
  [LAMBDA (SIZE)                                             (* edited: "10-SEP-82 10:07")
                                                             (* put a color test pattern on the display.)
    (COLORFILL WHOLECOLORDISPLAY 0)
    (SELECTQ \COLORDISPLAYBITSPERPIXEL
	     [4 (OR (NUMBERP SIZE)
		    (SETQ SIZE 20))
		(for I from 1 to 7 as LEFT from 90 by 80 do (COLORFILLAREA LEFT 410 60 60 I))
		(for I from 8 to 15 as LEFT from 10 by 80 do (COLORFILLAREA LEFT 330 60 60 I))
		(for HORIZCOLOR from 0 as BOTTOM from 0 to 300 by SIZE
		   do (COND
			((EQ HORIZCOLOR 16)
			  (SETQ HORIZCOLOR 0)))
		      (COLORFILLAREA 0 BOTTOM 640 SIZE HORIZCOLOR (COLORSCREENBITMAP)
				     (QUOTE REPLACE))
		   finally (for VERTCOLOR from 0 as LEFT from 0 to COLORSCREENWIDTH
			      by (ITIMES SIZE 2) do (COND
						      ((EQ VERTCOLOR 16)
							(SETQ VERTCOLOR 0)))
						    (COLORFILLAREA LEFT 0 SIZE BOTTOM VERTCOLOR
								   (COLORSCREENBITMAP)
								   (QUOTE REPLACE]
	     [8 (OR (NUMBERP SIZE)
		    (SETQ SIZE 1))
		(for HORIZCOLOR from 0 as BOTTOM from 0 to COLORSCREENHEIGHT by SIZE
		   do (COND
			((EQ HORIZCOLOR 256)
			  (SETQ HORIZCOLOR 0)))
		      (COLORFILLAREA 0 BOTTOM COLORSCREENWIDTH SIZE HORIZCOLOR (COLORSCREENBITMAP)
				     (QUOTE REPLACE))
		   finally (for VERTCOLOR from 0 as LEFT from 0 to COLORSCREENWIDTH
			      by (ITIMES SIZE 2) do (COND
						      ((EQ VERTCOLOR 256)
							(SETQ VERTCOLOR 0)))
						    (COLORFILLAREA LEFT 0 SIZE BOTTOM VERTCOLOR
								   (COLORSCREENBITMAP)
								   (QUOTE REPLACE]
	     (SHOULDNT])

(SHOWCOLORBLOCKS
  [LAMBDA NIL                                                (* edited: "10-SEP-82 14:38")
                                                             (* puts up color blocks for an 8 bit color display.)
    (bind BOTTOM (WIDTH ←(IQUOTIENT COLORSCREENWIDTH 16))
	  (HEIGHT ←(IQUOTIENT COLORSCREENHEIGHT 16))
	  (COLOR# ← 0) for I from 15 to 0 by -1 do (SETQ BOTTOM (ADD1 (ITIMES HEIGHT I)))
						   (for LEFT from 0 to (IDIFFERENCE COLORSCREENWIDTH 
										    WIDTH)
						      by WIDTH
						      do (COLORFILLAREA LEFT BOTTOM WIDTH HEIGHT 
									COLOR# (COLORSCREENBITMAP))
							 (SETQ COLOR# (ADD1 COLOR#])

(MAPOFACOLOR
  [LAMBDA (PRIMARIES)                                        (* rrb "22-SEP-82 17:06")
    (AND (NLISTP PRIMARIES)
	 (SETQ PRIMARIES (CONS PRIMARIES)))
    (PROG ((MAXCOLOR (MAXIMUMCOLOR))
	   (MINVISIBLEINTENSITY 45))
          (RETURN (COLORMAPCREATE (CONS (QUOTE (0 0 0))
					(for I from 1 to MAXCOLOR bind THISLEVEL
					   collect [SETQ THISLEVEL
						     (COND
						       ((EQ MAXCOLOR 255)
                                                             (* if 255 colors, there is enough for all of them.)
							 I)
						       (T (IPLUS (IQUOTIENT (ITIMES I
										    (IDIFFERENCE
										      255 
									      MINVISIBLEINTENSITY))
									    MAXCOLOR)
								 MINVISIBLEINTENSITY]
						   (LIST (COND
							   ((FMEMB (QUOTE RED)
								   PRIMARIES)
							     THISLEVEL)
							   (T 0))
							 (COND
							   ((FMEMB (QUOTE GREEN)
								   PRIMARIES)
							     THISLEVEL)
							   (T 0))
							 (COND
							   ((FMEMB (QUOTE BLUE)
								   PRIMARIES)
							     THISLEVEL)
							   (T 0])
)

(RPAQQ EditColorMapHeight 315)

(RPAQQ EditColorMapWidth 380)

(RPAQQ COLOR#MENUSAVE NIL)

(RPAQQ CONTROLMENUSAVE NIL)

(RPAQQ EDIT8BITCOLORMAPMENU NIL)

(RPAQQ EDIT8BITCOLORMAPNUMBERREADER NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS COLOR#MENUSAVE CONTROLMENUSAVE EDIT8BITCOLORMAPMENU EDIT8BITCOLORMAPNUMBERREADER 
	    EditColorMapHeight EditColorMapWidth)
)
(* * support for global naming and querying of colors.)

(DEFINEQ

(CNSMENUINIT
  [LAMBDA NIL                                                (* gbn " 9-Aug-85 03:11")
    [SETQ CNSHUEMENU (create MENU
				 ITEMS ←(for I in DICOLOR.hueMapping collect (CAR I]
    [SETQ CNSSATURATIONMENU (create MENU
					ITEMS ←(for I in DICOLOR.saturationMapping
						  collect (CAR I]
    (SETQ CNSLIGHTNESSMENU (create MENU
				       ITEMS ←(for I in DICOLOR.lightnessMapping
						 collect (CAR I])

(CNSTOCSL
  [LAMBDA (hue saturation lightness)                         (* hdj "12-Apr-85 19:01")
    (PROG ((hueAtom (MKATOM hue))
	     (saturationAtom (MKATOM saturation))
	     (lightnessAtom (MKATOM lightness))
	     c s l)
	    (if [NOT (SETQ c (fetch (hueRecord ordering) of (ASSOC hueAtom 
									       DICOLOR.hueMapping]
		then (SETQ c DICOLOR.achromatic))
	    (if (EQ c DICOLOR.achromatic)
		then (SETQ s DICOLOR.noSaturation)
	      else (if [NOT (SETQ s (fetch (saturationRecord ordering)
					       of (ASSOC saturationAtom DICOLOR.saturationMapping]
			 then (SETQ s DICOLOR.vivid)))
	    (SELECTQ hueAtom
		       (Black (SETQ l DICOLOR.black))
		       (White (SETQ l DICOLOR.white))
		       (if [NOT (SETQ l (fetch (lightnessRecord ordering)
						 of (ASSOC lightnessAtom DICOLOR.lightnessMapping]
			   then (SETQ l DICOLOR.medium)))
	    (RETURN (LIST c s l])

(CNSTORGB
  [LAMBDA (saturation lightness hue)                         (* hdj "15-Jul-85 12:33")
    (LET ((CSL (CNSTOCSL hue saturation lightness)))
         (HLSTORGB (APPLY (FUNCTION CSLTOHLS)
			      CSL])

(CSLTOCNS
  [LAMBDA (c s l)                                            (* hdj "15-Jul-85 12:37")
    (PROG (hue saturation lightness)
	    [if (EQ c DICOLOR.achromatic)
		then (SETQ saturation "")
		       [SELECTC l
				  (DICOLOR.black (SETQ hue "Black")
						 (SETQ lightness ""))
				  (DICOLOR.white (SETQ hue "White")
						 (SETQ lightness ""))
				  (PROGN (SETQ hue "Gray")
					   (SETQ lightness (MKSTRING (fetch (lightnessRecord
										    name)
									    of (DICOLOR.lightnessN
										   l]
	      else (SETQ hue (fetch (hueRecord name) of (DICOLOR.hueN c)))
		     (SETQ saturation (fetch (saturationRecord name) of (DICOLOR.saturationN
										s)))
		     (SETQ lightness (fetch (lightnessRecord name) of (DICOLOR.lightnessN
									      l]
	    (RETURN (LIST saturation lightness hue])

(DICOLOR.FROM.USER
  [LAMBDA NIL                                                (* gbn "30-Oct-85 11:28")

          (* * Returns a color, either by its name (which can then be looked up on colornames) or as an RGB triple if it is 
	  not named. Prompts the user first with the global color name menu. She can then choose NEWCOLOR which can be 
	  specified as RGB or CNS)


    (PROG (NAME RGB)                                       (* first try to get a color name)
	    [SETQ NAME (MENU (OR COLORNAMEMENU (SETQ COLORNAMEMENU
					 (create MENU
						   ITEMS ←(CONS NEWCOLORITEM
								  (for ENTRY in COLORNAMES
								     collect (CAR ENTRY]
	    (if (NOT NAME)
		then                                       (* the user clicked outside the menu)
		       (RETURN))
	    (SETQ RGB (SELECTQ NAME
				   (RGB (READCOLOR1 "specify new color"))
				   (CNS (APPLY (FUNCTION CNSTORGB)
						 (GETCNS)))
				   (RETURN NAME)))
	    (if (NOT (SETQ NAME (TTYIN "New color name? ")))
		then                                       (* user decided that she didn't want to name the 
							     color)
		       (RETURN RGB))
	    (push COLORNAMES (CONS (SETQ NAME (CAR NAME))
				       RGB))
	    (SETQ COLORNAMEMENU NIL)                       (* invalidate the menu)
	    (RETURN NAME])

(GETCNS
  [LAMBDA NIL                                                (* gbn " 9-Aug-85 03:13")
    (LIST (MENU CNSLIGHTNESSMENU)
	    (MENU CNSSATURATIONMENU)
	    (MENU CNSHUEMENU])

(HLSTOCSL
  [LAMBDA (hue lightness saturation)                         (* hdj "15-Jul-85 12:14")
    (LET ((ISLHue (FQUOTIENT (MOD (PLUS hue 240)
				    360)
			       360)))
         (PROG (c s l)
	         (for old s from DICOLOR.noSaturation to DICOLOR.vivid
		    do (if (EQ s DICOLOR.vivid)
			     then (RETURN))
			 (if (LEQ saturation (PLUS (DICOLOR.saturationNvalue s)
							 (QUOTIENT (DIFFERENCE
								       (DICOLOR.saturationNvalue
									 (ADD1 s))
								       (DICOLOR.saturationNvalue
									 s))
								     2)))
			     then (RETURN)))
	         [if (EQ s DICOLOR.noSaturation)
		     then (SETQ c DICOLOR.achromatic)
			    (for old l from DICOLOR.black to DICOLOR.white
			       do (if (EQ l DICOLOR.white)
					then (RETURN))
				    (if (LEQ lightness (PLUS (DICOLOR.lightnessNvalue l)
								   (QUOTIENT
								     (DIFFERENCE
								       (DICOLOR.lightnessNvalue
									 (ADD1 l))
								       (DICOLOR.lightnessNvalue
									 l))
								     2)))
					then (RETURN)))
		   else (for old c from DICOLOR.red to DICOLOR.purplishRed
			     do                            (* (HELP c))
				  (if (EQ c DICOLOR.purplishRed)
				      then (if (GREATERP ISLHue
							       (PLUS (DICOLOR.hueNvalue c)
								       (QUOTIENT
									 (DIFFERENCE 1
										       (
										DICOLOR.hueNvalue
											 c))
									 2)))
						 then (SETQ c DICOLOR.red))
					     (RETURN))
				  (if (LEQ ISLHue (PLUS (DICOLOR.hueNvalue c)
							      (QUOTIENT (DIFFERENCE
									    (DICOLOR.hueNvalue
									      (ADD1 c))
									    (DICOLOR.hueNvalue
									      c))
									  2)))
				      then (RETURN)))
			  (for old l from DICOLOR.veryDark to DICOLOR.veryLight
			     do (if (EQ l DICOLOR.veryLight)
				      then (RETURN))
				  (if (LEQ lightness (PLUS (DICOLOR.lightnessNvalue l)
								 (QUOTIENT
								   (DIFFERENCE (
									  DICOLOR.lightnessNvalue
										   (ADD1 l))
										 (
									  DICOLOR.lightnessNvalue
										   l))
								   2)))
				      then (RETURN]
	         (RETURN (LIST c s l])

(CSLTOHLS
  [LAMBDA (c s l)                                            (* hdj "15-Jul-85 12:23")
    (PROG (hue saturation lightness)
	    (if (EQ c DICOLOR.achromatic)
		then (SETQ hue 0.0)
		       (SETQ saturation 0.0)
		       (SETQ lightness (DICOLOR.lightnessNvalue l))
	      else (SETQ hue (DICOLOR.hueNvalue c))
		     (SETQ saturation (DICOLOR.saturationNvalue s))
		     (SETQ lightness (DICOLOR.lightnessNvalue l)))
	    (RETURN (LIST (MOD (FPLUS 120 (FTIMES hue 360))
				   360)
			      lightness saturation])

(RGBTOCNS
  [LAMBDA (Red Green Blue)                                   (* hdj "15-Jul-85 12:36")
    (APPLY (FUNCTION CSLTOCNS)
	     (APPLY (FUNCTION HLSTOCSL)
		      (RGBTOHLS Red Green Blue])
)

(RPAQQ DICOLOR.hueMapping ((Achromatic 0.0 -1)
			     (Red 0.0 0)
			     (OrangishRed .01 1)
			     (RedOrange .02 2)
			     (ReddishOrange .03 3)
			     (Orange .04 4)
			     (YellowishOrange .07 5)
			     (OrangeYellow .1 6)
			     (OrangishYellow .13 7)
			     (Yellow .1673 8)
			     (GreenishYellow .2073 9)
			     (YellowGreen .2473 10)
			     (YellowishGreen .2873 11)
			     (Green .3333 12)
			     (BluishGreen .4133 13)
			     (GreenBlue .4933 14)
			     (GreenishBlue .5733 15)
			     (Blue .6666 16)
			     (PurplishBlue .6816 17)
			     (BluePurple .6966 18)
			     (BluishPurple .7116 19)
			     (Purple .73 20)
			     (ReddishPurple .8 21)
			     (PurpleRed .87 22)
			     (PurplishRed .94 23)
			     (BrownishRed .01 24)
			     (RedBrown .02 25)
			     (ReddishBrown .03 26)
			     (Brown .04 27)
			     (YellowishBrown .07 28)
			     (BrownYellow .1 29)
			     (BrownishYellow .13 30)))

(RPAQQ DICOLOR.lightnessMapping ((Black 0.0 0)
				   (VeryDark .1666 1)
				   (Dark .3333 2)
				   (Medium .5 3)
				   (Light .6666 4)
				   (VeryLight .8333 5)
				   (White 1.0 6)))

(RPAQQ DICOLOR.saturationMapping ((NoSaturation 0.0 0)
				    (Grayish .25 1)
				    (Moderate .5 2)
				    (Strong .75 3)
				    (Vivid 1.0 4)))

(RPAQQ NEWCOLORITEM (New% Color (QUOTE CNS)
				  "Allows specification of a new color"
				  (SUBITEMS (RGB (QUOTE RGB)
						 "Specify a new color using Red, Green, Blue sliders")
					    (CNS (QUOTE CNS)
						 "Specify a new color using English"))))

(RPAQ? COLORNAMEMENU )
(DEFINEQ

(DICOLOR.hueN
  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:38")
    (DECLARE (GLOBALVARS DICOLOR.hueMapping))
    (for ELT in DICOLOR.hueMapping suchthat (EQ (fetch (hueRecord ordering) of ELT)
							N])

(DICOLOR.hueNvalue
  [LAMBDA (N)                                                (* hdj "18-Apr-85 09:58")
    (fetch (hueRecord value) of (DICOLOR.hueN N])

(DICOLOR.hueNname
  [LAMBDA (N)                                                (* hdj "18-Apr-85 10:07")
    (fetch (hueRecord name) of (DICOLOR.hueN N])

(DICOLOR.lightnessN
  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:40")
    (DECLARE (GLOBALVARS DICOLOR.lightnessMapping))
    (for ELT in DICOLOR.lightnessMapping suchthat (EQ (fetch (lightnessRecord ordering)
								 of ELT)
							      N])

(DICOLOR.lightnessNvalue
  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:36")
    (fetch (lightnessRecord value) of (DICOLOR.lightnessN N])

(DICOLOR.lightnessNname
  [LAMBDA (N)                                                (* hdj "17-Apr-85 14:02")
    (fetch (lightnessRecord name) of (DICOLOR.lightnessN N])

(DICOLOR.saturationN
  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:39")
    (DECLARE (GLOBALVARS DICOLOR.saturationMapping))
    (for ELT in DICOLOR.saturationMapping suchthat (EQ (fetch (saturationRecord ordering)
								  of ELT)
							       N])

(DICOLOR.saturationNvalue
  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:36")
    (fetch (saturationRecord value) of (DICOLOR.saturationN N])

(DICOLOR.saturationNname
  [LAMBDA (N)                                                (* hdj "17-Apr-85 14:02")
    (fetch (saturationRecord name) of (DICOLOR.saturationN N])
)
(DECLARE: EVAL@LOAD DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD hueRecord (name value ordering))

(RECORD lightnessRecord (name value ordering))

(RECORD saturationRecord (name value ordering))
]


(RPAQQ DICOLOR.hueConstants (DICOLOR.achromatic DICOLOR.blue DICOLOR.bluePurple DICOLOR.bluishGreen 
						  DICOLOR.bluishPurple DICOLOR.brown 
						  DICOLOR.brownYellow DICOLOR.brownishRed 
						  DICOLOR.brownishYellow DICOLOR.green 
						  DICOLOR.greenBlue DICOLOR.greenishBlue 
						  DICOLOR.greenishYellow DICOLOR.orange 
						  DICOLOR.orangeYellow DICOLOR.orangishRed 
						  DICOLOR.orangishYellow DICOLOR.purple 
						  DICOLOR.purpleRed DICOLOR.purplishBlue 
						  DICOLOR.purplishRed DICOLOR.red DICOLOR.redBrown 
						  DICOLOR.redOrange DICOLOR.reddishBrown 
						  DICOLOR.reddishOrange DICOLOR.reddishPurple 
						  DICOLOR.yellow DICOLOR.yellowGreen 
						  DICOLOR.yellowishBrown DICOLOR.yellowishGreen 
						  DICOLOR.yellowishOrange))
(DECLARE: EVAL@COMPILE 

(RPAQQ DICOLOR.achromatic -1)

(RPAQQ DICOLOR.blue 16)

(RPAQQ DICOLOR.bluePurple 18)

(RPAQQ DICOLOR.bluishGreen 13)

(RPAQQ DICOLOR.bluishPurple 19)

(RPAQQ DICOLOR.brown 27)

(RPAQQ DICOLOR.brownYellow 29)

(RPAQQ DICOLOR.brownishRed 24)

(RPAQQ DICOLOR.brownishYellow 30)

(RPAQQ DICOLOR.green 12)

(RPAQQ DICOLOR.greenBlue 14)

(RPAQQ DICOLOR.greenishBlue 15)

(RPAQQ DICOLOR.greenishYellow 9)

(RPAQQ DICOLOR.orange 4)

(RPAQQ DICOLOR.orangeYellow 6)

(RPAQQ DICOLOR.orangishRed 1)

(RPAQQ DICOLOR.orangishYellow 7)

(RPAQQ DICOLOR.purple 20)

(RPAQQ DICOLOR.purpleRed 22)

(RPAQQ DICOLOR.purplishBlue 17)

(RPAQQ DICOLOR.purplishRed 23)

(RPAQQ DICOLOR.red 0)

(RPAQQ DICOLOR.redBrown 25)

(RPAQQ DICOLOR.redOrange 2)

(RPAQQ DICOLOR.reddishBrown 26)

(RPAQQ DICOLOR.reddishOrange 3)

(RPAQQ DICOLOR.reddishPurple 21)

(RPAQQ DICOLOR.yellow 8)

(RPAQQ DICOLOR.yellowGreen 10)

(RPAQQ DICOLOR.yellowishBrown 28)

(RPAQQ DICOLOR.yellowishGreen 11)

(RPAQQ DICOLOR.yellowishOrange 5)

(CONSTANTS DICOLOR.achromatic DICOLOR.blue DICOLOR.bluePurple DICOLOR.bluishGreen 
	   DICOLOR.bluishPurple DICOLOR.brown DICOLOR.brownYellow DICOLOR.brownishRed 
	   DICOLOR.brownishYellow DICOLOR.green DICOLOR.greenBlue DICOLOR.greenishBlue 
	   DICOLOR.greenishYellow DICOLOR.orange DICOLOR.orangeYellow DICOLOR.orangishRed 
	   DICOLOR.orangishYellow DICOLOR.purple DICOLOR.purpleRed DICOLOR.purplishBlue 
	   DICOLOR.purplishRed DICOLOR.red DICOLOR.redBrown DICOLOR.redOrange DICOLOR.reddishBrown 
	   DICOLOR.reddishOrange DICOLOR.reddishPurple DICOLOR.yellow DICOLOR.yellowGreen 
	   DICOLOR.yellowishBrown DICOLOR.yellowishGreen DICOLOR.yellowishOrange)
)


(RPAQQ DICOLOR.saturationConstants (DICOLOR.noSaturation DICOLOR.grayish DICOLOR.moderate 
							   DICOLOR.strong DICOLOR.vivid))
(DECLARE: EVAL@COMPILE 

(RPAQQ DICOLOR.noSaturation 0)

(RPAQQ DICOLOR.grayish 1)

(RPAQQ DICOLOR.moderate 2)

(RPAQQ DICOLOR.strong 3)

(RPAQQ DICOLOR.vivid 4)

(CONSTANTS DICOLOR.noSaturation DICOLOR.grayish DICOLOR.moderate DICOLOR.strong DICOLOR.vivid)
)


(RPAQQ DICOLOR.lightnessConstants (DICOLOR.black DICOLOR.veryDark DICOLOR.dark DICOLOR.medium 
						   DICOLOR.light DICOLOR.veryLight DICOLOR.white))
(DECLARE: EVAL@COMPILE 

(RPAQQ DICOLOR.black 0)

(RPAQQ DICOLOR.veryDark 1)

(RPAQQ DICOLOR.dark 2)

(RPAQQ DICOLOR.medium 3)

(RPAQQ DICOLOR.light 4)

(RPAQQ DICOLOR.veryLight 5)

(RPAQQ DICOLOR.white 6)

(CONSTANTS DICOLOR.black DICOLOR.veryDark DICOLOR.dark DICOLOR.medium DICOLOR.light DICOLOR.veryLight 
	   DICOLOR.white)
)
)
(CNSMENUINIT)
(FILESLOAD LLCOLOR READNUMBER)
(PUTPROPS COLOR COPYRIGHT ("Xerox Corporation" 1982 1983 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1856 11813 (DISPLAYCOLORLEVELS 1866 . 2155) (DISPLAYHLSLEVEL 2157 . 3001) (
DISPLAYHLSLEVELS 3003 . 3449) (HLSLEVEL 3451 . 4166) (HLSTORGB 4168 . 5216) (HLSVALUEFN 5218 . 5843) (
HLSVALUEFROMLEVEL 5845 . 6212) (LEVELFROMHLSVALUE 6214 . 6587) (RAINBOWMAP 6589 . 9936) (RGBTOHLS 9938
 . 11811)) (11814 13760 (OVERPAINT 11824 . 12613) (BITMAPFROMSTRING 12615 . 13174) (SHADEBITMAP 13176
 . 13758)) (13761 33096 (EDITCOLORMAP 13771 . 15415) (ADJUSTCOLORMAP 15417 . 15919) (EDITCOLORMAP1 
15921 . 19148) (EDITCOLORMAP2 19150 . 24487) (GETCOLOR#FROMUSER 24489 . 25593) (GETCOLOR#FROMSCREEN 
25595 . 26076) (DISPLAYCOLORLEVEL 26078 . 26952) (FILLINREGION 26954 . 27432) (AREAFILL 27434 . 27642)
 (CENTEREDLEFT 27644 . 27989) (OUTLINEAREA 27991 . 29074) (OUTLINEREGION 29076 . 29531) (
SHOWCOLORTESTPATTERN 29533 . 31315) (SHOWCOLORBLOCKS 31317 . 32012) (MAPOFACOLOR 32014 . 33094)) (
33553 41310 (CNSMENUINIT 33563 . 34063) (CNSTOCSL 34065 . 35110) (CNSTORGB 35112 . 35346) (CSLTOCNS 
35348 . 36299) (DICOLOR.FROM.USER 36301 . 37758) (GETCNS 37760 . 37966) (HLSTOCSL 37968 . 40473) (
CSLTOHLS 40475 . 41083) (RGBTOCNS 41085 . 41308)) (42888 44965 (DICOLOR.hueN 42898 . 43179) (
DICOLOR.hueNvalue 43181 . 43356) (DICOLOR.hueNname 43358 . 43531) (DICOLOR.lightnessN 43533 . 43853) (
DICOLOR.lightnessNvalue 43855 . 44048) (DICOLOR.lightnessNname 44050 . 44241) (DICOLOR.saturationN 
44243 . 44569) (DICOLOR.saturationNvalue 44571 . 44767) (DICOLOR.saturationNname 44769 . 44963)))))
STOP