ImagerColorNamesImpl.mesa
Copyright © 1984, 1985 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: Crow, May 22, 1984 1:42:09 pm PDT
Last Edited (even more extensively) by: Doug Wyatt, March 7, 1985 5:46:38 pm PST
DIRECTORY
Basics USING [BITSHIFT],
ImagerColorPrivate USING [HSL],
IO USING [Close, EndOfStream, GetTokenRope, RIS, STREAM],
Rope USING [Concat, Length, ROPE],
SymTab USING [Create, Fetch, Insert, Ref];
ImagerColorNamesImpl: CEDAR PROGRAM
IMPORTS Basics, IO, Rope, SymTab
EXPORTS ImagerColorPrivate
~ BEGIN OPEN ImagerColorPrivate;
ROPE: TYPE ~ Rope.ROPE;
UndefinedName: PUBLIC SIGNAL = CODE;
BadGrammar: PUBLIC SIGNAL = CODE;
Word:
TYPE ~ {
black, gray, white, -- achromatic "hue"
red, orange, brown, yellow, green, cyan, blue, purple, magenta, -- hue
weak, moderate, strong, vivid, -- saturation
dark, medium, light, -- lightness
very -- general-purpose adverb
};
Achromatic: TYPE ~ Word[black..white];
Hue: TYPE ~ Word[red..magenta];
Saturation: TYPE ~ Word[weak..vivid];
Lightness: TYPE ~ Word[dark..light];
NameArray: TYPE ~ ARRAY Word OF ARRAY BOOL OF ROPE;
names:
REF NameArray ~
NEW[NameArray ← [
black: ["black", NIL],
gray: ["gray", "grayish"],
white: ["white", NIL],
red: ["red", "reddish"],
orange: ["orange", "orangish"],
brown: ["brown", "brownish"],
yellow: ["yellow", "yellowish"],
green: ["green", "greenish"],
cyan: ["cyan", "cyanish"],
blue: ["blue", "bluish"],
purple: ["purple", "purplish"],
magenta: ["magenta", "magentaish"],
weak: ["weak", "weakish"],
moderate: ["moderate", NIL],
strong: ["strong", "strongish"],
vivid: ["vivid", NIL],
dark: ["dark", "darkish"],
medium: ["medium", NIL],
light: ["light", "lightish"],
very: ["very", NIL]
]];
HSLArray: TYPE ~ ARRAY Word[black..light] OF HSL;
hslFromWord:
REF HSLArray ~
NEW[HSLArray ← [
-- Achromatics: only s and l are significant
black: [0, 0, 0.0],
gray: [0, 0, 0.4],
white: [0, 0, 1.0],
-- Hues: h, s, l are all significant
red: [0.0, 0.6, 0.4],
orange: [0.04, 0.6, 0.4],
brown: [0.08, 0.6, 0.2],
yellow: [0.1667, 0.6, 0.4],
green: [0.3333, 0.6, 0.4],
cyan: [0.4999, 0.6, 0.4],
blue: [0.6666, 0.6, 0.4],
purple: [0.73, 0.6, 0.4],
magenta: [0.8333, 0.6, 0.4],
-- Saturations: only s is significant
weak: [0, 0.3, 0],
moderate: [0, 0.6, 0],
strong: [0, 0.8, 0],
vivid: [0, 1.0, 0],
-- Lightnesses: only l is significant
dark: [0, 0, 0.2],
medium: [0, 0, 0.4],
light: [0, 0, 0.7]
]];
defaultSaturation: Word ~ moderate;
defaultLightness: Word ~ medium;
averageSaturation: REAL ~ hslFromWord[moderate].s;
averageLightness: REAL ~ hslFromWord[medium].l;
vocabulary: SymTab.Ref ~ BuildVocabulary[];
Val: TYPE ~ REF Token;
Token: TYPE ~ RECORD[word: Word, ish: BOOL];
BuildVocabulary:
PROC
RETURNS[SymTab.Ref] ~ {
vocabulary: SymTab.Ref ~ SymTab.Create[mod: 41, case: FALSE];
Insert:
PROC[key:
ROPE, word: Word, ish:
BOOL] ~ {
val: Val ~ NEW[Token ← [word: word, ish: ish]];
inserted: BOOL ~ SymTab.Insert[x: vocabulary, key: key, val: val];
IF NOT inserted THEN ERROR;
};
-- Enter standard words
FOR ish:
BOOL
IN
BOOL
DO
FOR word: Word
IN Word
DO
key: ROPE ~ names[word][ish];
IF key#NIL THEN Insert[key: key, word: word, ish: ish];
ENDLOOP;
ENDLOOP;
-- Add a few synonyms
Insert[key: "Grey", word: gray, ish: FALSE];
Insert[key: "Greyish", word: gray, ish: TRUE];
Insert[key: "Violet", word: purple, ish: FALSE];
Insert[key: "Bright", word: vivid, ish: FALSE];
RETURN[vocabulary];
};
TokenListFromName:
PROC[name:
ROPE]
RETURNS[list:
LIST
OF Token ←
NIL] ~ {
stream: IO.STREAM ~ IO.RIS[name];
DO key:
ROPE; val:
REF; found:
BOOL;
[token: key] ← IO.GetTokenRope[stream ! IO.EndOfStream => EXIT];
IF Rope.Length[key]<2 THEN LOOP;
[found: found, val: val] ← SymTab.Fetch[x: vocabulary, key: key];
IF found THEN list ← CONS[NARROW[val, Val]^, list]
ELSE ERROR UndefinedName;
ENDLOOP;
IO.Close[stream];
};
WeightedValue: TYPE ~ RECORD[val, ave, weight: REAL, first: BOOL];
Adjust:
PROC[w: WeightedValue, new:
REAL, ish:
BOOL]
RETURNS[WeightedValue] ~ {
IF w.first
THEN {
IF ish THEN w.val ← w.ave+.6666*(new-w.val) ELSE w.val ← new;
w.first ← FALSE;
}
ELSE {
w.weight ← w.weight*(IF ish THEN 0.3333 ELSE 0.5); -- weaken weight if ishy
w.val ← w.val+w.weight*(new-w.ave);
IF w.val<0 THEN w.val ← 0 ELSE IF w.val>1 THEN w.val ← 1;
};
RETURN[w];
};
HSLFromName:
PUBLIC
PROC[name:
ROPE]
RETURNS[
HSL] ~ {
tokenList: LIST OF Token ~ TokenListFromName[name]; -- rightmost token is first in list
prev: Token;
h, hueMin, hueMid, hueMax, hueUpper, hueLower: REAL;
s: WeightedValue ← [val: 0, ave: averageSaturation, weight: 1, first: TRUE];
l: WeightedValue ← [val: 0, ave: averageLightness, weight: 1, first: TRUE];
hDefined: BOOL ← FALSE;
secondHue: BOOL ← TRUE;
IF tokenList=NIL THEN ERROR BadGrammar; -- empty name
FOR list:
LIST
OF Token ← tokenList, list.rest
UNTIL list=
NIL
DO
token: Token ← list.first;
IF list=tokenList
THEN {
-- rightmost token
[h, s.val, l.val] ← hslFromWord[token.word];
IF token.ish THEN ERROR BadGrammar; -- name can't end with -ish
SELECT token.word
FROM
IN Achromatic => NULL;
IN Hue => {
-- other hues must be in same third of color wheel
hueMid ← hueLower ← hueUpper ← h;
hueMin ← h - 0.3334;
hueMax ← h + 0.3334;
hDefined ← TRUE;
};
ENDCASE => ERROR BadGrammar; -- final word must name a color
}
ELSE {
-- a modifier
mh, ms, ml: REAL ← 0; -- h, s, l of modifier
IF token.word=very THEN token ← prev;
[mh, ms, ml] ← hslFromWord[token.word];
SELECT token.word
FROM
IN Hue => {
IF ms#0
AND hDefined
THEN {
-- modify hue
factor: REAL ~ IF token.ish THEN 0.3333 ELSE 0.5;
IF mh>hueMax THEN mh ← mh-1 -- get continuum
ELSE IF mh<hueMin THEN mh ← mh+1;
IF mh
IN[hueMin..hueMax]
THEN {
IF secondHue
THEN {
-- reset admissable range
IF mh<hueMid
THEN {
hueMin ← hueLower ← mh;
hueMax ← hueUpper ← hueMid;
}
ELSE {
hueMax ← hueUpper ← mh;
hueMin ← hueLower ← hueMid;
};
secondHue ← FALSE;
};
-- move within established hue range and reset limits using previous hue
IF h < mh
THEN {
hueLower ← h;
h ← h + factor * (hueUpper - h);
};
IF h > mh
THEN {
hueUpper ← h;
h ← h + factor * (hueLower - h);
};
}
ELSE ERROR BadGrammar; -- new hue too distant from original hue
}
ELSE
IF ms#0
THEN {
-- mixing with gray, 1st hue
h ← mh;
hueMid ← hueLower ← hueUpper ← h;
hueMin ← h - 0.3333;
hueMax ← h + 0.6667;
};
IF ms#s.val THEN s.val ← (s.val+ms)/2; -- interpolate saturation
IF ml#l.val THEN l.val ← (l.val+ml)/2; -- interpolate lightness
};
IN Saturation => s ← Adjust[s, ms, token.ish];
IN Lightness => l ← Adjust[l, ml, token.ish];
ENDCASE => ERROR;
};
prev ← token;
ENDLOOP;
IF NOT hDefined THEN s.val ← 0;
IF h<0 THEN h ← h+1 ELSE IF h>1 THEN h ← h-1;
RETURN[[h, s.val, l.val]];
};
NameFromHSL:
PUBLIC
PROC[hsl:
HSL, level:
NAT ← 3]
RETURNS[
ROPE] = {
h: REAL ~ hsl.h;
s: REAL ← hsl.s;
l: REAL ~ hsl.l;
epsilon: REAL ~ 1.0 / Basics.BITSHIFT[1, level+1]; -- differences less than this are insignificant
list: LIST OF Token ← NIL;
Cons: PROC[word: Word, ish: BOOL ← FALSE] ~ { list ← CONS[[word, ish], list] };
ConsAdjustment:
PROC[lower, upper: Word, value:
REAL, level:
NAT] ~ {
Build a name for "value" interpolated between "lower" and "upper"
token, lastToken: Token;
approximation, adjustment: REAL ← 0.5;
IF (value >= 1.0 - epsilon) OR (value <= epsilon) THEN RETURN;
Build a binary string representing the successive approximation path to "value"
FOR i:
NAT
IN[0..level-1)
DO
delta: REAL ~ ABS[value - approximation];
half: REAL ~ adjustment/2;
third: REAL ~ adjustment/3;
IF delta <= epsilon THEN EXIT;
token.ish ← ABS[ABS[delta] - third] < ABS[ABS[delta] - half];
IF token.ish THEN adjustment ← third ELSE adjustment ← half;
IF value < approximation
THEN { token.word ← lower; approximation ← approximation - adjustment }
ELSE { token.word ← upper; approximation ← approximation + adjustment };
IF i>0 AND token=lastToken THEN Cons[very] ELSE Cons[token.word, token.ish];
lastToken ← token;
ENDLOOP;
};
IF l <= epsilon THEN Cons[black]
ELSE IF l >= (1-epsilon) THEN Cons[white]
ELSE {
upper, lower: Word ← black;
t: REAL ← 0; -- huePlaceInInterval
-- Get hue
IF s <= epsilon THEN { Cons[gray]; s ← 0 } -- Achromatic
ELSE {
-- get bounding hues
hUpper: REAL ← 1.5;
hLower: REAL ← -.5;
FOR name: Word
IN Hue
DO
hue: REAL ← hslFromWord[name].h;
IF name=brown AND (l > .35) THEN LOOP; -- don't consider brown if too light
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 (hUpper - h) > (hue - h) THEN { upper ← name; hUpper ← hue; }; }
ELSE IF (h - hLower) > (h - hue) THEN { lower ← name; hLower ← hue; };
ENDLOOP;
t ← (h - hLower) / (hUpper - hLower); -- place in interval, IN[0..1]
IF t < .5
THEN {
-- closer to lesser valued hue
Cons[lower];
IF (t <= epsilon) THEN NULL -- lower
ELSE
IF t
IN[0.2916667 .. 0.5-epsilon]
THEN {
-- upperish lower
Cons[upper, TRUE]; t ← t + .1666667 }
ELSE Cons[upper]; -- upper lower
}
ELSE {
-- closer to greater valued hue
Cons[upper];
IF (t >= (1.0 - epsilon)) THEN NULL -- upper
ELSE
IF t
IN[0.5+epsilon .. 0.7083333]
THEN {
-- lowerish uppe
r
Cons[lower, TRUE]; t ← t - .1666667 }
ELSE Cons[lower]; -- lower upper
};
ConsAdjustment[lower, upper, t, level-1];
};
-- Get Saturation
IF s >= (1.0 - epsilon) THEN Cons[vivid]
ELSE {
IF lower=brown THEN s ← 2*(1-t)*s -- correct for brown's darkness
ELSE IF upper=brown THEN s ← 2*t*s;
ConsAdjustment[weak, strong, s, level];
};
-- Get Lightness
ConsAdjustment[dark, light, l, level];
};
RETURN[RopeFromTokenList[list]];
};
RopeFromTokenList:
PROC[list:
LIST
OF Token]
RETURNS[
ROPE] ~ {
rope: ROPE ← NIL;
FOR each:
LIST
OF Token ← list, each.rest
UNTIL each=
NIL
DO
token: Token ~ each.first;
IF rope#NIL THEN rope ← Rope.Concat[rope, " "];
rope ← Rope.Concat[rope, names[token.word][token.ish]];
ENDLOOP;
RETURN[rope];
};
END.