(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