DIRECTORY
ColorNames,
ColorModels 	USING [undefined],
Basics			USING [BITSHIFT],
IO 				USING [STREAM, RIS, GetTokenRope, EndOfStream],
Rope 			USING [ROPE, Length, Equal, Concat ];
ColorNamesImpl: CEDAR PROGRAM
IMPORTS Basics, IO, Rope  EXPORTS ColorNames =
BEGIN OPEN ColorNames;
ROPE: TYPE=Rope.ROPE;

UndefinedName: PUBLIC SIGNAL = CODE;
BadGrammar: PUBLIC SIGNAL = CODE;
undefined: REAL = ColorModels.undefined;	--for undefined color values
entryKind: TYPE = { color, saturation, lightness };
colorRecord: TYPE = RECORD [
name: ROPE,
hue, saturation, lightness: REAL,
type: entryKind
];

colorMapping: ARRAY ColorType OF colorRecord _ [
black:					["Black", 			undefined,	0.0,			0.0,			color],
white:					["White", 		undefined,	0.0,			1.0,			color],
gray:					["Gray", 			undefined,	0.0,			0.4,			color],
grey:					["Grey", 			undefined,	0.0,			0.4,			color],
red:					["Red", 			0.0,			.6,				0.4,			color],
orange:				["Orange", 		0.04,			.6,				0.4,			color],
brown:				["Brown", 		0.08,			.6,				0.2,			color],
yellow:				["Yellow", 		0.1667,		.6,				0.4,			color],
green:					["Green", 		0.3333,		.6,				0.4,			color],
cyan:					["Cyan",			0.4999,		.6,				0.4,			color],	
blue:					["Blue", 			0.6666,		.6,				0.4,			color],
purple:				["Purple", 		0.73,			.6,				0.4,			color],
magenta:				["Magenta",		0.8333,		.6,				0.4,			color],

achromatic:			["Achromatic", 	undefined,	0.0,			undefined,	saturation],
weak:					["Weak", 			undefined,	0.3,			undefined,	saturation],
moderate:				["Moderate", 	undefined,	0.6,			undefined,	saturation],
strong:				["Strong", 		undefined,	0.8,			undefined,	saturation],
vivid:					["Vivid", 		undefined,	1.0,			undefined,	saturation],
bright:				["Bright", 		undefined,	1.0,			undefined,	saturation],

dark:					["Dark", 			undefined,	undefined,	0.2		,	lightness],
medium:				["Medium", 		undefined,	undefined,	0.4			,	lightness],
light:					["Light", 			undefined,	undefined,	0.7		,	lightness]
];

ishCount: NAT = 15;
ishList: ARRAY [0..ishCount) OF ROPE _ [
"Grayish", "Greyish", "Reddish", "Orangish", "Brownish", "Yellowish", "Greenish", "Cyanish",
"Bluish", "Purplish", "Magentaish", "Weakish", "Strongish", "Darkish", "Lightish" 
];
deIshList: ARRAY [0..ishCount) OF ROPE _ [
"Gray", "Grey", "Red", "Orange", "Brown", "Yellow", "Green", "Cyan",
"Blue", "Purple", "Magenta", "Weak", "Strong", "Dark", "Light" 
];

