DIRECTORY NamedColors, ImagerColor 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: ImagerColor.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; }; }; 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.) 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: ImagerColor.HSL, 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 clr.L <= insignificant THEN tokenList _ CONS["Black", tokenList] ELSE IF clr.L >= (1.0 - insignificant) THEN tokenList _ CONS["White", tokenList] ELSE { 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, huePlaceInInterval, level - 1 ]; }; IF clr.S >= (1.0 - insignificant) THEN tokenList _ CONS["Vivid", tokenList] ELSE { IF Rope.Equal[colorMapping[greatestLower].name, "Brown", FALSE] THEN clr.S _ 2 * (1.0 - huePlaceInInterval) * clr.S -- correct for Brown'clr.S darkness ELSE IF Rope.Equal[colorMapping[leastUpper].name, "Brown", FALSE] THEN clr.S _ 2 * huePlaceInInterval * clr.S; tokenList _ BuildTokenList[tokenList, "Weak", "Strong", clr.S, level]; }; tokenList _ BuildTokenList[tokenList, "Dark", "Light", clr.L, level]; }; WHILE tokenList # NIL DO rope _ Rope.Concat[Rope.Concat[rope, tokenList.first], " "]; tokenList _ tokenList.rest; ENDLOOP; RETURN[rope]; }; END. ξNamedColorsImpl.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 Rick Beach, October 25, 1985 9:18:46 pm PDT Rewritten by Crow: May 22, 1984 1:42:09 pm Last Edited by Crow, September 25, 1985 5:30:22 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 Κ&˜code– "Cedar" stylešœ™Kšœ Οmœ1™Kšœžœ,˜1—Kšœ3˜3Kšœ˜——šžœžœ# ˜HKšœžœ,˜1———šœ˜K˜ Kšœ%˜%Kšœ˜Kšœ˜K˜ K˜—K˜K™—Kšžœ žœ žœ˜Kšž˜šžœ7žœ˜@Kšžœ1 #˜X—šžœžœ4žœ˜BKšžœ'˜-—KšœF˜FK˜Kšœ ™ —KšœE˜EK˜K˜—šžœ žœž˜Kšœ<˜