NamedColorsImpl.mesa
Copyright © 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
Rick Beach, October 25, 1985 9:18:46 pm PDT
Rewritten by Crow: May 22, 1984 1:42:09 pm
Last Edited by Crow, March 20, 1987 2:36:20 pm PST
DIRECTORY
NamedColors,
ImagerColorFns USING [HSL],
Basics USING [BITSHIFT],
IO USING [STREAM, RIS, GetTokenRope, EndOfStream],
Rope USING [ROPE, Length, Equal, Concat ];
NamedColorsImpl: CEDAR PROGRAM
IMPORTS Basics, IO, Rope
EXPORTS NamedColors
~ BEGIN OPEN NamedColors;
ROPE: TYPE ~ Rope.ROPE;
UndefinedName: PUBLIC SIGNAL ~ CODE;
BadGrammar: PUBLIC SIGNAL ~ CODE;
undefined: REAL ~ -1; --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"
];
RopeToHSL: PUBLIC PROCEDURE[rope: ROPE] RETURNS[clr: ImagerColorFns.HSL] = {
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;
clr.H ← clr.S ← clr.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 clr.S = undefined AND clr.L = undefined
THEN { -- reading first color
clr.H ← color.hue; clr.S ← color.saturation; clr.L ← color.lightness;
IF clr.H # undefined THEN { -- other hues must be in same third of color wheel
hueMid ← hueLower ← hueUpper ← clr.H;
hueMin ← clr.H - .3334;
hueMax ← clr.H + .3334;
};
}
ELSE { -- not first color
IF color.hue # undefined AND clr.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; };
};
move within established hue range and reset limits using previous hue
IF clr.H < color.hue THEN {
hueLower ← clr.H;
clr.H ← clr.H + factor * (hueUpper - clr.H);
};
IF clr.H > color.hue THEN {
hueUpper ← clr.H;
clr.H ← clr.H + factor * (hueLower - clr.H);
};
}
ELSE IF color.hue # undefined THEN { -- mixing with grey, 1st hue
hueMid ← hueLower ← hueUpper ← clr.H;
hueMin ← clr.H - .3333;
hueMax ← clr.H + .6667;
};
IF clr.S # color.saturation THEN clr.S ← (clr.S + color.saturation) / 2.0;
IF clr.L # color.lightness THEN clr.L ← (clr.L + color.lightness) / 2.0;
};
};
saturation => { -- achromatic, weak, moderate, strong vivid
IF clr.S = undefined THEN SIGNAL BadGrammar; -- must not have read a color yet
[clr.S, saturationFactor] ← ApplyFactor[ saturationFactor, color.saturation,
colorMapping[moderate].saturation, clr.S,
ish, firstSaturation];
firstSaturation ← FALSE;
};
lightness => { -- dark, medium, light
IF clr.L = undefined THEN SIGNAL BadGrammar; -- must not have read a color yet
[clr.L, lightnessFactor] ← ApplyFactor[ lightnessFactor, color.lightness,
colorMapping[medium].lightness, clr.L,
ish, firstLightness];
firstLightness ← FALSE;
};
ENDCASE;
}
ELSE SIGNAL UndefinedName; -- not found
lastToken ← token;
tokenList ← tokenList.rest;
ENDLOOP;
IF clr.S = undefined OR clr.L = undefined THEN SIGNAL BadGrammar;
IF clr.H = undefined THEN clr.S ← 0.0; -- kill saturated greys (from "bright white", etc.)
Fix deviant color wheel addresses
IF clr.H # undefined THEN IF clr.H < 0.0 THEN clr.H ← clr.H + 1. ELSE IF clr.H > 1.0 THEN clr.H ← clr.H - 1.;
RETURN [clr];
};
HSLToRope: PUBLIC PROCEDURE [clr: ImagerColorFns.HSL, level: NAT ← 2] 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, median, value: REAL, level: NAT]
RETURNS[LIST OF ROPE] ~ {
Build a name for "value" interpolated between "lowName" and "highName"
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: REAL ← median;
adjustment: REAL ← IF (number - median) > 0.0 THEN (1.0 - median) ELSE median;
IF (number >= 1.0 - insignificant) OR (number <= insignificant) THEN RETURN[tokenList];
Build a binary string representing the successive approximation path to "value"
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, closest: ColorType ← black;
huePlaceInInterval: REAL;
Special case extremes of lightness
IF clr.L <= insignificant THEN tokenList ← CONS["Black", tokenList]
ELSE IF clr.L >= (1.0 - insignificant) THEN tokenList ← CONS["White", tokenList]
ELSE {
Get hue
IF (clr.H < undefined/2.0) OR (clr.S < insignificant) THEN -- Achromatic
{ tokenList ← CONS["Grey", tokenList]; clr.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 (clr.L > .35) THEN LOOP;
IF clr.H - hue > .6667 THEN hue ← hue + 1.0 -- ensure continuum
ELSE IF hue - clr.H > .6667 THEN hue ← hue - 1.0;
IF clr.H < hue
THEN { IF (leastUpperHue - clr.H) > (hue - clr.H)
THEN { leastUpper ← i; leastUpperHue ← hue; }; }
ELSE IF (clr.H - greatestLowerHue) > (clr.H - hue)
THEN { greatestLower ← i; greatestLowerHue ← hue; };
};
ENDLOOP;
huePlaceInInterval ← (clr.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,
0.5,     -- median value between hues
huePlaceInInterval,
level - 1
];
IF (leastUpperHue - clr.H) < (clr.H - greatestLowerHue)  -- closest hue
THEN closest ← leastUpper ELSE closest ← greatestLower;
};
Get Saturation
IF clr.S >= (1.0 - insignificant) THEN tokenList ← CONS["Vivid", tokenList]
ELSE tokenList ← BuildTokenList[
tokenList, "Weak", "Strong", colorMapping[closest].saturation, clr.S, level
];
Get Lightness
tokenList ← BuildTokenList[
tokenList, "Dark", "Light", colorMapping[closest].lightness, clr.L, level
];
};
WHILE tokenList # NIL DO
rope ← Rope.Concat[Rope.Concat[rope, tokenList.first], " "];
tokenList ← tokenList.rest;
ENDLOOP;
RETURN[rope];
};
END.