ParseColorName: PUBLIC PROCEDURE[rope: ROPE] RETURNS[h, s, l: REAL] = {
color: colorRecord;
found: BOOLEAN _ FALSE;
lastEntryKind: entryKind _ color;
ish: BOOLEAN _ FALSE;
token: ROPE;
lastToken: ROPE;
tokenList: LIST OF ROPE _ NIL;
firstSaturation, firstLightness, secondHue: BOOLEAN _ TRUE;
saturationFactor, lightnessFactor, hueFactor: REAL _ 1.0;
hueMin, hueMid, hueMax, hueUpper, hueLower: REAL;
Done: SIGNAL = CODE;
stream: IO.STREAM _ IO.RIS[rope];

FindColor: PROC[r: ROPE] RETURNS [colorRecord, BOOLEAN] = {
FOR i: ColorType IN ColorType DO
IF Rope.Equal[r,colorMapping[i].name,FALSE] THEN RETURN[colorMapping[i], TRUE];
ENDLOOP;
RETURN[colorMapping[black], FALSE];
};
DeIsh: PROC[r: ROPE] RETURNS [rOut: ROPE, ish: BOOLEAN] = {
rOut _ r;
ish _ FALSE;
FOR i: NAT IN [0..ishCount) DO
IF Rope.Equal[r, ishList[i], FALSE] THEN {
ish _ TRUE;
rOut _ deIshList[i]
};
ENDLOOP;
};
ApplyFactor: PROC[ weight, tableEntry, average, value: REAL, ish, first: BOOLEAN] 
							RETURNS[newValue, newWeight: REAL] ~ {
IF first THEN {
IF ish 
THEN newValue _ average + .6666 * (tableEntry - value)
ELSE newValue _ tableEntry;  
newWeight _ weight;
}
ELSE {
newWeight _ IF ish THEN weight * .3333 ELSE weight * .5; 		-- weaken weight if ishy
newValue _ value + newWeight * (tableEntry - average);
newValue _ MIN[1.0, MAX[0.0, newValue]];
};
};
NextToken: PROC = {
DO
token _ NIL;
[token: token, charsSkipped: ] _ IO.GetTokenRope[stream ! IO.EndOfStream => CONTINUE];
IF token=NIL THEN SIGNAL Done;
IF Rope.Length[token] > 2 THEN EXIT;
ENDLOOP;
};

DO
NextToken[! Done => EXIT];						-- pick up tokens and stack them
tokenList _ CONS[token, tokenList];
ENDLOOP;

h _ s _ l _ undefined;

WHILE tokenList # NIL DO					-- now pop tokens back off stack so color comes first
[token, ish] _ DeIsh[tokenList.first];					-- catch mumbleish, strip ish
IF Rope.Equal[token, "Very", FALSE] THEN token _ lastToken;
[color, found] _ FindColor[token];
IF found 
THEN {
SELECT color.type FROM
color => {													-- picking up color name
IF s = undefined AND l = undefined 
THEN {  														-- reading first color
h _ color.hue;    s _ color.saturation;    l _ color.lightness;
IF h # undefined THEN {   -- other hues must be in same third of color wheel
hueMid _ hueLower _ hueUpper _ h;    
hueMin _ h - .3334;    
hueMax _ h + .3334;
};  
}
ELSE {																-- not first color
IF color.hue # undefined AND h # undefined THEN {
factor: REAL _ IF ish THEN .3333 ELSE .5;
IF color.hue > hueMax THEN color.hue _ color.hue - 1.	-- get continuum
ELSE IF color.hue < hueMin THEN color.hue _ color.hue + 1.;
IF NOT (hueMin <= color.hue AND hueMax >= color.hue) 
THEN SIGNAL BadGrammar									-- hue not in range
ELSE IF secondHue THEN {		-- in range and possibly second hue
IF color.hue < hueMid 				-- reset admissable range
THEN { 
hueMin _ hueLower _ color.hue;  
hueMax _ hueUpper _ hueMid;  secondHue _ FALSE;  }
ELSE  {
hueMax _ hueUpper _ color.hue;  
hueMin _ hueLower _ hueMid;  secondHue _ FALSE;  };
};
IF h < color.hue THEN {
hueLower _ h;
h _ h + factor * (hueUpper - h);
};
IF h > color.hue THEN {
hueUpper _ h;
h _ h + factor * (hueLower - h);
};
}
ELSE IF color.hue # undefined THEN {  		-- mixing with grey, 1st hue
hueMid _ hueLower _ hueUpper _ h;    
hueMin _ h - .3333;    
hueMax _ h + .6667;  
};
IF s # color.saturation THEN s _ (s + color.saturation) / 2.0;
IF l # color.lightness THEN l _ (l + color.lightness) / 2.0;
};
};
saturation => {						-- achromatic, weak, moderate, strong vivid
IF s = undefined THEN SIGNAL BadGrammar;	-- must not have read a color yet
[s, saturationFactor] _ ApplyFactor[ saturationFactor, color.saturation,
										colorMapping[moderate].saturation, s, 
										ish, firstSaturation];
firstSaturation _ FALSE;
};
lightness => {						-- dark, medium, light
IF l = undefined THEN SIGNAL BadGrammar;	-- must not have read a color yet
[l, lightnessFactor] _ ApplyFactor[ lightnessFactor, color.lightness,
										 colorMapping[medium].lightness, l, 
										 ish, firstLightness];
firstLightness _ FALSE;
};
ENDCASE;
}
ELSE SIGNAL UndefinedName;			-- not found
lastToken _ token;
tokenList _ tokenList.rest;
ENDLOOP;
IF s = undefined OR l = undefined THEN SIGNAL BadGrammar;
IF h = undefined THEN s _ 0.0;			   -- kill saturated greys (from "bright white", etc.)
IF h # undefined THEN IF h < 0.0 THEN h _ h + 1. ELSE IF h > 1.0 THEN h _ h - 1.;
RETURN [h, s, l];
};

