
DIRECTORY
Atom USING [GetPName, MakeAtom],
CNSColor,
Rope USING [ROPE];
CNSColorImpl: CEDAR PROGRAM
IMPORTS Atom
EXPORTS CNSColor =
BEGIN OPEN CNSColor;

hueRecord: TYPE = RECORD [
name: ATOM,
value: REAL
];

hueMapping: ARRAY CSLChroma OF hueRecord _ [
[$Achromatic, 			0.0],
[$Red, 					0.0],
[$OrangishRed, 			0.01],
[$RedOrange, 			0.02],
[$ReddishOrange, 		0.03],
[$Orange, 				0.04],
[$YellowishOrange, 	0.07],
[$OrangeYellow, 		0.10],
[$OrangishYellow, 		0.13],
[$Yellow, 				0.1673],
[$GreenishYellow, 		0.2073],
[$YellowGreen, 			0.2473],
[$YellowishGreen, 		0.2873],
[$Green, 					0.3333],
[$BluishGreen, 			0.4133],
[$GreenBlue, 			0.4933],
[$GreenishBlue, 		0.5733],
[$Blue, 					0.6666],
[$PurplishBlue, 			0.6816],
[$BluePurple, 			0.6966],
[$BluishPurple, 			0.7116],
[$Purple, 				0.73],
[$ReddishPurple, 		0.80],
[$PurpleRed, 			0.87],
[$PurplishRed, 			0.94],
[$BrownishRed, 		0.01],
[$RedBrown, 			0.02],
[$ReddishBrown, 		0.03],
[$Brown, 				0.04],
[$YellowishBrown, 		0.07],
[$BrownYellow, 		0.10],
[$BrownishYellow, 		0.13]
];

saturationRecord: TYPE = RECORD [
name: ATOM,
value: REAL
];

saturationMapping: ARRAY CSLSaturation OF saturationRecord _ [
[$NoSaturation, 	0.0],
[$Grayish, 		0.25],
[$Moderate, 		0.50],
[$Strong, 		0.75],
[$Vivid, 			1.0]
];

lightnessRecord: TYPE = RECORD [
name: ATOM,
value: REAL
];

lightnessMapping: ARRAY CSLLightness OF lightnessRecord _ [
[$Black, 			0.0],
[$VeryDark, 	0.1666],
[$Dark, 			0.3333],
[$Medium, 		0.5],
[$Light, 			0.6666],
[$VeryLight, 	0.8333],
[$White, 			1.0]
];

CSLFromCNS: PUBLIC PROCEDURE [hue, saturation, lightness: Rope.ROPE] RETURNS [c: CSLChroma, s: CSLSaturation, l: CSLLightness] = {
hueAtom, saturationAtom, lightnessAtom: ATOM;

hueAtom _ Atom.MakeAtom[hue];
FOR c IN [red..brownishYellow] DO
IF hueAtom = hueMapping[c].name THEN EXIT;
REPEAT
FINISHED => c _ achromatic;
ENDLOOP;

IF c = achromatic THEN s _ noSaturation
ELSE {
saturationAtom _ Atom.MakeAtom[saturation];
FOR s IN [grayish..vivid] DO
IF saturationAtom = saturationMapping[s].name THEN EXIT;
REPEAT
FINISHED => s _ vivid;
ENDLOOP;
};

SELECT hueAtom FROM
$Black => l _ black;
$White => l _ white;
ENDCASE => {
lightnessAtom _ Atom.MakeAtom[lightness];
FOR l IN [veryDark..veryLight] DO
IF lightnessAtom = lightnessMapping[l].name THEN EXIT;
REPEAT
FINISHED => l _ medium;
ENDLOOP;
};

RETURN[c, s, l];
};

CNSFromCSL: PUBLIC PROCEDURE [c: CSLChroma, s: CSLSaturation, l: CSLLightness] RETURNS [hue, saturation, lightness: Rope.ROPE] = {
IF c = achromatic THEN {
saturation _ "";
SELECT l FROM
black => {
hue _ "Black";
lightness _ "";
};
white => {
hue _ "White";
lightness _ "";
};
ENDCASE => {
hue _ "Gray";
lightness _ Atom.GetPName[lightnessMapping[l].name];
};
}
ELSE {
hue _ Atom.GetPName[hueMapping[c].name];
saturation _ Atom.GetPName[saturationMapping[s].name];
lightness _ Atom.GetPName[lightnessMapping[l].name];
};
RETURN[hue, saturation, lightness];
};

HSLFromCSL: PUBLIC PROCEDURE [c: CSLChroma, s: CSLSaturation, l: CSLLightness] RETURNS [hue, saturation, lightness: REAL] = {
IF c = achromatic THEN {
hue _ 0.0;
saturation _ 0.0;
lightness _ lightnessMapping[l].value;
}
ELSE {
hue _ hueMapping[c].value;
saturation _ saturationMapping[s].value;
lightness _ lightnessMapping[l].value;
};
RETURN[hue, saturation, lightness];
};

