(FILECREATED " 2-Jul-85 12:14:03" {ERIS}<LISPCORE>LIBRARY>COLOR.;3 32967  

      changes to:  (FNS EDITCOLORMAP2)

      previous date: "19-Jun-85 17:53:13" {ERIS}<LISPCORE>LIBRARY>COLOR.;2)


(* 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)
	(FILES LLCOLOR)
	(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	       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)
)
(FILESLOAD LLCOLOR)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   READNUMBER)
(PUTPROPS COLOR COPYRIGHT ("Xerox Corporation" 1982 1983 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1156 11113 (DISPLAYCOLORLEVELS 1166 . 1455) (DISPLAYHLSLEVEL 1457 . 2301) (
DISPLAYHLSLEVELS 2303 . 2749) (HLSLEVEL 2751 . 3466) (HLSTORGB 3468 . 4516) (HLSVALUEFN 4518 . 5143) (
HLSVALUEFROMLEVEL 5145 . 5512) (LEVELFROMHLSVALUE 5514 . 5887) (RAINBOWMAP 5889 . 9236) (RGBTOHLS 9238
 . 11111)) (11114 13060 (OVERPAINT 11124 . 11913) (BITMAPFROMSTRING 11915 . 12474) (SHADEBITMAP 12476
 . 13058)) (13061 32396 (EDITCOLORMAP 13071 . 14715) (ADJUSTCOLORMAP 14717 . 15219) (EDITCOLORMAP1 
15221 . 18448) (EDITCOLORMAP2 18450 . 23787) (GETCOLOR#FROMUSER 23789 . 24893) (GETCOLOR#FROMSCREEN 
24895 . 25376) (DISPLAYCOLORLEVEL 25378 . 26252) (FILLINREGION 26254 . 26732) (AREAFILL 26734 . 26942)
 (CENTEREDLEFT 26944 . 27289) (OUTLINEAREA 27291 . 28374) (OUTLINEREGION 28376 . 28831) (
SHOWCOLORTESTPATTERN 28833 . 30615) (SHOWCOLORBLOCKS 30617 . 31312) (MAPOFACOLOR 31314 . 32394)))))
STOP