DIRECTORY
ColorSchemeViewer,
ViewerClasses USING [Viewer, ViewerClass, PaintProc, ViewerClassRec],
ViewerOps USING [PaintViewer, CreateViewer, RegisterViewerClass, EstablishViewerPosition, PaintHint],
VFonts USING [CharWidth, FontHeight, EstablishFont, StringWidth, Font],
ViewerTools USING [MakeNewTextViewer, GetContents, SetContents],
Real USING [Round],
Convert USING [RealFromRope, RopeFromReal],
MessageWindow USING [Append],
ImagerFont USING [Font, Find, Extents, RopeEscapement, RopeBoundingBox],
Buttons USING [ButtonProc, Create], 
Sliders USING [SliderProc, Slider, Create, SetContents, GetContents, FilterProc],
Rope USING [ROPE, Length],
Imager;
ColorSchemeViewerImpl: CEDAR PROGRAM
IMPORTS ViewerOps, ImagerFont, Imager, Buttons, Sliders, Rope, VFonts, ViewerTools, Convert, MessageWindow, Real
EXPORTS ColorSchemeViewer
~ BEGIN OPEN ColorSchemeViewer;

ROPE: TYPE = Rope.ROPE;
Context: TYPE = Imager.Context;
Viewer: TYPE = ViewerClasses.Viewer;
Data: TYPE = REF DataRec;
DataRec: TYPE = RECORD [
button: Viewer,
title: Label,
sliders: ARRAY [1..3] OF Sliders.Slider,
text: ARRAY [1..3] OF Viewer,
labels: ARRAY [1..3] OF Label,
values: ARRAY [1..3] OF REAL, 	-- same values as Sliders.GetContents
notify: NotifyProc,	--called when values change
clientData: REF
];
Label: TYPE = REF LabelRec;
LabelRec: TYPE = RECORD [
rope: ROPE,
lx,ly: REAL,	--for showing the rope
font: Imager.Font,
wx,wy: INT,	--lower left corner of the label
ww,wh: INT	--overall size
];