CSLFromHSL: PUBLIC PROCEDURE [hue, saturation, lightness: REAL] RETURNS [c: CSLChroma, s: CSLSaturation, l: CSLLightness] = {
FOR s IN [noSaturation..vivid] DO
IF s = vivid THEN EXIT;
IF saturation <= saturationMapping[s].value + (saturationMapping[s+1].value - saturationMapping[s].value)/2 THEN EXIT;
ENDLOOP;
IF s = noSaturation THEN {
c _ achromatic;
FOR l IN [black..white] DO
IF l = white THEN EXIT;
IF lightness <= lightnessMapping[l].value + (lightnessMapping[l+1].value - lightnessMapping[l].value)/2 THEN EXIT;
ENDLOOP;
}
ELSE {
FOR cc: CSLChroma IN [red..purplishRed] DO
c _ cc; -- to satisfy fussier Mimosa compiler (if c is the loop variable, can't assign to it)
IF c = purplishRed THEN {
IF hue > hueMapping[c].value + (1.0 - hueMapping[c].value)/2 THEN c _ red;
EXIT;
};
IF hue <= hueMapping[c].value + (hueMapping[c+1].value - hueMapping[c].value)/2 THEN EXIT;
ENDLOOP;
FOR l IN [veryDark..veryLight] DO
IF l = veryLight THEN EXIT;
IF lightness <= lightnessMapping[l].value + (lightnessMapping[l+1].value - lightnessMapping[l].value)/2 THEN EXIT;
ENDLOOP;
};
RETURN[c, s, l];
};

END.
   $  CNSColorImpl.mesa
Copyright Ó 1983, 1985, 1989 by Xerox Corporation.  All rights reserved.
Written by Darlene Plebon on June 23, 1983 11:48 am
Last Edited by: Beach, June 22, 1983 2:52 pm
Last Edited by: Stone, June 20, 1985 4:38:58 pm PDT
Doug Wyatt, November 17, 1989 5:29:17 pm PST
 Ê£  •NewlineDelimiter
–"cedar" style˜ proc–"Cedar" stylešœ™IcodešœH™HK–"Cedar" stylešœ3™3J™,J™3J™,—unitšÏk	˜	Jšœœ˜ J˜	Jšœœœ˜—šÏnœœ˜Jšœ˜Jšœ˜—Mšœ˜J˜ šœœœ˜Jšœœ˜Jšœ˜J˜J˜ —šœœœ˜,Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜J˜ —šœœœ˜!Jšœœ˜Jšœ˜J˜—J˜ šœœœ˜>Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜J˜ —šœœœ˜ Jšœœ˜Jšœ˜J˜—J˜ šœœœ˜;Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜J˜ —š
ž
œœ	œ#œœ6˜‚Jšœ(œ˜-J˜ Jšœ˜šœœ˜!Jšœœœ˜*š˜Jšœ˜—Jšœ˜—J˜ Jšœœ˜'šœ˜Jšœ+˜+šœœ˜Jšœ,œœ˜8š˜Jšœ˜—Jšœ˜—Jšœ˜—J˜ šœ	˜Jšœ˜Jšœ˜šœ˜Jšœ)˜)šœœ˜!Jšœ*œœ˜6š˜Jšœ˜—Jšœ˜—Jšœ˜——J˜ Jšœ
˜J˜—J˜ šž
œœ3œ#œ˜‚šœœ˜J˜šœ˜šœ
˜
Jšœ˜J˜J˜—šœ
˜
Jšœ˜J˜J˜—šœ˜Jšœ˜Jšœ4˜4J˜——Jšœ˜—šœ˜Jšœ(˜(Jšœ6˜6Jšœ4˜4Jšœ˜—Jšœ˜#J˜—J˜ šž
œœ3œœ˜}šœœ˜J˜
J˜Jšœ&˜&J˜—šœ˜Jšœ˜Jšœ(˜(Jšœ&˜&Jšœ˜—Jšœ˜#J˜—J˜ šž
œœœœ6˜}šœœ˜!Jšœœœ˜Jšœjœœ˜vJšœ˜—šœœ˜J˜šœœ˜Jšœœœ˜Jšœfœœ˜rJšœ˜—J˜—šœ˜šœœ˜*JšœÏcU˜]šœœ˜Jšœ;œ	˜JJšœ˜J˜—JšœNœœ˜ZJšœ˜—šœœ˜!Jšœœœ˜Jšœfœœ˜rJšœ˜—Jšœ˜—Jšœ
˜J˜—J˜ Jšœ˜— …—    6  ý  