ColorNamesImpl.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
Last Edited (Extensively) by: May 22, 1984 1:42:09 pm PDT
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: BOOLEANFALSE;
lastEntryKind: entryKind ← color;
ish: BOOLEANFALSE;
token: ROPE;
lastToken: ROPE;
tokenList: LIST OF ROPENIL;
firstSaturation, firstLightness, secondHue: BOOLEANTRUE;
saturationFactor, lightnessFactor, hueFactor: REAL ← 1.0;
hueMin, hueMid, hueMax, hueUpper, hueLower: REAL;
Done: SIGNAL = CODE;
stream: IO.STREAMIO.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: REALIF 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 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.)
 Fix deviant color wheel addresses
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: ROPENIL] ~ {
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] ~ {
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: ROPENIL;
number: REAL ← value;
ishy: BOOLEANFALSE;
approximation, adjustment: REAL ← 0.5;
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 ROPENIL;
leastUpper, greatestLower: ColorType ← black;
huePlaceInInterval: REAL;
Special case extremes of lightness
IF l <= insignificant THEN tokenList ← CONS["Black", tokenList]
ELSE IF l >= (1.0 - insignificant) THEN tokenList ← CONS["White", tokenList]
ELSE {
Get hue
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
];
};
Get Saturation
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];
};
Get Lightness
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.