Create: PUBLIC PROC [labels: ARRAY [1..3] OF ROPE, sw, sh: INT, notify: NotifyProc, title: ROPE _ NIL, clientData: REF _ NIL, parent: Viewer _ NIL, wx, wy: INTEGER _ 0] RETURNS [Viewer] = {
vgap: INT _ sh/3;	--gap between sliders
hgap: INT _ sh;	--gap between sliders and text viewer
lWidth: INT;
xOrg: INT _ 0;
yOrg: INT _ 0;
data: Data _ NEW[DataRec];
new: Viewer _ ViewerOps.CreateViewer[flavor: $ColorScheme,
info: [parent: parent,
wx: wx, wy: wy,
border: parent=NIL,	--no border on nested viewers
data: data], paint: FALSE];
data.notify _ notify;
data.clientData _ clientData;
{
max: REAL _ 0;
font: ImagerFont.Font _ SELECT TRUE FROM
sh < 14 => ImagerFont.Find["Xerox/TiogaFonts/Helvetica10B"],
sh IN [14..22] => ImagerFont.Find["Xerox/TiogaFonts/Helvetica12B"],
sh IN [22..28] => ImagerFont.Find["Xerox/TiogaFonts/Helvetica14B"],
sh > 28 => ImagerFont.Find["Xerox/TiogaFonts/Helvetica16B"],
ENDCASE => ImagerFont.Find["Xerox/TiogaFonts/Helvetica10"];
x: INT _ xOrg;
y: INT _ yOrg;
FOR i: NAT IN [1..3] DO	--compute the width of the labels
max _ MAX[max, ImagerFont.RopeEscapement[font, labels[i],0, Rope.Length[labels[i]]].x];
ENDLOOP;
lWidth _ MAX[Real.Round[1.2*max], Real.Round[max]+6];  --the label and its box
FOR i: NAT DECREASING IN [1..3] DO	--format the labels
data.labels[i] _ FormatLabel[labels[i], x, y, lWidth, sh, font];
y _ y+sh+vgap;
ENDLOOP;
};
{
x: INT _ xOrg+lWidth;
y: INT _ yOrg;
FOR i: NAT DECREASING IN [1..3] DO
data.sliders[i] _ Sliders.Create[info: [parent: new, wx: x, wy: y, ww: sw, wh: sh], 
sliderProc: SliderProc,
filterProc: FilterProc,
orientation: horizontal,
clientData: NEW[SliderData _ [i,data]],
paint: FALSE];
y _ y+sh+vgap;
ENDLOOP;
};
{
w:  NAT _ 8 * VFonts.CharWidth['0];  -- 8 digits worth of width
h: NAT _ VFonts.FontHeight[]+2;	--need space for the caret and selection
x: INT _ xOrg+lWidth+sw+hgap;
y: INT _ yOrg+(sh-h)/2;
FOR i: NAT DECREASING IN [1..3] DO
data.text[i] _ ViewerTools.MakeNewTextViewer[info: [
parent: new,
wx: x, wy: y, ww: w, wh: h, 
data: "0.5",
scrollable: FALSE,
border: FALSE ], paint: FALSE];
y _ y+sh+vgap;
ENDLOOP;
{
bOffset: INT _ vgap/2;
vfont: VFonts.Font _ VFonts.EstablishFont["helvetica", 10, TRUE];
bw: INT _ VFonts.StringWidth["SET", vfont]+8;	--button width
bh: INT _ VFonts.FontHeight[vfont]+1;
by: INT _ yOrg+3*sh+2*vgap+bOffset;	--button y position
data.button _ Buttons.Create[
info: [
name: "SET",
wx: x,
wy: by,
wh: bh,
ww: bw,
parent: new,
border: TRUE ],
clientData: data,
font: vfont,
fork: TRUE,
documentation: "Sets the values in the text viewers", 
proc: ButtonProc,
paint: FALSE ];
data.title _ NEW[LabelRec _ [
rope: title,
lx: 0,
ly: 2,	--to align with button text
font: vfont,
wx: xOrg,
wy: by,
ww: VFonts.StringWidth[title, vfont],	--last 4 not used unless I box the title
wh: bh
]];
new.ww _ xOrg+lWidth+sw+hgap+w+1;  --label+slider+gap+text+1
new.wh _ yOrg+3*sh+2*vgap+bOffset+bh+2; --3*sliders+2*gap+button+2
ViewerOps.EstablishViewerPosition[new, new.wx, new.wy, new.ww, new.wh];  --make viewers notice it
};
};
FOR i: NAT IN [1..3] DO
data.values[i] _ .5;
Sliders.SetContents[slider: data.sliders[i], contents: data.values[i]]
ENDLOOP;
RETURN[new];
};
ButtonProc: Buttons.ButtonProc = { ENABLE BadValue => CONTINUE;  --refuses to set bad values
self: Viewer _ NARROW[parent];
data: Data _ NARROW[clientData];
values: ARRAY [1..3] OF REAL _ data.values;
changes: Changes;
FOR i: NAT IN [1..3] DO
values[i] _ GetTextValue[data.text[i]];
ENDLOOP;
changes _ SetValues[self.parent, values];
ViewerOps.PaintViewer[self.parent, client, FALSE, NEW[Changes _ changes]];
data.notify[data.values, changes, data.clientData];
};

BadValue: SIGNAL = CODE;
GetTextValue: PROCEDURE [v: ViewerClasses.Viewer] RETURNS [value: REAL] = {
rope: Rope.ROPE ~ ViewerTools.GetContents[v];
IF rope=NIL THEN RETURN[0];
value _ Convert.RealFromRope[rope];
IF value > 1.0 OR value < 0.0 THEN {
MessageWindow.Append[message: "Invalid value ", clearFirst: TRUE];
MessageWindow.Append[message: rope, clearFirst: FALSE];
SIGNAL BadValue;
};
RETURN[value];
};

SliderData: TYPE = RECORD[v: NAT, data: Data];
SliderProc: Sliders.SliderProc = {
sd: REF SliderData _ NARROW[clientData];
changes: Changes _ SELECT sd.v FROM 1 => v1, 2 => v2, 3 => v3, ENDCASE => ERROR;
IF reason=move AND sd.data.values[sd.v] = value THEN RETURN;
sd.data.values[sd.v] _ value;
PutText[viewer: sd.data.text[sd.v], contents: value];
sd.data.notify[sd.data.values, changes, sd.data.clientData];
};
FilterProc: Sliders.FilterProc = {RETURN[Real.Round[value*1000]/1000.0]};  --4 digits

FormatLabel: PROC [rope: ROPE, x, y, w, h: INT, font: ImagerFont.Font] RETURNS[Label] = {
extents: ImagerFont.Extents _ ImagerFont.RopeBoundingBox[font, rope, 0, Rope.Length[rope]];
label: Label _ NEW[LabelRec _ [
rope: rope,
lx: (w-extents.rightExtent+extents.leftExtent)/2,
ly: extents.descent+(h-(extents.descent+extents.ascent))/2,	
font: font,
wx: x,
wy: y,
ww: w,
wh: h
]];
RETURN[label];
};
PutText: PROC [viewer: Viewer, contents: REAL] = {
rounded: REAL _ Real.Round[1000*contents]/1000.0;
ViewerTools.SetContents[viewer: viewer, contents: Convert.RopeFromReal[rounded], paint: TRUE];
};
SetValues: PUBLIC PROC [viewer: Viewer, values: ARRAY [1..3] OF REAL, notify: BOOLEAN _ FALSE] RETURNS [Changes]= {
changes: Changes;
data: Data _ NARROW[viewer.data];
v: NAT _ 0;
update: PROC [i: NAT] = {
PutText[viewer: data.text[i], contents: values[i]];
Sliders.SetContents[slider: data.sliders[i], contents: values[i]];
data.values[i] _ values[i];
};
IF data.values[1] # values[1] THEN {update[1]; v _ 1};
IF data.values[2] # values[2] THEN {update[2]; v _ v+2};
IF data.values[3] # values[3] THEN {update[3]; v _ v+4};
changes _ SELECT v FROM 0 => none, 1 => v1, 2 => v2, 4 => v3, ENDCASE => allValues;
IF notify THEN data.notify[data.values, changes, data.clientData];
RETURN[changes];
};

GetValues: PUBLIC PROC[viewer: Viewer] RETURNS[v1, v2, v3: REAL] = {
data: Data _ NARROW[viewer.data];
RETURN[data.values[1], data.values[2], data.values[3]];
};

Paint: PUBLIC PROC [viewer: Viewer, context: Imager.Context, whatChanged: Changes] ~ {
data: Data _ NARROW[viewer.data];
doValue: PROC [v: NAT, paintHint: ViewerOps.PaintHint] = {
ViewerOps.PaintViewer[data.sliders[v], paintHint, TRUE];
ViewerOps.PaintViewer[data.text[v], paintHint, TRUE];
};

SELECT whatChanged FROM
v1 => doValue[1, client];
v2 => doValue[2, client];
v3 => doValue[3, client];
allValues => FOR i: NAT IN [1..3] DO doValue[i, client]; ENDLOOP;
ENDCASE => {	--paintViewer
ViewerOps.PaintViewer[data.button, all, TRUE];
PaintLabel[data.title, context, FALSE];
FOR i: NAT IN [1..3] DO
doValue[i, all];
PaintLabel[label: data.labels[i], context: context, outline: TRUE]; 
ENDLOOP;
};
};

SetSliderColors: PUBLIC PROC [viewer: Viewer, colors: ARRAY [1..3] OF Imager.Color] = {
data: Data _ NARROW[viewer.data];
FOR i: NAT IN [1..3] DO
old: Viewer _ data.sliders[i];
data.sliders[i] _ Sliders.Create[info: [parent: viewer, wx: old.wx, wy: old.wy, ww: old.ww, wh: old.wh], 
sliderProc: SliderProc,
filterProc: FilterProc,
orientation: horizontal,
foreground: colors[i],
clientData: NEW[SliderData _ [i,data]],
paint: TRUE];
Sliders.SetContents[data.sliders[i], Sliders.GetContents[old]];
ENDLOOP;
};

PaintLabel: PROC[label: Label, context: Context, outline: BOOLEAN] = {
action: PROC = {
IF outline THEN OutlineBox[context, label.wx, label.wy, label.ww, label.wh];
Imager.TranslateT[context, [label.wx, label.wy]];
Imager.SetXY[context, [label.lx, label.ly]];
Imager.SetFont[context, label.font];
Imager.ShowRope[context, label.rope];
};
Imager.DoSave[context, action]
};

OutlineBox: PROC [context: Context, x, y, w, h: INT] = {
Imager.SetColor[context, Imager.black];
Imager.SetStrokeWidth[context, 1];
Imager.SetStrokeEnd[context, square];
x _ x; y _ y+1;	--match viewer conventions
w _ w-1; h _ h-1;	--match viewer conventions
Imager.MaskVectorI[context, x, y, x, y+h];
Imager.MaskVectorI[context, x, y+h, x+w, y+h];
Imager.MaskVectorI[context, x+w, y+h, x+w, y];
Imager.MaskVectorI[context, x+w, y, x, y];
};

myClass: ViewerClasses.ViewerClass = NEW[ViewerClasses.ViewerClassRec _ [
flavor:$ColorScheme,
paint: PaintProc
]];
PaintProc: ViewerClasses.PaintProc = {
IF whatChanged = NIL THEN Paint[self, context, paintViewer]
ELSE {
changes: REF Changes _ NARROW[whatChanged];
Paint[self, context, changes^];
};
RETURN[TRUE];
};
ViewerOps.RegisterViewerClass[$ColorScheme, myClass];
END.

ΔColorSchemeViewerImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Maureen Stone, March 23, 1987 5:04:25 pm PST
Pier, March 13, 1987 1:44:13 pm PST

NotifyProc: TYPE = PROC [v1, v2, v3: REAL, client: REF]; 

Format the labels.  The labels are the same height as the sliders.  The width is based on the width of the longest rope.  Labels are flush with the left edge of the viewer 
Create the sliders.  The sliders are flush with the right edge of the labels
Create the text viewers.  They sit hgap to the right of the sliders
Create the "Set" button.  This is used to make the viewer notice that the text viewers have been edited.  The button is positioned over the text viewers, bOffset above the top one.
Add the title.  It is flush left with the sliders and at the same height as the Set button
now we can set the total size of the viewer
Changes: none, v1, v2, v3, allValues, paintViewer.  
For the red, green, blue colored sliders.
Κa˜
code™Kšœ
Οm
œ1™<K™,K™#—š
Οk	˜	Kš
œ˜Kšœ
žœ2˜EKšœ	žœV˜eKšœžœ;˜GKšœžœ/˜@Kšœžœ	˜Kšœžœ˜+Kšœ
žœ
˜Kšœ
žœ8˜HKšœžœ˜$KšœžœD˜QKšœžœžœ
˜Kš
œ˜K™—šΠblœžœ
ž˜$Kšžœi˜pKšžœ˜—šœžœ
žœ˜K˜Kšžœžœžœ
˜Kšœ	žœ˜Kšœžœ˜$Kšœžœžœ	˜šœ	žœžœ˜K˜Kš
œ
˜
Kšœ	žœžœ˜(Kšœžœžœ˜Kšœžœžœ˜KšœžœžœΟc%˜DKšœ ˜/Kšœž˜K˜—Kšœžœžœ
˜šœ
žœžœ˜Kšœžœ
˜Kšœžœ ˜#K˜Kšœžœ
  ˜,Kšœžœ
 ˜K˜K˜—Kš
Οn
œžœžœžœ
žœ™9K™š‘œžœ
žœ
žœžœ
žœ
žœžœžœžœžœžœ
žœžœ
˜½
Kšœžœ	 ˜'Kšœžœ %˜5Kšœžœ
˜Kšœžœ˜Kšœžœ˜Kšœ
žœ
˜š
œ:˜:Kš
œ˜Kš
œ˜Kšœžœ
 ˜1Kšœžœ˜—K˜Kš
œ˜˜
K™¬
Kšœžœ˜šœžœ
žœ
ž˜(Kš
œ<˜<Kšœžœ>˜CKšœžœ>˜CKš
œ<˜<Kšžœ4˜;—Kšœžœ˜Kšœžœ˜š	žœžœ
žœžœ
 !˜9KšœžœN˜WKšžœ
˜—Kšœ	žœ+ ˜Nš	žœžœ
ž
œžœ
 ˜6Jš
œ@˜@J˜Kšžœ
˜—K˜—˜
K™LKšœžœ˜Kšœžœ˜šžœžœ
ž
œž˜"˜TKš
œ˜Kš
œ˜Kš
œ˜Kšœžœ˜'Kšœžœ˜—J˜Kšžœ
˜—K˜—˜
K™CKšœžœ ˜?Kšœžœ (˜HKšœžœ˜Kšœžœ˜šžœžœ
ž
œž˜"š
œ4˜4Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ
˜Kšœžœžœ˜—J˜Kšžœ
˜—˜
K™΄
Kšœ	žœ
˜Kšœ;žœ˜AKšœžœ' ˜<Kšœžœ˜%Kšœžœ ˜7š
œ˜š
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ˜—Kš
œ˜K˜Kšœžœ
˜Kš
œ6˜6Kš
œ˜Kšœžœ˜—K™Zšœ
žœ
˜K˜Kš
œ˜Kšœ ˜"Kš
œ˜Kš
œ	˜	Kš
œ˜Kšœ& (˜NK˜K˜—K™+Kšœ! ˜<Kšœ' ˜BKšœI ˜aK˜—K˜—šžœžœ
žœž˜K˜Kš
œF˜FKšžœ
˜—Kšžœ˜K˜—šœ#žœ
žœ ˜\Kšœžœ	˜Kšœ
žœ
˜ Kšœžœžœ
žœ˜+K˜šžœžœ
žœž˜Kš
œ'˜'Kšžœ
˜—K˜)Kšœ*žœ˜JKš
œ3˜3K˜K˜—Kšœ
žœžœ
˜š‘œž	œžœ	žœ˜KKšœžœ˜-Kšžœžœ
žœ
žœ˜K˜#šžœ
žœ
žœ˜$Kšœ<žœ˜BKšœ0žœ˜7Jšžœ
˜Kš
œ˜—Kšžœ˜K˜K˜—Kšœžœžœžœ˜.š
œ"˜"Kšœžœžœ
˜(Kš	œžœžœžœžœ
˜PKšžœ
žœžœ
žœ
˜<Kš
œ˜Kš
œ5˜5Kš
œ<˜<K˜—šœ"žœ# 
˜UK˜—š
‘œžœžœžœžœ˜YKš
œ[˜[šœžœ
˜K˜Kš
œ1˜1Kšœ; 
˜<K˜K˜K˜K˜K˜K˜—Kšžœ˜K˜—š‘œžœžœ˜2Kšœ	žœ$˜1KšœXžœ˜^K˜—š‘	œžœ
žœžœžœ
žœžœžœžœ
˜sKš
œ˜Kšœ
žœ˜!Kšœžœ˜šœžœžœ˜Kš
œ3˜3Kš
œB˜BK˜K˜—Kšžœžœ˜6Kšžœžœ˜8Kšžœžœ˜8Kšœ
žœžœ'žœ˜SKšžœžœ4˜BKšžœ
˜K˜K˜—š‘	œžœžœ
žœ˜DKšœ
žœ˜!Kšžœ1˜7K˜—K˜Kš‘œžœ
žœD˜Vš
œ4™4Kšœ
žœ˜!šœ	žœžœ%˜:Kšœ2žœ˜8Kšœ/žœ˜5K˜K˜—šžœ
ž˜K˜K˜K˜Kšœ
žœžœ
žœžœžœ
˜Ašžœ 
˜Kšœ(žœ˜.Kšœ žœ˜'šžœžœ
žœž˜Kš
œ˜Kšœ=žœ˜DKšžœ
˜—K˜——K˜—K˜š‘œžœžœžœ˜WK™)Kšœ
žœ˜!šžœžœž˜K˜˜iKš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ˜'Kšœžœ˜
—K˜?Kšžœ
˜—K˜K˜—š‘
œžœ*žœ˜Fšœžœ˜Kšžœ	žœ=˜LKš
œ1˜1K˜,K˜$K˜%K˜—K˜Kš
œ˜K˜—š‘
œžœ žœ˜8K˜'K˜"Kš
œ%˜%Kšœ ˜*Kšœ ˜,K˜*K˜.K˜.K˜*K˜K˜—šœ%žœ!˜IKš
œ˜Kš
œ˜K˜—š
œ&˜&Kšžœžœ
žœ"˜;šžœ˜Kšœ	žœžœ˜+Kš
œ˜K˜—Kšžœ
žœ˜
Kš
œ˜—K˜5Kšžœ
˜—J˜—…—&–5»