ColorToolImpl.mesa
Copyright Ó 1985, 1989, 1990, 1992 by Xerox Corporation. All rights reserved.
Maureen Stone June 10, 1986 0:26:23 am PDT
Maureen Stone, October 1, 1987 11:05:04 am PDT
Pier, December 7, 1988 4:56:56 pm PST
Giordano:PARC:Xerox (8*923-4484), June 25, 1990 4:54 pm PDT
Doug Wyatt, April 10, 1992 6:32 pm PDT
Ken Fishkin, September 14, 1992 2:43 pm PDT
DIRECTORY
Buttons, CNSColor, ColorFns, ColorPatch, ColorSchemeViewer, ColorTool, ColorTypes, Commander, Containers, Convert, ImagerColor, ImagerDither, NamedColors, Rope, SymTab, VFonts, ViewerClasses, ViewerOps, ViewerTools;
ColorToolImpl: CEDAR PROGRAM
IMPORTS Buttons, CNSColor, ColorFns, ColorPatch, ColorSchemeViewer, Commander, Containers, Convert, ImagerColor, NamedColors, Rope, SymTab, VFonts, ViewerOps, ViewerTools
EXPORTS ColorTool
RGB: TYPE = ImagerColor.RGB;
HSL: TYPE = ColorTypes.HSL;
HSV: TYPE = ColorTypes.HSV;
CMY: TYPE = ColorTypes.CMY;
CSL: TYPE ~ CNSColor.CSL;
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
Handle: TYPE = REF HandleRec ¬ NIL;
HandleRec: TYPE = RECORD[self, rgb, cmy, hsl, hsv, patch, name, setName, registered, setRegistered: Viewer, lastValue: RGB, specialColor: ImagerColor.ConstantColor, notify: SymTab.Ref];
ColorScheme: TYPE = {rgb, cmy, hsl, hsv, name};
fast: BOOLEAN ¬ FALSE;
Set and read the current value of the ColorTool
NoColorToolViewer: PUBLIC SIGNAL = CODE; --Raised when one of the following procedures is called and there is no ColorTool viewer available
SetRGBValue:
PUBLIC
PROC[rgb:
RGB, viewer: Viewer ¬
NIL] = {
handle: Handle ¬ GetHandle[viewer];
Update[[rgb.R, rgb.G, rgb.B], handle, $rgb];
};
GetRGBValue:
PUBLIC
PROC[viewer: Viewer ¬
NIL]
RETURNS [
RGB] = {
handle: Handle ¬ GetHandle[viewer];
RETURN[handle.lastValue];
};
SetCSLValue:
PUBLIC
PROC [csl:
CSL, viewer: Viewer ¬
NIL] = {
handle: Handle ¬ GetHandle[viewer];
hsl: HSL ~ CNSColor.HSLFromCSL[csl];
Update[[hsl.H, hsl.S, hsl.L], handle, $hsl];
};
GetCSLValue:
PUBLIC
PROC[viewer: Viewer ¬
NIL]
RETURNS [
CSL] = {
handle: Handle ¬ GetHandle[viewer];
hsl: HSL ~ ColorFns.HSLFromRGB[handle.lastValue];
RETURN[CNSColor.CSLFromHSL[hsl]];
};
GetColor:
PUBLIC
PROC [viewer: Viewer ¬
NIL]
RETURNS [ImagerColor.ConstantColor] = {
handle: Handle ¬ GetHandle[viewer];
IF handle.specialColor#NIL THEN RETURN[handle.specialColor]
ELSE RETURN[ImagerColor.ColorFromRGB[handle.lastValue]];
};
SetColor:
PUBLIC
PROC [color: ImagerColor.Color, viewer: Viewer ¬
NIL] = {
handle: Handle ¬ GetHandle[viewer];
WITH color
SELECT
FROM
constant: ImagerColor.ConstantColor => {
rgb: RGB ¬ RGBFromColor[constant];
Update[[rgb.R, rgb.G, rgb.B], handle, rgb];
WITH constant
SELECT
FROM
special: ImagerColor.SpecialColor => {
UpdateSpecial[special, special.name, handle];
};
ENDCASE => NULL;
};
ENDCASE => NULL; --sampled colors do nothing
};
RGBFromColor:
PROC [color: ImagerColor.ConstantColor]
RETURNS [
RGB] ~ {
RETURN[ImagerColor.RGBFromColor[ImagerColor.NarrowToOpConstantColor[color]]];
};
This mechanism allows a client of the ColorTool to request being called whenever the color changes. The ColorTool will keep a SymTab of procedures to support multiple clients. If there are multiple colortools, only one will get the registery.
NotifyProc: TYPE = ColorTool.NotifyProc;
Notifier: TYPE = REF NotifierRep;
NotifierRep:
TYPE =
RECORD [
notifyProc: NotifyProc,
notifyData: REF
];
RegisterNotifyProc:
PUBLIC
PROC[id:
ATOM, notifyProc: NotifyProc, data:
REF, viewer: Viewer ¬
NIL] = {
handle: Handle ¬ GetHandle[viewer];
idRope: ROPE ¬ Convert.RopeFromAtom[id, FALSE];
IF handle.notify=NIL THEN handle.notify ¬ SymTab.Create[];
[] ¬ SymTab.Store[x: handle.notify, key: idRope, val: NEW[NotifierRep ¬ [notifyProc: notifyProc, notifyData: data]]];
notifyProc[handle.lastValue, data];
};
RemoveProc:
PUBLIC
PROC[id:
ATOM, viewer: Viewer ¬
NIL] = {
handle: Handle ¬ GetHandle[viewer];
idRope: ROPE ¬ Convert.RopeFromAtom[id, FALSE];
[] ¬ SymTab.Delete[x: handle.notify, key: idRope];
};
GetHandle:
PROC[viewer: Viewer ¬
NIL]
RETURNS[Handle] = {
IF viewer=NIL THEN viewer ¬ ViewerOps.FindViewer["ColorTool"];
IF viewer=NIL THEN ERROR NoColorToolViewer
ELSE RETURN[NARROW[ViewerOps.FetchProp[viewer, $ColorTool]]];
};
Create:
PUBLIC
PROC
RETURNS[Viewer] = {
column: ViewerClasses.Column ¬ left;
outer: Viewer ¬ Containers.Create[info: [
name: "ColorTool",
iconic: TRUE,
column: column,
scrollable: TRUE ],
paint: FALSE ];
handle: Handle ¬ NEW[HandleRec];
sw: INT ¬ 128; --slider width
sh: INT ¬ 18; --slider height
xOrg: INT ¬ 10;
x,y: INT ¬ 0;
hSpace: INT ¬ 10;
vSpace: INT ¬ 15;
fudge: INT ¬ 6;
y ¬ 10;
x ¬ xOrg;
handle.rgb ¬ ColorSchemeViewer.Create[
labels: ["R","G","B"],
sw: sw, sh: sh,
notify: UpdateRGB,
title: "Red, Green, Blue",
clientData: handle,
parent: outer,
wx: x, wy: y
];
ColorSchemeViewer.SetSliderColors[handle.rgb, [
ImagerColor.ColorFromRGB[[1,0,0]],
ImagerColor.ColorFromRGB[[0,1,0]],
ImagerColor.ColorFromRGB[[0,0,1]]
]];
211 by 85 for sw=128, sh=18
x ¬ x+handle.rgb.ww+1;
handle.patch ¬ ColorPatch.MakeColorPatch[
[wx: x, wy: y, ww: 150, wh: 85, parent: outer], [mapIndex: 128, red: 127, green: 127, blue: 127]];
x ¬ x+handle.patch.ww+hSpace+fudge;
handle.hsl ¬ ColorSchemeViewer.Create[
labels: ["H","S","L"],
sw: sw, sh: sh,
notify: UpdateHSL,
title: "Hue, Saturation, Lightness",
clientData: handle,
parent: outer,
wx: x, wy: y
];
x ¬ xOrg;
y ¬ y+handle.rgb.wh+vSpace;
handle.cmy ¬ ColorSchemeViewer.Create[
labels: ["C","M","Y"],
sw: sw, sh: sh,
notify: UpdateCMY,
title: "Cyan, Magenta, Yellow",
clientData: handle,
parent: outer,
wx: x, wy: y
];
ColorSchemeViewer.SetSliderColors[handle.cmy, [
ImagerColor.ColorFromRGB[ColorFns.RGBFromCMY[[1,0,0]]],
ImagerColor.ColorFromRGB[ColorFns.RGBFromCMY[[0,1,0]]],
ImagerColor.ColorFromRGB[ColorFns.RGBFromCMY[[0,0,1]]]
]];
x ¬ x+handle.rgb.ww+1;
{
vfont: VFonts.Font ¬ VFonts.EstablishFont["helvetica", 10, TRUE];
bw: INT ¬ VFonts.StringWidth["SET FROM NAME", vfont]+8; --button width
bh: INT ¬ VFonts.FontHeight[vfont]+1;
localY: INT ¬ y;
makeText:
PROC[data:
ROPE]
RETURNS[Viewer] = {
[]¬ VFonts.EstablishFont["tioga", 10, TRUE];
RETURN[ViewerTools.MakeNewTextViewer[info: [
parent: outer,
wx: x, wy: localY,
ww: handle.patch.ww, wh: 2*VFonts.FontHeight[]+12,
data: data,
scrollable: TRUE,
border: TRUE ], paint: FALSE]];
};
handle.setName ¬ Buttons.Create[
info: [
name: "SET FROM NAME",
wx: x,
wy: localY,
wh: bh,
ww: bw,
parent: outer,
border: TRUE ],
clientData: handle,
font: vfont,
fork: FALSE,
documentation: "Sets the color from the name",
proc: SetNamedColor,
paint: FALSE ];
localY ¬ localY+handle.setName.wh;
handle.name ¬ makeText["Gray"];
localY ¬ localY+handle.name.wh;
bw ¬ VFonts.StringWidth["SET REGISTERED COLOR", vfont]+8;
handle.setRegistered ¬ Buttons.Create[
info: [
name: "SET REGISTERED COLOR",
wx: x,
wy: localY,
wh: bh,
ww: bw,
parent: outer,
border: TRUE ],
clientData: handle,
font: vfont,
fork: FALSE,
documentation: "Sets a registered color from the hierarchical name",
proc: SetRegisteredColor,
paint: FALSE ];
localY ¬ localY+handle.setRegistered.wh;
handle.registered ¬ makeText[""];
};
x ¬ x+handle.name.ww+hSpace+fudge;
handle.hsv ¬ ColorSchemeViewer.Create[
labels: ["H","S","V"],
sw: sw, sh: sh,
notify: UpdateHSV,
title: "Hue, Saturation, Value",
clientData: handle,
parent: outer,
wx: x, wy: y
];
handle.self ¬ outer;
ViewerOps.AddProp[outer, $ColorTool, handle];
ViewerOps.SetOpenHeight[outer, y+handle.hsl.wh+vSpace];
Update[[0.5, 0.5, 0.5], handle, rgb];
ViewerOps.OpenIcon[outer];
RETURN[outer];
};
Changes: TYPE = ColorSchemeViewer.Changes;
UpdateRGB: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], rgb]};
UpdateCMY: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], cmy]};
UpdateHSV: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], hsv]};
UpdateHSL: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], hsl]};
SetRegisteredColor: Buttons.ButtonProc = {
self: Viewer ¬ NARROW[parent];
data: Handle ¬ NARROW[clientData];
rope: ROPE ¬ ViewerTools.GetContents[data.registered];
color: ImagerColor.ConstantColor ¬ ImagerColor.Find[rope];
IF color=NIL THEN color ¬ ImagerColor.Find[Rope.Concat["Xerox/Research/", rope]]; -- retry
IF color=NIL THEN ViewerTools.SetContents[data.registered,
Rope.Concat[rope, " is not a registered color"]]
ELSE {
found a registered color. May not have sensible rgb value, but set it anyway
rgb: RGB ~ RGBFromColor[color];
Update[[rgb.R, rgb.G, rgb.B], data, $rgb];
UpdateSpecial[color, rope, data];
};
};
UpdateSpecial:
PROC[color: ImagerColor.ConstantColor, name:
ROPE, handle: Handle] = {
IF Rope.Match["*ChipNDale*", name,
FALSE]
THEN {
initial: ImagerColor.ConstantColor ¬ ImagerColor.Find["Xerox/Research/ChipNDale/CD/InitialColor"];
ColorPatch.PaintSpecial[handle.patch, initial];
};
ColorPatch.PaintSpecial[handle.patch, color];
ViewerTools.SetContents[handle.registered, name];
handle.specialColor ¬ color;
};
SetNamedColor: Buttons.ButtonProc = {
self: Viewer ¬ NARROW[parent];
data: Handle ¬ NARROW[clientData];
rope: ROPE ¬ ViewerTools.GetContents[data.name];
{
ENABLE NamedColors.UndefinedName, NamedColors.BadGrammar => {
ViewerTools.SetContents[data.name, Rope.Concat[rope, " is an invalid color name"]];
CONTINUE};
hsl: HSL ¬ NamedColors.RopeToHSL[rope];
Update[[hsl.H, hsl.S, hsl.L], data, name]
};
};
Update:
PROC [values:
ARRAY [1..3]
OF
REAL, handle: Handle, who: ColorScheme] = {
cmy: CMY;
hsl: HSL;
hsv: HSV;
colorName: Rope.ROPE;
doNotify: SymTab.EachPairAction = {
notifier: Notifier ¬ NARROW[val];
IF notifier.notifyProc#NIL THEN notifier.notifyProc[handle.lastValue, notifier.notifyData];
};
rgbColor: RGB;
rgbColor ¬
SELECT who
FROM
rgb => [values[1], values[2], values[3]],
cmy => ColorFns.RGBFromCMY[[values[1], values[2], values[3]]],
hsl, name => ColorFns.RGBFromHSL[[values[1], values[2], values[3]]],
hsv => ColorFns.RGBFromHSV[[values[1], values[2], values[3]]],
ENDCASE => ERROR;
IF rgbColor=handle.lastValue THEN RETURN
ELSE handle.lastValue ¬ rgbColor;
cmy ¬ ColorFns.CMYFromRGB[rgbColor];
hsl ¬ ColorFns.HSLFromRGB[rgbColor];
hsv ¬ ColorFns.HSVFromRGB[rgbColor];
colorName ¬ NamedColors.HSLToRope[hsl];
[] ¬ ColorSchemeViewer.SetValues[handle.rgb, [rgbColor.R, rgbColor.G, rgbColor.B]];
[] ¬ ColorSchemeViewer.SetValues[handle.cmy, [cmy.C, cmy.M, cmy.Y]];
[] ¬ ColorSchemeViewer.SetValues[handle.hsl, [hsl.H, hsl.S, hsl.L]];
[] ¬ ColorSchemeViewer.SetValues[handle.hsv, [hsv.H, hsv.S, hsv.V]];
ColorPatch.PaintColorPatch[handle.patch, rgbColor];
ViewerTools.SetContents[handle.name, colorName];
IF handle.notify#NIL THEN [] ¬ SymTab.Pairs[handle.notify, doNotify];
handle.specialColor ¬ NIL;
};
Init: Commander.CommandProc = {
WITH cmd.procData.clientData
SELECT
FROM
a: ATOM => IF (a = $ces) THEN {msg ¬ "This command has been retracted"; RETURN};
ENDCASE => NULL;
[] ¬ Create[]
};
Commander.Register[key: "ColorTool", proc: Init, doc: "Create a color tool", clientData: $original];
Commander.Register[key: "CesColorTool", proc: Init, doc: "This command has been retracted", clientData: $ces];
END.