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;
~
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
];
NotifyProc: TYPE = PROC [v1, v2, v3: REAL, client: REF];
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;
{
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
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;
};
{
Create the sliders. The sliders are flush with the right edge of the labels
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;
};
{
Create the text viewers. They sit hgap to the right of the sliders
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;
{
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.
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 ];
Add the title. It is flush left with the sliders and at the same height as the Set button
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
]];
now we can set the total size of the viewer
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] ~ {
Changes: none, v1, v2, v3, allValues, paintViewer.
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] = {
For the red, green, blue colored sliders.
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.