<> <> <> <> <> <> DIRECTORY Atom USING [GetPName, MakeAtom], CNSColor, Rope USING [ROPE]; CNSColorImpl: CEDAR PROGRAM IMPORTS Atom EXPORTS CNSColor = BEGIN OPEN CNSColor; hueRecord: TYPE = RECORD [ name: ATOM, value: REAL ]; hueMapping: ARRAY CSLChroma OF hueRecord _ [ [$Achromatic, 0.0], [$Red, 0.0], [$OrangishRed, 0.01], [$RedOrange, 0.02], [$ReddishOrange, 0.03], [$Orange, 0.04], [$YellowishOrange, 0.07], [$OrangeYellow, 0.10], [$OrangishYellow, 0.13], [$Yellow, 0.1673], [$GreenishYellow, 0.2073], [$YellowGreen, 0.2473], [$YellowishGreen, 0.2873], [$Green, 0.3333], [$BluishGreen, 0.4133], [$GreenBlue, 0.4933], [$GreenishBlue, 0.5733], [$Blue, 0.6666], [$PurplishBlue, 0.6816], [$BluePurple, 0.6966], [$BluishPurple, 0.7116], [$Purple, 0.73], [$ReddishPurple, 0.80], [$PurpleRed, 0.87], [$PurplishRed, 0.94], [$BrownishRed, 0.01], [$RedBrown, 0.02], [$ReddishBrown, 0.03], [$Brown, 0.04], [$YellowishBrown, 0.07], [$BrownYellow, 0.10], [$BrownishYellow, 0.13] ]; saturationRecord: TYPE = RECORD [ name: ATOM, value: REAL ]; saturationMapping: ARRAY CSLSaturation OF saturationRecord _ [ [$NoSaturation, 0.0], [$Grayish, 0.25], [$Moderate, 0.50], [$Strong, 0.75], [$Vivid, 1.0] ]; lightnessRecord: TYPE = RECORD [ name: ATOM, value: REAL ]; lightnessMapping: ARRAY CSLLightness OF lightnessRecord _ [ [$Black, 0.0], [$VeryDark, 0.1666], [$Dark, 0.3333], [$Medium, 0.5], [$Light, 0.6666], [$VeryLight, 0.8333], [$White, 1.0] ]; CSLFromCNS: PUBLIC PROCEDURE [hue, saturation, lightness: Rope.ROPE] RETURNS [c: CSLChroma, s: CSLSaturation, l: CSLLightness] = { hueAtom, saturationAtom, lightnessAtom: ATOM; hueAtom _ Atom.MakeAtom[hue]; FOR c IN [red..brownishYellow] DO IF hueAtom = hueMapping[c].name THEN EXIT; REPEAT FINISHED => c _ achromatic; ENDLOOP; IF c = achromatic THEN s _ noSaturation ELSE { saturationAtom _ Atom.MakeAtom[saturation]; FOR s IN [grayish..vivid] DO IF saturationAtom = saturationMapping[s].name THEN EXIT; REPEAT FINISHED => s _ vivid; ENDLOOP; }; SELECT hueAtom FROM $Black => l _ black; $White => l _ white; ENDCASE => { lightnessAtom _ Atom.MakeAtom[lightness]; FOR l IN [veryDark..veryLight] DO IF lightnessAtom = lightnessMapping[l].name THEN EXIT; REPEAT FINISHED => l _ medium; ENDLOOP; }; RETURN[c, s, l]; }; CNSFromCSL: PUBLIC PROCEDURE [c: CSLChroma, s: CSLSaturation, l: CSLLightness] RETURNS [hue, saturation, lightness: Rope.ROPE] = { IF c = achromatic THEN { saturation _ ""; SELECT l FROM black => { hue _ "Black"; lightness _ ""; }; white => { hue _ "White"; lightness _ ""; }; ENDCASE => { hue _ "Gray"; lightness _ Atom.GetPName[lightnessMapping[l].name]; }; } ELSE { hue _ Atom.GetPName[hueMapping[c].name]; saturation _ Atom.GetPName[saturationMapping[s].name]; lightness _ Atom.GetPName[lightnessMapping[l].name]; }; RETURN[hue, saturation, lightness]; }; HSLFromCSL: PUBLIC PROCEDURE [c: CSLChroma, s: CSLSaturation, l: CSLLightness] RETURNS [hue, saturation, lightness: REAL] = { IF c = achromatic THEN { hue _ 0.0; saturation _ 0.0; lightness _ lightnessMapping[l].value; } ELSE { hue _ hueMapping[c].value; saturation _ saturationMapping[s].value; lightness _ lightnessMapping[l].value; }; RETURN[hue, saturation, lightness]; }; CSLFromHSL: PUBLIC PROCEDURE [hue, saturation, lightness: REAL] RETURNS [c: CSLChroma, s: CSLSaturation, l: CSLLightness] = { FOR s IN [noSaturation..vivid] DO IF s = vivid THEN EXIT; IF saturation <= saturationMapping[s].value + (saturationMapping[s+1].value - saturationMapping[s].value)/2 THEN EXIT; ENDLOOP; IF s = noSaturation THEN { c _ achromatic; FOR l IN [black..white] DO IF l = white THEN EXIT; IF lightness <= lightnessMapping[l].value + (lightnessMapping[l+1].value - lightnessMapping[l].value)/2 THEN EXIT; ENDLOOP; } ELSE { FOR cc: CSLChroma IN [red..purplishRed] DO c _ cc; -- to satisfy fussier Mimosa compiler (if c is the loop variable, can't assign to it) IF c = purplishRed THEN { IF hue > hueMapping[c].value + (1.0 - hueMapping[c].value)/2 THEN c _ red; EXIT; }; IF hue <= hueMapping[c].value + (hueMapping[c+1].value - hueMapping[c].value)/2 THEN EXIT; ENDLOOP; FOR l IN [veryDark..veryLight] DO IF l = veryLight THEN EXIT; IF lightness <= lightnessMapping[l].value + (lightnessMapping[l+1].value - lightnessMapping[l].value)/2 THEN EXIT; ENDLOOP; }; RETURN[c, s, l]; }; END.