HSLToRope: PUBLIC PROCEDURE [h,s,l: REAL, level: NAT _ 3] RETURNS [rope: ROPE] = {
insignificant: REAL ~ 1.0 / Basics.BITSHIFT[1, level+1];
GetIshName: PROC[name: ROPE] RETURNS[nameish: ROPE _ NIL] ~ {
FOR i: NAT IN [0..ishCount) DO
IF Rope.Equal[name, deIshList[i]] THEN nameish _ ishList[i];
ENDLOOP;
IF nameish = NIL THEN nameish _ Rope.Concat[name, "ish"];
};
BuildTokenList: PROC[tokenList: LIST OF ROPE, lowName, highName: ROPE, value: REAL,
							 level: NAT]  RETURNS[LIST OF ROPE] ~ {
ConsWithVery: PROC[name, lastName: ROPE, tokenList: LIST OF ROPE] 
					RETURNS[LIST OF ROPE, ROPE]~ {
IF Rope.Equal[name, lastName, FALSE] THEN tokenList _ CONS["Very", tokenList]  
									 			  ELSE tokenList _ CONS[name, tokenList];
RETURN[tokenList, name];
};

name, lastName: ROPE _ NIL;
number: REAL _ value;
ishy: BOOLEAN _ FALSE;
approximation, adjustment: REAL _ 0.5;
IF (number >= 1.0 - insignificant) OR (number <= insignificant) THEN RETURN[tokenList];
FOR i: NAT IN [0..level-1) DO
IF ABS[number - approximation] <= insignificant THEN EXIT;
IF ABS[ABS[number - approximation] - adjustment/3.0] 
	< ABS[ABS[number - approximation] - adjustment/2.0] 
THEN {  adjustment _ adjustment / 3.;    ishy _ TRUE;  }
ELSE  {  adjustment _ adjustment / 2.;    ishy _ FALSE;  };
IF number < approximation 
THEN {  
name _ IF ishy THEN GetIshName[lowName] ELSE lowName;
approximation _ approximation - adjustment;  
}
ELSE  { 
name _ IF ishy THEN GetIshName[highName] ELSE highName;
approximation _ approximation + adjustment;  
};
[tokenList, lastName] _ ConsWithVery[name, lastName, tokenList]; 
ENDLOOP;
RETURN[tokenList];
};

tokenList: LIST OF ROPE _ NIL;
leastUpper, greatestLower: ColorType _ black;
huePlaceInInterval: REAL;

IF l <= insignificant THEN tokenList _ CONS["Black", tokenList]  
ELSE  IF l >= (1.0 - insignificant) THEN tokenList _ CONS["White", tokenList] 
ELSE {
IF (h < undefined/2.0) OR (s < insignificant) THEN					-- Achromatic
{  tokenList _ CONS["Grey", tokenList];    s _ 0.0;  }  
ELSE {																		-- get bounding hues
leastUpperHue: REAL _ 1.5;
greatestLowerHue: REAL _ -.5;
FOR i: ColorType IN ColorType DO
hue: REAL _ colorMapping[i].hue; 
IF hue # undefined THEN {
IF (Rope.Equal[colorMapping[i].name, "Brown", FALSE]) AND (l > .35) THEN LOOP;
IF h - hue > .6667 THEN hue _ hue + 1.0 						-- ensure continuum
ELSE IF hue - h > .6667 THEN hue _ hue - 1.0;
IF h < hue 
THEN {  IF (leastUpperHue - h) > (hue - h) 
THEN {  leastUpper _ i;   leastUpperHue _ hue;  };  } 
ELSE IF (h - greatestLowerHue) > (h - hue) 
THEN {  greatestLower _ i;   greatestLowerHue _ hue;  }; 
};
ENDLOOP;
huePlaceInInterval _ (h - greatestLowerHue) / (leastUpperHue - greatestLowerHue);
IF huePlaceInInterval < .5 											-- get leading color names
THEN									-- closer to lesser valued hue
IF (huePlaceInInterval <= insignificant) 
THEN tokenList _ CONS[colorMapping[greatestLower].name, tokenList]	-- lower
ELSE IF (huePlaceInInterval >= .2916667) AND (huePlaceInInterval <= .5-insignificant)
THEN {																	-- upperish lower
tokenList _ CONS[GetIshName[colorMapping[leastUpper].name],
							CONS[colorMapping[greatestLower].name, tokenList]];
huePlaceInInterval _ huePlaceInInterval + .1666667;
}
ELSE tokenList _ CONS[colorMapping[leastUpper].name,				-- upper lower
							CONS[colorMapping[greatestLower].name, tokenList]]
ELSE									-- closer to greater valued hue
IF (huePlaceInInterval >= (1.0 - insignificant))
THEN tokenList _ CONS[colorMapping[leastUpper].name, tokenList]		-- upper
ELSE IF (huePlaceInInterval <= .7083333) AND (huePlaceInInterval >= .5+insignificant)
THEN {																	-- lowerish upper
tokenList _ CONS[GetIshName[colorMapping[greatestLower].name],
							CONS[colorMapping[leastUpper].name, tokenList]];
huePlaceInInterval _ huePlaceInInterval - .1666667;
}
ELSE   tokenList _ CONS[colorMapping[greatestLower].name,			-- lower upper
							CONS[colorMapping[leastUpper].name, tokenList]];
tokenList _ BuildTokenList[
tokenList,
colorMapping[greatestLower].name,    
colorMapping[leastUpper].name,
huePlaceInInterval,
level - 1
];
};
IF s >= (1.0 - insignificant) THEN tokenList _ CONS["Vivid", tokenList]
ELSE {
IF Rope.Equal[colorMapping[greatestLower].name, "Brown", FALSE] 
THEN  s _ 2 * (1.0 - huePlaceInInterval) * s	-- correct for Brown's darkness
ELSE IF Rope.Equal[colorMapping[leastUpper].name, "Brown", FALSE] 
THEN  s _ 2 * huePlaceInInterval * s;
tokenList _ BuildTokenList[tokenList, "Weak", "Strong", s, level];
};
tokenList _ BuildTokenList[tokenList, "Dark", "Light", l, level];
};

