<<>> <> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY NamedColors, 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: 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: 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] ~ { <> 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]; <> 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; <> 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, 0.5, -- median value between hues huePlaceInInterval, level - 1 ]; IF (leastUpperHue - clr.H) < (clr.H - greatestLowerHue) -- closest hue THEN closest ¬ leastUpper ELSE closest ¬ greatestLower; }; <> IF clr.S >= (1.0 - insignificant) THEN tokenList ¬ CONS["Vivid", tokenList] ELSE tokenList ¬ BuildTokenList[ tokenList, "Weak", "Strong", colorMapping[closest].saturation, clr.S, level ]; <> 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.