WHILE tokenList # NIL DO
rope _ Rope.Concat[Rope.Concat[rope, tokenList.first], " "];
tokenList _ tokenList.rest;
ENDLOOP;
RETURN[rope];
};



END.
˜ColorNamesImpl.mesa
Copyright c 1984 by Xerox Corporation.  All rights reserved.
Written by Maureen Stone on June 23, 1983 11:48 am
Last Edited by: Beach, June 22, 1983 2:52 pm
Last Edited by: Stone, October 19, 1983 5:20 pm
Last Edited by: Pier, January 18, 1984 1:09 pm
Last Edited (Extensively) by: May 22, 1984 1:42:09 pm PDT
move within established hue range and reset limits using previous hue
	Fix deviant color wheel addresses
Build a name for "value" interpolated between "lowName" and "highName"
Build a binary string representing the successive approximation path to "value"
Special case extremes of lightness
Get hue
Get Saturation
Get Lightness
Κ*˜Iproc–

"Cedar" styleš
œ™Jšœ
Οm
œ1™<K–

"Cedar" styleš
œ2™2J™,J™/J™.J™9
unitš
Οk	˜	Jš
œ˜Jšœ
žœ
˜Jšœ	žœžœ˜Jšžœ
ž	œžœ"˜6Jšœžœžœžœž
œž
œ˜-—šœžœ
ž˜Jšžœ	žœž	œ
˜.—Lšžœ
žœ˜Lšžœžœžœ
˜L˜Jšœžœ
žœžœ
˜$Jšœžœ
žœžœ
˜!JšœžœΟc˜EJšœžœ$˜3šœ
žœžœ˜Jšœžœ
˜Jšœž˜!Jš
œ˜J˜J˜—šœžœžœ˜0Jš
œ8˜8Jš
œ7˜7Jš
œ6˜6Jš
œ6˜6Jš
œ0˜0Jš
œ5˜5Jš
œ3˜3Jš
œ6˜6Jš
œ5˜5Jš
œ4˜4Jš
œ4˜4Jš
œ5˜5Jš
œ7˜7Idefault˜Mš
œG˜GJš
œ?˜?Jš
œD˜DMš
œA˜AJš
œ@˜@Jš
œA˜AJ˜Jš
œ>˜>Jš
œA˜AJš
œ?˜?J˜—J˜Jšœ
žœ˜šœ	žœžœ
žœ˜(Jš
œ\˜\Jš
œR˜RJ˜—šœžœžœ
žœ˜*Jš
œD˜DJš
œ?˜?J˜J˜—šΟnœžœ
ž	œžœžœ
žœ˜GJš
œ˜Jšœžœžœ
˜Jš
œ!˜!Jšœžœžœ
˜Jšœžœ
˜Jšœžœ
˜Jš	œžœ
žœ
žœžœ
˜Jšœ,žœžœ
˜;Jšœ.žœ˜9Jšœ,žœ
˜1Jšœžœ
žœ
˜Jšœžœ
žœžœ˜!J˜š
 	œžœžœžœžœ˜;šžœžœž˜ Jš
žœ#žœžœ
žœžœ˜OJšžœ
˜—Jšžœžœ˜#J˜—š œžœžœžœžœžœ˜;Jš
œ	˜	Jšœžœ
˜šžœžœ
žœž˜šžœžœž˜*Jšœžœ
˜Jš
œ˜J˜—Jšžœ
˜—Jš
œ˜—Jš œžœ&žœžœ˜Ršœžœžœ˜-šžœžœ˜Jšžœ˜Jšžœ2˜6Jšžœ˜Jš
œ˜J˜
—šžœ˜JšœžœžœžœŸ˜SJš
œ6˜6Jšœžœžœ˜(J˜—J˜—š 	œžœ˜š
ž˜Jšœžœ
˜Jšœ!žœžœžœ˜VJšžœžœ
žœ
žœ˜Jšžœžœ
žœ
˜$Jšžœ
˜—J˜—J˜š
ž˜JšœžœŸ ˜@Jšœžœ˜#Jšžœ
˜J˜—Jš
œ˜J˜šžœ
žœ
žœŸ5˜RJšœ+Ÿ˜HJšžœžœžœ˜;š
œ"˜"Jšžœ˜	šžœ˜šžœž˜šœŸ˜/Jšžœžœ˜#šžœŸ˜,Jš
œ?˜?šžœžœŸ2˜LJš
œ%˜%Jš
œ˜Jš
œ˜Jš
œ˜—Jš
œ
˜
—šžœŸ˜(šžœžœžœ˜1Jš	œžœžœžœžœ˜)šžœžœŸ˜FJšžœ
žœžœ˜;—šžœ
žœžœ˜5JšžœŸ˜2šžœ
žœžœŸ$˜=JšžœŸ˜3šžœ˜Jš
œ ˜ Jšœ)žœ˜2—šžœ˜Jš
œ ˜ Jšœ)žœ˜3—J˜—J™E—šžœžœ˜Jš
œ
˜
Jš
œ ˜ J˜—šžœžœ˜Jš
œ
˜
Jš
œ ˜ J˜—J˜
—šžœ
žœžœŸ˜DJš
œ%˜%Jš
œ˜Jš
œ˜Jš
œ˜—Jšžœžœ"˜>Jšžœžœ!˜<Jš
œ˜—Jš
œ˜—šœŸ+˜@Jšžœžœ
žœ
Ÿ!˜Jš
œH˜HJš
œ0˜0Jš
œ ˜ —Jšœžœ
˜Jš
œ˜—šœŸ˜*Jšžœžœ
žœ
Ÿ!˜JJš
œE˜EJš
œ.˜.Jš
œ ˜ Jšœžœ
˜Jš
œ˜—Jšžœ
˜—J˜
—Jšžœ
žœŸ˜)—Jš
œ˜J˜Jšžœ
˜—Jšžœžœžœ
žœ˜9JšžœžœŸ3˜WJ™"Jšžœžœ
žœ	žœžœ
žœ	žœ˜QJšžœ˜J˜—J˜š 	œžœ
ž	œ	žœ	žœžœžœ˜RJšœžœžœ
˜8š 
œžœžœžœ
žœžœ˜=šžœžœ
žœž˜Jšžœ žœ˜<Jšžœ
˜—Jšžœžœ
žœ$˜9Jš
œ˜—Jš œžœžœ
žœ
žœžœ	žœ
˜Sšœžœžœ
žœ
žœ
žœ˜.J™FJš œžœžœ
žœ
žœ
žœ˜Bšœžœ
žœ
žœ
žœžœ˜#Jšžœžœžœ
žœ˜OJšœ	ž
œ
žœ˜6Jšžœ˜J˜—J˜Jšœžœžœ
˜Jšœžœ	˜Jšœžœžœ
˜Jšœžœ˜&šžœ!žœžœ
žœ˜WJš
ŸO™O—šžœžœ
žœž˜Jšžœ
žœ*žœ
žœ
˜:Jšžœ
žœ
žœ+˜5šœžœ
žœ+˜5Jšžœ,žœ˜8Jšžœ-žœ˜;—šžœ˜šžœ˜Jšœžœžœžœ	˜5Jš
œ-˜-Jš
œ
˜
—šžœ˜Jšœžœžœžœ
˜7Jš
œ-˜-Jš
œ˜——Jš
œA˜AJšžœ
˜—Jšžœ˜J˜—J˜Jš	œžœ
žœ
žœžœ
˜Jš
œ-˜-Jšœžœ
˜˜J™"—Jšžœžœ
žœ˜AJšžœžœžœ
žœ˜Nšžœ˜J™šžœžœžœŸ
˜DJšœžœ#Ÿ˜8—šžœŸ˜,Jšœžœ˜Jšœžœ˜šžœžœž˜ Jšœžœ˜!šžœžœ˜Jš	žœ,žœžœžœ
ž˜NJšžœžœŸ˜AJšžœ
žœžœ˜-šžœ	˜šžœ
žœ!˜+Jšžœ2˜6—šžœ
žœ$˜+Jšžœ5˜9——J˜—Jšžœ
˜—Jš
œQ˜QšžœŸ#˜@šžœ	Ÿ˜+šžœ'˜)Jšžœ
žœ.Ÿ˜K—šžœ
žœ!žœ)˜UšžœŸ˜(šœžœ+˜;Jšœžœ/˜:—Jš
œ3˜3Jš
œ
˜
——šžœ
žœ#Ÿ˜FJšœžœ.˜9——šžœ	Ÿ˜,šžœ.˜0Jšžœ
žœ,Ÿ˜I—šžœ
žœ!žœ)˜UšžœŸΟi
˜(šœžœ.˜>Jšœžœ,˜7—Jš
œ3˜3Jš
œ
˜
——šžœžœ%Ÿ˜JJšœžœ,˜7———š
œ˜J˜
Jš
œ%˜%Jš
œ˜Jš
œ˜J˜	J˜—J˜J™—Jšžœžœžœ˜Gš
ž˜šžœ7žœ˜@Jšžœ)Ÿ˜L—šžœ
žœ4žœ˜BJšžœ˜%—Jš
œB˜BJ˜Jš
œ
™
—Jš
œA˜AJ˜J˜—šžœ
žœ
ž˜Jš
œ<˜<Jš
œ˜Jšžœ
˜—Jšžœ˜
J˜—J˜J˜J˜Jšžœ
˜—…—,δ=¦