DIRECTORY Buttons, CedarProcess, Controls, ControlsPrivate, Convert, Imager, Labels, MessageWindow, Rope, TiogaOps, TIPLinking, TIPUser, Vector2, VFonts, ViewerClasses, ViewerOps, ViewerTools;

ControlsImpl: CEDAR MONITOR
IMPORTS Buttons, CedarProcess, Controls, ControlsPrivate, Convert, Imager, Labels, MessageWindow, Rope, TiogaOps, TIPLinking, TIPUser, VFonts, ViewerOps, ViewerTools
EXPORTS Controls, ControlsPrivate

~ BEGIN
Button:					TYPE ~ Controls.Button;
Control:					TYPE ~ Controls.Control;
ControlList:				TYPE ~ Controls.ControlList;
ControlProc:				TYPE ~ Controls.ControlProc;
ControlRep:				TYPE ~ Controls.ControlRep;
ControlSizes:				TYPE ~ Controls.ControlSizes;
ControlType:				TYPE ~ Controls.ControlType;
Detent:					TYPE ~ Controls.Detent;
DetentList:				TYPE ~ Controls.DetentList;
IntegerPair:				TYPE ~ Controls.IntegerPair;
Mouse:					TYPE ~ Controls.Mouse;
OuterData:				TYPE ~ Controls.OuterData;
RealSequence:			TYPE ~ Controls.RealSequence;
SliderTaper:				TYPE ~ Controls.SliderTaper;
TextLocation:				TYPE ~ Controls.TextLocation;
RopeFromValueProc:	TYPE ~ ControlsPrivate.RopeFromValueProc;
SetValueFromRopeProc:	TYPE ~ ControlsPrivate.SetValueFromRopeProc;
Color:						TYPE ~ Imager.Color;
Font:						TYPE ~ Imager.Font;
ROPE:						TYPE ~ Rope.ROPE;
Viewer:					TYPE ~ ViewerClasses.Viewer;
NewControl: PUBLIC PROC [
name: ROPE ฌ NIL,
type: ControlType ฌ vSlider,
clientData: REF ANY ฌ NIL,
min: REAL ฌ 0.0,
max: REAL ฌ 1.0,
init: REAL ฌ 0.5,
proc: ControlProc ฌ NIL,
report: BOOL ฌ TRUE,
precision: NAT ฌ 0,
row: INTEGER ฌ 0,
x, y: INTEGER ฌ 0,
w, h: INTEGER ฌ 0,
textLocation: TextLocation ฌ [up, left],
dummy: BOOL ฌ FALSE,
detents: DetentList ฌ NIL,
taper: SliderTaper ฌ lin,
queue: BOOL ฌ FALSE,
values: RealSequence ฌ NIL,
color: Color ฌ Imager.black,
font: Font ฌ NIL,
clientUse: ATOM ฌ $None,
flavor: ATOM ฌ $Nil]
RETURNS [c: Control]
~ {
c ฌ NEW[ControlRep];
IF type = dial THEN w ฌ h ฌ MIN[w, h];
c.name ฌ name;
c.type ฌ type;
c.proc ฌ proc;
c.report ฌ report;
c.precision ฌ precision;
c.row ฌ row;
c.x ฌ x;
c.y ฌ y;
c.w ฌ w;
c.h ฌ h;
c.textLocation ฌ textLocation;
c.dummy ฌ dummy;
c.flavor ฌ flavor;
c.clientData ฌ clientData;
c.min ฌ min;
c.max ฌ max;
c.init ฌ init;
c.value ฌ init;
c.values ฌ values;
c.detents ฌ detents;
c.taper ฌ taper;
c.queue ฌ queue;
c.color ฌ color;
c.font ฌ font;
c.clientUse ฌ clientUse;
IF type = function AND w # 0 THEN ControlsPrivate.NewFunction[c];
};

Append: PUBLIC PROC [control: Control, controls: ControlList ฌ NIL]
RETURNS [ControlList] ~ {
tail: ControlList ฌ controls;
List: TYPE ~ RECORD[first: Control, rest: REF List ฌ NIL];
IF tail = NIL THEN RETURN[LIST[control]];
WHILE tail.rest # NIL DO tail ฌ tail.rest; ENDLOOP;
tail.rest ฌ LIST[control];
RETURN[controls];
};

ControlViewer: PUBLIC PROC [
parent: Viewer,
control: Control,
graphics: Viewer ฌ NIL,
outerData: OuterData ฌ NIL]
~ {
IF control = NIL THEN RETURN;
IF NOT control.dummy THEN {
viewer: Viewer;
control.parent ฌ parent;
control.outerData ฌ outerData;
viewer ฌ ViewerOps.CreateViewer[
flavor: IF control.flavor # $Nil
THEN control.flavor
ELSE SELECT control.type FROM
function => $ControlsFunction,
contour => $ControlsContour,
sketch => $ControlsSketch
ENDCASE => $ControlsSliderDial,
paint: TRUE,
info: [
data: control,
name: control.name,
wx: control.x,
wy: control.y,
ww: control.w,
wh: control.h,
border: SELECT control.type FROM dial, vSlider, hSlider => FALSE, ENDCASE => TRUE,
scrollable: FALSE,
parent: parent]];
control.viewer ฌ viewer;
ViewerOps.AddProp[viewer, $CreatedInOuterViewer, $True];
SELECT control.type FROM
function, contour, sketch => ClearControl[control];
ENDCASE;
IF NOT Rope.IsEmpty[control.name] THEN TitleControl[control];
IF control.report AND control.type # contour AND control.type # sketch
THEN StatusControl[control];
};
SELECT control.type FROM
vSlider, hSlider, dial => ControlsPrivate.NewSliderDial[control];
contour => ControlsPrivate.NewContour[control];
function => ControlsPrivate.NewFunction[control];
sketch => ControlsPrivate.NewSketch[control];
ENDCASE => NULL;
};

SetControlColor: PUBLIC PROC [control: Control, color: Color] ~ {
control.color ฌ color;
};

statusWidth:		INTEGER ~ 32;
lineHeight:		INTEGER ~ 8;
lineMargin:		INTEGER ~ 4;
edgeMargin:		INTEGER ~ 15;
wordMargin:		INTEGER ~ 10;
functionMargin:	INTEGER ~ 10;
dialMargin:		INTEGER ~ 12;
sliderMargin:	INTEGER ~ 17;

ControlPositions: PUBLIC PROC [
controls: ControlList, sizes: ControlSizes, columnWidth: INTEGER]
RETURNS [height: INTEGER] ~ {
x, y: INTEGER ฌ edgeMargin;
titleWidth, row, rowHeight, width: INTEGER ฌ 0;
FOR cc: ControlList ฌ controls, cc.rest WHILE cc # NIL AND cc.first # NIL DO
c: Control ฌ cc.first;
controlMargin: INTEGER ฌ SELECT c.type FROM
dial => dialMargin,
function => functionMargin,
ENDCASE => sliderMargin;
IF c = NIL THEN LOOP;
c.font ฌ VFonts.DefaultFont[c.font];
titleWidth ฌ VFonts.StringWidth[c.name, c.font];
SetControlSize[c, sizes];
SELECT c.row FROM
0, row => NULL;
row+1 => {x ฌ edgeMargin; y ฌ y+rowHeight; row ฌ c.row; rowHeight ฌ 0};
ENDCASE => {
x ฌ edgeMargin; y ฌ edgeMargin+row*rowHeight; row ฌ c.row; rowHeight ฌ 0};
width ฌ SELECT c.type FROM
vSlider, hSlider, dial => MAX[titleWidth, statusWidth],
ENDCASE => titleWidth+statusWidth+wordMargin;
width ฌ SELECT c.textLocation.place FROM
up, down => MAX[c.w+controlMargin, width],
ENDCASE => c.w+controlMargin+width+wordMargin;
IF c.x # 0 OR c.y # 0
THEN {x ฌ c.x; y ฌ c.y}									-- pre-specified control location
ELSE {														-- computed control location
IF x+width > columnWidth
THEN {x ฌ edgeMargin; y ฌ y+rowHeight; row ฌ row+1; rowHeight ฌ 0};
SELECT c.textLocation.place FROM
down => {
c.x ฌ x;
c.y ฌ SELECT c.type FROM
function, contour => y+2*lineMargin+lineHeight,
ENDCASE => y+3*lineMargin+2*lineHeight;
};
left => {
c.x ฌ x+wordMargin+(IF c.textLocation.side
THEN titleWidth+statusWidth
ELSE MAX[titleWidth, statusWidth]);
c.y ฌ y;
};
ENDCASE => {c.x ฌ x; c.y ฌ y};
};
height ฌ ControlHeight[c];
IF height > rowHeight THEN rowHeight ฌ height;
c.row ฌ row;
x ฌ x+width;
ENDLOOP;
height ฌ 0;
FOR c: ControlList ฌ controls, c.rest WHILE c # NIL AND c.first # NIL DO
temp: INTEGER ฌ ControlBaseY[c.first]+ControlHeight[c.first];
height ฌ MAX[height, temp]; 
ENDLOOP;
};

ControlRow: PUBLIC PROC [control: Control, row: INTEGER] ~ {
IF control # NIL THEN control.row ฌ row;
};

ControlBaseY: PROC [control: Control] RETURNS [INTEGER] ~ {
RETURN[IF control.textLocation.place = down
THEN SELECT control.type FROM
function, contour => control.y-2*lineMargin-lineHeight,
ENDCASE => control.y-3*lineMargin-2*lineHeight
ELSE control.y];
};

ControlHeight: PROC [control: Control] RETURNS [height: INTEGER] ~ {
height ฌ sliderMargin+control.h;
IF control.textLocation.place = up OR control.textLocation.place = down THEN {
IF control.report THEN height ฌ height+lineMargin+lineHeight;
IF NOT Rope.IsEmpty[control.name] THEN SELECT control.type FROM
vSlider, hSlider, dial => IF control.textLocation.place = up
THEN height ฌ height+lineMargin+lineHeight
ELSE height ฌ height+2*lineMargin+lineHeight;
ENDCASE;
};
};
clearWidth: NAT ฌ 37;

ClearControl: PROC [control: Control] ~ {
SELECT control.textLocation.place FROM
up, down => {
x: INTEGER ฌ control.x+control.w-clearWidth;
y: INTEGER ฌ IF control.textLocation.place = up
THEN control.y+control.h+lineMargin
ELSE control.y-2*lineMargin;
v: Viewer ฌ Buttons.Create[
[parent: control.parent, name: "Clear", wx: x, wy: y], Clear, control,,,, TRUE];
ViewerOps.AddProp[v, $Control, control];
ViewerOps.AddProp[v, $CreatedInOuterViewer, $True];
};	
ENDCASE;
};

Clear: Buttons.ButtonProc ~ {
c: Control ฌ NARROW[clientData];
SELECT c.type FROM
function => ControlsPrivate.ResetFunction[c];
contour => ControlsPrivate.ClearContour[c];
sketch => ControlsPrivate.ClearSketch[c];
ENDCASE;
};

TitleControl: PROC [control: Control] ~ {
titleWidth: INTEGER ฌ VFonts.StringWidth[control.name, control.font]+10;
x: INTEGER ฌ SELECT control.textLocation.place FROM
up, down => SELECT control.textLocation.edge FROM
center => MAX[control.x-3, (control.w-titleWidth)/2],
right => control.x+control.w-titleWidth,
ENDCASE -- left -- => control.x-3,
left => SELECT control.type FROM
vSlider, hSlider, dial => control.x-MAX[titleWidth, statusWidth]-wordMargin,
ENDCASE =>
control.x-titleWidth-(IF control.report THEN statusWidth+wordMargin ELSE 0),
inside => MAX[control.x-3, (control.w-titleWidth)/2],
ENDCASE -- right -- => control.x+control.w+wordMargin;
y: INTEGER ฌ SELECT control.textLocation.place FROM
up => SELECT control.type FROM
vSlider, hSlider, dial => control.y+control.h+2*lineMargin+lineHeight,
ENDCASE => control.y+control.h+lineMargin,
down => control.y-2*lineMargin-lineHeight,
ENDCASE => SELECT control.textLocation.edge FROM
center => control.y+control.h/2,
up => control.y+control.h,
ENDCASE -- down -- => control.y+lineHeight+2;
IF control.textLocation.side THEN {
titleWidth ฌ titleWidth-4;
x ฌ control.x-statusWidth-titleWidth-8;
y ฌ control.y-2;
};
control.title ฌ LabelViewer[parent: control.parent, x: x, y: y, w: titleWidth, font: control.font];
ViewerOps.AddProp[control.title, $CreatedInOuterViewer, $True];
ViewerTools.SetContents[control.title, control.name];
};

StatusControl: PROC [control: Control] ~ {
contents: ROPE;
titleWidth: INTEGER ฌ VFonts.StringWidth[control.name, control.font]+10;
x: INTEGER ฌ SELECT control.textLocation.place FROM
up, down => SELECT control.type FROM
vSlider, hSlider, dial => SELECT control.textLocation.edge FROM
center => MAX[control.x-3, (control.w-titleWidth)/2],
right => control.x+control.w-titleWidth,
ENDCASE -- left -- => control.x,
ENDCASE => control.x+titleWidth+wordMargin,
left => control.x-MAX[titleWidth, statusWidth]-wordMargin+4,
ENDCASE => SELECT control.type FROM
vSlider, hSlider, dial => control.x+control.w+wordMargin,
ENDCASE => control.x+control.w+2*wordMargin+titleWidth;
y: INTEGER ฌ SELECT control.textLocation.place FROM
up => control.y+control.h+lineMargin,
down => control.y-2*lineMargin,
ENDCASE => SELECT control.textLocation.edge FROM
center => control.y+control.h/2,
up => control.y+control.h,
ENDCASE -- down -- => control.y;
bigWidth: INTEGER ฌ statusWidth+5;
IF control.textLocation.edge = left AND
(control.textLocation.place = up OR control.textLocation.place = down)
THEN bigWidth ฌ SELECT control.type FROM
vSlider, hSlider, dial => MAX[control.w, bigWidth],
ENDCASE => MAX[control.w-titleWidth-wordMargin-clearWidth, bigWidth]; 
IF control.textLocation.side THEN {
x ฌ control.x-statusWidth-5;
y ฌ control.y;
};
control.status ฌ TextViewer[control, control.parent, x, y, bigWidth];
IF control.status = NIL THEN RETURN;
ViewerOps.AddProp[control.status, $CreatedInOuterViewer, $True];
contents ฌ Convert.FtoRope[control.value, control.precision];
IF control.flavor # $ControlsContour AND control.flavor # $ControlsSketch
THEN {
ViewerOps.AddProp[control.status, $RopeFromControlValueProc, control.contourRef];
ViewerOps.AddProp[control.status, $SetControlValueFromRopeProc, control.sketchRef];
WITH control.contourRef SELECT FROM
refProc: REF ControlsPrivate.RopeFromValueProc =>
contents ฌ  refProcญ[control].valueRope;
ENDCASE;
};
ViewerTools.SetContents[control.status, contents];
SELECT control.type FROM
vSlider, hSlider, dial => ActivateViewer[control.status];
ENDCASE;
};

Blink: PROC [message: ROPE] ~ {
MessageWindow.Append[message, TRUE];
MessageWindow.Blink[];
};

LabelViewer: PROC [parent: Viewer, x, y, w: INTEGER, font: Font] RETURNS [v: Viewer] ~ {
IF parent # NIL THEN v ฌ Labels.Create[
[parent: parent, wx: x, wy: y, ww: w, wh: 13, scrollable: FALSE, border: FALSE], font];
};

TextViewer: PROC [control: Control, parent: Viewer, x, y, w: INTEGER]
RETURNS [v: Viewer] ~ {
SELECT control.type FROM
vSlider, hSlider, dial =>
IF parent # NIL THEN {
v ฌ ViewerTools.MakeNewTextViewer[
[parent: parent, wx: x, wy: y, ww: w, wh: 13, scrollable: FALSE, border: FALSE]];
ViewerOps.AddProp[v, $Control, control];
};
ENDCASE => RETURN[LabelViewer[parent, x, y, w, control.font]];
};

SetControlSize: PROC [control: Control, controlSizes: ControlSizes] ~ {
IF control.w = 0 THEN control.w ฌ SELECT control.type FROM
hSlider => controlSizes.wHSlider,
vSlider => controlSizes.wVSlider,
function, contour, sketch => controlSizes.wSketch,
dial => controlSizes.dDial,
ENDCASE =>  controlSizes.dDial;
IF control.h = 0 THEN control.h ฌ SELECT control.type FROM
hSlider => controlSizes.hHSlider,
vSlider => controlSizes.hVSlider,
function, contour, sketch => controlSizes.hSketch,
dial => controlSizes.dDial,
ENDCASE =>  controlSizes.dDial;
};
controlsActivateLinked: BOOL ฌ FALSE;
controlsActivateTip: TIPUser.TIPTable ฌ TIPUser.InstantiateNewTIPTable["ControlsActivate.tip"];

ActivateViewer: PUBLIC PROC [viewer: Viewer] = {
IF NOT controlsActivateLinked THEN {
[] ฌ TIPLinking.Append[controlsActivateTip, viewer.tipTable];
controlsActivateLinked ฌ TRUE;
};
viewer.tipTable ฌ controlsActivateTip;
};

RegisterRopeFromValueProc: PUBLIC PROC [control: Control, proc: RopeFromValueProc]
~ {
refProc: REF RopeFromValueProc ~ NEW[RopeFromValueProc ฌ proc];
IF control.status = NIL THEN RETURN;
ViewerOps.AddProp[control.status, $RopeFromControlValueProc, refProc];
};
RegisterValueFromRopeProc: PUBLIC PROC [control: Control, proc: SetValueFromRopeProc]
~ {
refProc: REF SetValueFromRopeProc ~ NEW[SetValueFromRopeProc ฌ proc];
IF control.status = NIL THEN RETURN;
ViewerOps.AddProp[control.status, $SetControlValueFromRopeProc, refProc];
};
ActivateControl: PROC [viewer: Viewer, whatChanged: ATOM]
RETURNS [ok: BOOL ฌ TRUE]
~ {
refAny: REF ANY ฌ ViewerOps.FetchProp[viewer, $Control];
IF refAny # NIL
THEN {
control: Control ฌ NARROW[refAny];
text: ROPE ~ ViewerTools.GetContents[viewer: viewer];
refAnyToo: REF ANY ฌ ViewerOps.FetchProp[viewer, $SetControlValueFromRopeProc];
IF text # NIL
THEN {
WITH refAnyToo SELECT FROM
refProc: REF ControlsPrivate.SetValueFromRopeProc => refProcญ[control, text
! Convert.Error => {ok ฌ FALSE; CONTINUE}];
ENDCASE => Controls.SetSliderDialValue[control, Convert.RealFromRope[text
! Convert.Error => {ok ฌ FALSE; CONTINUE}]];
};
IF NOT ok
THEN Blink[Rope.Concat["Bad value: ", text]]
ELSE IF NOT ControlProcBusy[control] THEN {
control.whatChanged ฌ whatChanged;
ForkControlProc[control];
};
}
ELSE IF (refAny ฌ ViewerOps.FetchProp[viewer, $ButtonText]) = NIL
THEN ok ฌ FALSE
ELSE [] ฌ CedarProcess.Fork[ForkTextButtonProc, refAny];
};

ForkTextButtonProc: CedarProcess.ForkableProc ~ {
b: Button ฌ NARROW[data];
IF b.textProc # NIL THEN b.textProc[b.textViewer, b.clientData, blue];
};

Activator: TiogaOps.CommandProc ~ {
RETURN[ActivateControl[viewer, $TypedIn], TRUE];
};
NotifyControl: PUBLIC ViewerClasses.NotifyProc ~ {
c: Control ฌ NARROW[self.data];
IF c.queue OR c.proc = NIL OR CedarProcess.GetStatus[c.process] # busy THEN { 
m: Mouse ฌ c.mouse;
IF input # NIL THEN WITH input.first SELECT FROM
tipCoords: TIPUser.TIPScreenCoords =>
m ฌ SetMouse[NARROW[input.rest.first], [tipCoords.mouseX, tipCoords.mouseY]];
ENDCASE;
IF c.outerData # NIL THEN c.outerData.lastControl ฌ c;
IF c.mouse.state = up THEN lastControlMoused ฌ c;
SELECT c.type FROM
vSlider, hSlider, dial => ControlsPrivate.NotifySliderDial[c, m];
function => ControlsPrivate.NotifyFunction[c, m];
contour => ControlsPrivate.NotifyContour[c, m];
sketch => ControlsPrivate.NotifySketch[c, m];
ENDCASE;
};
};

SetMouse: PUBLIC PROC [atom: ATOM, position: IntegerPair] RETURNS [mouse: Mouse] ~ {
mouse ฌ SELECT atom FROM
$upLeftShiftControl =>					[position, up, left, TRUE, TRUE],
$upLeftShift =>							[position, up, left, FALSE, TRUE],
$upLeftControl =>						[position, up, left, TRUE, FALSE],
$upLeft =>								[position, up, left, FALSE, FALSE],
$upMiddleShiftControl =>				[position, up, middle, TRUE, TRUE],
$upMiddleShift =>						[position, up, middle, FALSE, TRUE],
$upMiddleControl =>					[position, up, middle, TRUE, FALSE],
$upMiddle =>							[position, up, middle, FALSE, FALSE],
$upRightShiftControl =>				[position, up, right, TRUE, TRUE],
$upRightShift =>						[position, up, right, FALSE, TRUE],
$upRightControl =>						[position, up, right, TRUE, FALSE],
$upRight =>								[position, up, right, FALSE, FALSE],
$downLeftShiftControl =>				[position, down, left, TRUE, TRUE],
$downLeftShift =>						[position, down, left, FALSE, TRUE],
$downLeftControl =>					[position, down, left, TRUE, FALSE],
$downLeft =>							[position, down, left, FALSE, FALSE],
$downMiddleShiftControl =>			[position, down, middle, TRUE, TRUE],
$downMiddleShift =>					[position, down, middle, FALSE, TRUE],
$downMiddleControl =>				[position, down, middle, TRUE, FALSE],
$downMiddle =>							[position, down, middle, FALSE, FALSE],
$downRightShiftControl =>				[position, down, right, TRUE, TRUE],
$downRightShift =>						[position, down, right, FALSE, TRUE],
$downRightControl =>					[position, down, right, TRUE, FALSE],
$downRight =>							[position, down, right, FALSE, FALSE],
$heldLeftShiftControl =>				[position, held, left, TRUE, TRUE],
$heldLeftShift =>						[position, held, left, FALSE, TRUE],
$heldLeftControl =>						[position, held, left, TRUE, FALSE],
$heldLeft =>								[position, held, left, FALSE, FALSE],
$heldMiddleShiftControl =>			[position, held, middle, TRUE, TRUE],
$heldMiddleShift =>					[position, held, middle, FALSE, TRUE],
$heldMiddleControl =>					[position, held, middle, TRUE, FALSE],
$heldMiddle =>							[position, held, middle, FALSE, FALSE],
$heldRightShiftControl =>				[position, held, right, TRUE, TRUE],
$heldRightShift =>						[position, held, right, FALSE, TRUE],
$heldRightControl =>					[position, held, right, TRUE, FALSE],
$heldRight =>							[position, held, right, FALSE, FALSE],
ENDCASE =>								[position, held, left, FALSE, FALSE];
};

lastControlMoused: Control ฌ NIL;

LastControlMoused: PUBLIC PROC RETURNS [Control] ~ {RETURN[lastControlMoused]};

SetLastControlMoused: PUBLIC PROC [control: Control] ~ {lastControlMoused ฌ control};

NotifyControlProcDone: ENTRY PROC [control: Control] ~ {NOTIFY control.procDone};

ControlProcForker: CedarProcess.ForkableProc ~ {
c: Control ฌ NARROW[data];
c.proc[c, c.clientData];
NotifyControlProcDone[c];
};

MaybeForkControlProc: PUBLIC PROC [control: Control] ~ {
IF control.proc # NIL AND NOT ControlProcBusy[control] THEN ForkControlProc[control];
};

ForkControlProc: PUBLIC PROC [control: Control] ~ {
IF control.proc # NIL THEN control.process ฌ CedarProcess.Fork[ControlProcForker, control];
};

ControlProcBusy: PUBLIC PROC [control: Control] RETURNS [BOOL] ~ {
RETURN[control.process # NIL AND CedarProcess.GetStatus[control.process] = busy];
};
GetClientDataFromControlViewer: PUBLIC PROC [viewer: Viewer] RETURNS [REF ANY] ~ {
WITH viewer.data SELECT FROM
control: Control => RETURN[control.clientData];
ENDCASE => RETURN[NIL];
};
Reset: PUBLIC PROC [c1, c2, c3, c4, c5, c6: Control ฌ NIL, repaint: BOOL ฌ TRUE] ~ {
InnerReset: PROC [control: Control] ~ {
IF control # NIL THEN SELECT control.type FROM
vSlider, hSlider, dial => Controls.SetSliderDialValue[control, control.init, repaint];
function => ControlsPrivate.ResetFunction[control, repaint];
contour => ControlsPrivate.ClearContour[control, repaint];
sketch => ControlsPrivate.ClearSketch[control, repaint];
ENDCASE => NULL;
};
InnerReset[c1];
InnerReset[c2];
InnerReset[c3];
InnerReset[c4];
InnerReset[c5];
InnerReset[c6];
};
WaitControlProcDone: PUBLIC ENTRY PROC [control: Control] ~ {
WAIT control.procDone;
};

FindControl: PUBLIC PROC [outerData: OuterData, controlName: ROPE] RETURNS [c: Control] ~ {
FOR l: LIST OF Control ฌ outerData.controls, l.rest WHILE l # NIL DO
IF Rope.Equal[l.first.name, controlName, FALSE] THEN RETURN[l.first];
ENDLOOP;
};
Vernier: PUBLIC PROC [
vernier, control: Control,
cwIncrease: BOOL ฌ TRUE,
resolution: REAL ฌ 10.0]
~ {
range, percent0, percent1, delta, newValue: REAL;
IF vernier = NIL OR control = NIL OR vernier = control THEN RETURN;
SELECT control.type FROM vSlider, hSlider, dial => NULL; ENDCASE => RETURN;
IF vernier.min = vernier.max THEN {vernier.min ฌ 0.0; vernier.max ฌ 1.0};
range ฌ vernier.max-vernier.min;
percent0 ฌ (vernier.valuePrev-vernier.min)/range;
percent1 ฌ (vernier.value-vernier.min)/range;
delta ฌ percent1-percent0;
IF percent0 > 0.75 AND percent1 < 0.25 THEN delta ฌ delta+1.0;
IF percent0 < 0.25 AND percent1 > 0.75 THEN delta ฌ delta-1.0;
IF resolution # 0.0 THEN newValue ฌ IF cwIncrease 
THEN control.value+(control.max-control.min)*(delta/resolution)
ELSE control.value-(control.max-control.min)*(delta/resolution);
IF control.type # dial THEN newValue ฌ MIN[control.max, MAX[control.min, newValue]];
Controls.SetSliderDialValue[control, newValue];
};
tipTable: TIPUser.TIPTable ฌ TIPUser.InstantiateNewTIPTable["Controls.tip"];

					
ViewerOps.RegisterViewerClass[$ControlsSliderDial, NEW[ViewerClasses.ViewerClassRec ฌ [
notify: NotifyControl,
paint: ControlsPrivate.PaintSliderDial,
tipTable: tipTable]]];

ViewerOps.RegisterViewerClass[$ControlsFunction, NEW[ViewerClasses.ViewerClassRec ฌ [
notify: NotifyControl,
paint: ControlsPrivate.PaintFunction,
tipTable: tipTable]]];

ViewerOps.RegisterViewerClass[$ControlsContour, NEW[ViewerClasses.ViewerClassRec ฌ [
notify: NotifyControl,
paint: ControlsPrivate.PaintContour,
tipTable: tipTable]]];

ViewerOps.RegisterViewerClass[$ControlsSketch, NEW[ViewerClasses.ViewerClassRec ฌ [
notify: NotifyControl,
paint: ControlsPrivate.PaintSketch,
tipTable: tipTable]]];

TiogaOps.RegisterCommand[$ControlsActivate, Activator, TRUE];


END.
..

์
ControlsImpl.mesa
Copyright ำ 1985, 1992 by Xerox Corporation.  All rights reserved.
Bloomenthal, July 2, 1992 6:34 pm PDT
Ken Shoemake, September 7, 1989 1:04:22 am PDT
Types
Control Creation
control.graphics _ graphics;
Control Positioning
Control Title, Status, and Clear
Control Activate
controlsActivateTip.opaque ฌ FALSE;
controlsActivateTip.link ฌ viewer.tipTable;
controlsActivateTip ฌ controlsActivateTip;


Procs are forked to minimize wedging:
ForkTextButtonProc: CedarProcess.ForkableProc ~ {
A prior attempt to deal with the input focus problem caused by KillInputFocus.
b: Button _ NARROW[data];
textProc may change the input focus, so save it in order to restore:
focus: InputFocus.Focus _ InputFocus.GetInputFocus[];
textProc may change input focus, which may cause KillInputFocus and result in new call to
ForkTextButtonProc or ForkControlProc; to avoid this, disable ActivateControl during this call: 
activateSuspended _ TRUE;
IF b.textProc # NIL THEN b.textProc[b.textViewer, b.clientData, blue];
InputFocus.SetInputFocus[focus.owner, focus.info];
ViewerTools.SetSelection[focus.owner];
activateSuspended _ FALSE;
};

KillInputFocus: ViewerEvents.EventProc ~ {
IF controlsActivateTip # NIL AND viewer # NIL AND viewer.tipTable = controlsActivateTip
THEN [] _ ActivateControl[viewer, $InputKilled];
};

Control Notification
Mouse: TYPE ~ RECORD [pos, state, button, doubleClick, controlKey, shiftKey]
We give up on the double-clicking (it caused logical and interactive-timing problems):
$downLeftDoubleShiftControl =>		[position, down, left, TRUE, TRUE, TRUE],
$downLeftDoubleShift =>				[position, down, left, TRUE, FALSE, TRUE],
$downLeftDoubleControl =>			[position, down, left, TRUE, TRUE, FALSE],
$downLeftDouble =>					[position, down, left, TRUE, FALSE, FALSE],
$downMiddleDoubleShiftControl =>	[position, down, middle, TRUE, TRUE, TRUE],
$downMiddleDoubleShift =>			[position, down, middle, TRUE, FALSE, TRUE],
$downMiddleDoubleControl =>		[position, down, middle, TRUE, TRUE, FALSE],
$downMiddleDouble =>					[position, down, middle, TRUE, FALSE, FALSE],
$downRightDoubleShiftControl =>		[position, down, right, TRUE, TRUE, TRUE],
$downRightDoubleShift =>				[position, down, right, TRUE, FALSE, TRUE],
$downRightDoubleControl =>			[position, down, right, TRUE, TRUE, FALSE],
$downRightDouble =>					[position, down, right, TRUE, FALSE, FALSE],
Control Reading
Control Setting
Control Miscellany
Vernier Procedures
Start Code
[] _ CedarProcess.Fork[WatchControl];

We eliminate KillInputFocus so that ActivateControl is called ONLY if the user types a value followed by a CR into a control or text button.  This is as advertised in Controls.  Otherwise serious problems with the input focus can result; e.g., suppose the control proc called by ActivateControl changes the input focus, causing an endless propagation of KillInputFocus?  One solution is to save the input focusand disable KillInputFocus restoring them when the control proc is done, but this would prevent the user from explicitly changing the input focus.
[] _ ViewerEvents.RegisterEventProc[KillInputFocus, killInputFocus,, FALSE];
Was:
gControl: REF ANY;
gControlInput: LIST OF REF ANY;
newControlInputBoolean: BOOL;
newControlInputCondition: CONDITION;

NotifyControl: PUBLIC ViewerClasses.NotifyProc ~ {
NewControlInput[self.data, input];
};

NewControlInput: ENTRY PROC [data: REF ANY, input: LIST OF REF ANY] ~ {
gControl _ data;
gControlInput _ input;
NOTIFY newControlInputCondition;
newControlInputBoolean _ TRUE;
};

GetControlInput: ENTRY PROC RETURNS [control: Control] ~ {
-- IF NOT newControlInputBoolean THEN -- WAIT newControlInputCondition;
newControlInputBoolean _ FALSE;
control _ NARROW[gControl];
IF control.outerData # NIL THEN control.outerData.lastControl _ control;
IF gControlInput # NIL THEN {
tipCoords: TIPUser.TIPScreenCoords _ NARROW[gControlInput.first];
control.mouse _
SetMouse[NARROW[gControlInput.rest.first], [tipCoords.mouseX, tipCoords.mouseY]];
};
};

WatchControl: CedarProcess.ForkableProc ~ {
DO 
control: Control _ GetControlInput[];
IF control.mouse.state = up THEN {
IF control.outerData # NIL THEN control.outerData.lastControl _ control;
lastControlMoused _ control;
};
SELECT control.type FROM
vSlider =>	ControlsPrivate.NotifySliderDial[control];
hSlider =>	ControlsPrivate.NotifySliderDial[control];
dial =>		ControlsPrivate.NotifySliderDial[control];
function =>	ControlsPrivate.NotifyFunction[control];
contour =>	ControlsPrivate.NotifyContour[control];
sketch =>		ControlsPrivate.NotifySketch[control];
ENDCASE =>	NULL;
ENDLOOP;
};
ส–
"cedarcode" style•NewlineDelimiter

™š
œ™Jšœ	ฯeœ6™BJ™%J™.J˜Jšฯk	œท
˜ภ
J˜—šะblœžœ
ž˜Jšžœž
˜ฅ
šžœ˜!J˜——Jšœž˜
headš
ฯl™Jšœ
žœ˜#Jšœžœ˜%Jšœžœ˜,Jšœžœ˜,Jšœ
žœ˜*Jšœžœ˜.Jšœžœ˜,Jšœ
žœ˜#Jšœ
žœ˜*Jšœžœ˜,Jšœ	žœ˜!Jšœžœ˜(Jšœžœ˜-Jšœžœ˜,Jšœžœ˜.Jšœžœ%˜<Jšœžœ(˜BJšœ
žœ˜ Jšœ	žœ˜Jšžœžœžœ
˜Jšœ
žœ˜(—š
 ™šฯn
œžœ
žœ˜Jšœžœžœ
˜J˜Jšœžœ
žœžœ
˜Jšœžœ˜Jšœžœ˜Jšœžœ˜Jšœžœ
˜Jšœžœžœ
˜Jšœžœ˜Jšœžœ˜Jšœžœ˜Jšœžœ˜J˜(Jšœžœžœ
˜Jšœžœ
˜J˜Jšœžœžœ
˜Jšœžœ
˜J˜Jšœ
žœ
˜Jšœžœ	˜Jšœžœ˜Jšžœ
˜Jš
œ˜Jšœžœ
˜Jšžœ
žœ	žœ˜&J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜J˜Jšžœžœžœ ˜AJ˜J˜—šกœžœ,žœ
˜CJšžœ˜J˜Jš	œžœžœžœžœ˜:Jš
žœžœ
žœ
žœ
žœ˜)Jšžœ
žœ
žœžœ
˜3Jšœžœ
˜Jšžœ˜J˜J˜—šก
œžœ
žœ˜Jš
œ˜Jš
œ˜Jšœžœ
˜Jšœžœ
˜Jš
œ˜Jšžœžœ
žœ
žœ
˜šžœ
žœžœ˜Jš
œ˜J˜Jš
œ™J˜˜ šœžœ˜ Jšžœ˜šžœ
žœž˜Jš
œ˜Jš
œ˜Jš
œ˜Jšžœ˜——Jšœžœ
˜š
œ˜Jš
œ˜J˜Jš
œ˜Jš
œ˜J˜J˜Jšœžœžœžœžœžœ
˜RJšœžœ
˜Jš
œ˜——J˜Jš
œ8˜8šžœž˜J˜3Jšžœ
˜—Jšžœ
žœžœ˜=šžœžœžœ˜FJšžœ˜—J˜—šžœž˜J˜AJ˜/Jšœ	žœ&˜1J˜-Jšžœžœ
˜—J˜J˜—šกœžœ%˜AJ˜J˜——š
 ™˜Jšœž	œ˜Jšœž	œ˜Jšœ
žœ˜Jšœ
žœ˜Jšœžœ˜Jšœžœ˜Jšœžœ˜šœžœ˜J˜——šะbnœžฯb
œ
˜Jšœ9žœ
˜AJšžœ	žœ˜Jšœžœ˜Jšœ#žœ˜/šžœ%žœžœ
žœžœ
ž˜LJ˜šœžœžœž˜+J˜Jš
œ˜Jšžœ˜—Jšžœžœ
žœ
žœ
˜J˜$J˜0Jš
œ˜šžœž˜Jšœ
žœ
˜J˜Gšžœ˜J˜J——šœžœž˜Jšœžœ˜7Jšžœ&˜-—šœžœž˜(Jšœžœ˜*Jšžœ'˜.—šžœ	žœ˜Jšžœฯc!˜Ašžœค˜0šžœ˜Jšžœ?˜C—šžœž˜ š
œ	˜	J˜šœžœž˜Jš
œ/˜/Jšžœ ˜'—Jš
œ˜—š
œ	˜	šœžœ˜*Jšžœ˜Jšžœ
žœ˜#—J˜Jš
œ˜—Jšžœ˜—J˜——J˜Jšžœžœ˜.J˜J˜Jšžœ
˜—J˜šžœ#žœžœ
žœžœ
ž˜HJšœžœ0˜=Jšœ	žœ˜Jšžœ
˜—J˜J˜—šข
œžฃ
œžœ˜<Jšžœžœ
žœ˜(J˜J˜—šกœžœžœžœ˜;šžœ
žœ"˜+šžœ
žœž˜Jš
œ7˜7Jšžœ'˜.—Jšžœ˜—J˜J˜—šก
œžœžœ
žœ˜DJ˜ šžœ!žœ#žœ˜NJšžœžœ'˜=š	žœ
žœžœ
žœž˜?šœžœ ˜<Jšžœ&˜*Jšžœ)˜-—Jšžœ
˜—J˜—J˜——š
  ™ Jšœžœ˜J˜šขœžœ˜)šžœž˜&š
œ
˜
Jšœžœ"˜,šœžœžœ ˜/Jšžœ˜#Jšžœ˜—šœ	ฯs
œ˜Jšœฅ
œฅ
œฅ
œฅ
œžœ˜P—J˜(Jš
œ3˜3Jšœ
ฅ˜—Jšžœ
˜—J˜J˜—šกœ˜Jšœ
žœ
˜ šžœž˜J˜-J˜+J˜)Jšžœ
˜—J˜J˜—šกœžœ˜)Jšœžœ5˜Hšœžœžœž˜3šœžœž˜1Jšœ
žœ(˜5J˜(Jšžœ
ค
œ˜"—šœžœž˜ Jšœ$žœ%˜Lšžœ˜
Jšœžœžœžœ˜L——Jšœ
žœ(˜5Jšžœ
คœ#˜6—šœžœžœž˜3šœžœž˜J˜FJšžœ#˜*—Jš
œ*˜*šžœžœž˜0Jš
œ ˜ J˜Jšžœ
ค
œ˜-——šžœžœ˜#J˜J˜'J˜J˜—J˜cJš
œ?˜?Jš
œ5˜5J˜J˜—šฃ
œžœ˜*Jšœ
žœ
˜Jšœžœ5˜Hšœžœžœž˜3šœžœž˜$šœžœž˜?Jšœ
žœ(˜5J˜(Jšžœ
ค
œ˜ —Jšžœ$˜+—Jšœžœ'˜<šžœžœž˜#Jš
œ9˜9Jšžœ0˜7——šœžœžœž˜3Jš
œ%˜%Jš
œ˜šžœžœž˜0Jš
œ ˜ J˜Jšžœ
ค
œ˜ ——Jšœ
žœ˜"šžœ"ž˜'šœ!žœ#˜Fšžœžœž˜(Jšœžœ˜3Jšžœžœ8˜F———šžœžœ˜#J˜J˜J˜—J˜EJšžœžœ
žœ
žœ
˜$Jš
œ@˜@J˜=šžœ#žœ!˜Išžœ˜Jš
œQ˜QJš
œS˜Sšžœžœ
ž˜#šœ	žœ%˜1J˜(—Jšžœ
˜—J˜——Jš
œ2˜2šžœž˜Jš
œ9˜9Jšžœ
˜—J˜J˜—šกœžœžœ˜J•StartOfExpansion [viewer: 
ViewerClasses.Viewer]šœžœ˜$J– [viewer: 
ViewerClasses.Viewer]š
œ˜J˜J˜—šกœžœžœžœ˜Xšžœ
žœ
žœ˜'Jšœ:žœ
žœ	˜W—J˜J˜—šก
œžœ-žœ
˜EJšžœ˜šžœž˜š
œ˜šžœ
žœ
žœ˜˜"Jšœ9žœ	žœ˜Q—J˜(J˜——Jšžœžœ-˜>—J˜J˜—šกœžœ3˜Gšžœžœžœž˜:Jš
œ!˜!Jš
œ!˜!Jš
œ2˜2Jš
œ˜Jšžœ˜—šžœžœžœž˜:Jš
œ!˜!Jš
œ!˜!Jš
œ2˜2Jš
œ˜Jšžœ˜—J˜——š
 ™Jšœžœžœ
˜%˜_J˜—šกœžœ˜0šžœ
žœžœ˜$J– [viewer: 
ViewerClasses.Viewer]šœžœ
™#J™+J™*J˜=Jšœžœ
˜Jš
œ˜—J˜&Jš
œ˜J˜—šกœžœ
žœ,˜RJ˜Jšœ	žœžœ˜?Jšžœžœ
žœ
žœ
˜$Jš
œF˜FJ˜J™—šกœžœ
žœ/˜UJ˜Jšœ	žœžœ˜EJšžœžœ
žœ
žœ
˜$Jš
œI˜IJ˜J™—–o -- [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]šกœžœžœ
˜9Jšžœžœžœ
˜Jš
œ˜Jšœžœ
žœ)˜8J™%šžœ
ž˜šžœ˜Jšœžœ	˜"Jšœžœ+˜5Jšœžœ
žœ=˜Ošžœž˜
šžœ˜šžœžœ
ž˜Jšœ	žœYžœžœ˜wJšžœ\žœžœ˜v—J˜——šžœ
žœ˜	Jšžœ(˜,šžœ
žœžœ˜+J˜"Jš
œ˜J˜——J˜
—šžœ
žœ7ž˜AJšžœž˜Jšžœ4˜8——J˜J˜—šกœ™1Jš
œN™NJšœžœ™J™DJ™5Jš
œY™YJš
œ`™`Jšœžœ
™Jšžœžœ.™FJ™2J™&Jšœžœ
™J™J™—šกœ˜1Jšœžœ˜Jšžœžœ.˜FJ˜J˜—šกœ™*š
žœžœ
žœ
žœ
žœ&™WJšžœ,™0—J™J™—šก	œ˜#Jšžœ$žœ˜0Jš
œ˜——š
 ™šข
œžœ˜2Jšœ
žœ˜š
žœ	žœ
žœ
žœ*žœ˜NJ˜šžœ	žœ
žœ
žœ
žœ
ž˜0š
œ%˜%Jšœ
žœ:˜M—Jšžœ
˜—Jšžœžœ
žœ˜6Jšžœžœ˜1šžœž˜Jš
œA˜AJ˜1J˜/J˜-Jšžœ
˜—J˜—Jš
œ˜J˜—š
กœžœ
žœžœžœ˜TJšœฅœฅœ8™Lšœžœž˜Jšœ0žœžœ˜<Jšœ+žœžœ˜8Jšœ,žœžœ˜9Jšœ'žœžœ˜5Jšœ3žœžœ˜?Jšœ.žœžœ˜;Jšœ/žœžœ˜<Jšœ*žœžœ˜8Jšœ1žœžœ˜=Jšœ,žœžœ˜9Jšœ.žœžœ˜;Jšœ)žœžœ˜7Jšœ3žœžœ˜?Jšœ.žœžœ˜;Jšœ/žœžœ˜<Jšœ*žœžœ˜8Jšœ6žœžœ˜BJšœ1žœžœ˜>Jšœ2žœžœ˜?Jšœ.žœžœ˜<Jšœ5žœžœ˜AJšœ0žœžœ˜=Jšœ1žœžœ˜>Jšœ,žœžœ˜:J™VJšœ7žœžœžœ™IJšœ2žœžœžœ™EJšœ3žœžœžœ™FJšœ.žœžœžœ™BJšœ:žœžœžœ™LJšœ5žœžœžœ™HJšœ6žœžœžœ™IJšœ2žœžœžœ™FJšœ9žœžœžœ™KJšœ4žœžœžœ™GJšœ5žœžœžœ™HJšœ0žœžœžœ™DJšœ3žœ
žœ˜?Jšœ.žœ
žœ˜;Jšœ0žœ
žœ˜=Jšœ+žœ
žœ˜9Jšœ6žœ
žœ˜BJšœ1žœ
žœ˜>Jšœ3žœ
žœ˜@Jšœ.žœ
žœ˜<Jšœ5žœ
žœ˜AJšœ0žœ
žœ˜=Jšœ1žœ
žœ˜>Jšœ,žœ
žœ˜:Jšžœ"žœ
žœ˜7—J˜J˜—šœžœ
˜!J˜—šกœžœ
žœžœ˜OJ˜—šกœžœ
žœ4˜UJ˜—šกœžœ
žœžœ˜QJ˜—šกœ˜0Jšœ
žœ˜Jš
œ˜Jš
œ˜J˜J˜—šกœžœ
žœ˜8Jš
žœžœ
žœ
žœžœ˜UJš
œ˜J˜—šกœžœ
žœ˜3Jšžœžœ
žœA˜[Jš
œ˜J˜—š
กœžœ
žœžœžœ˜BJšžœžœ
žœ1˜QJš
œ˜——š
 ™šกœžœ
žœžœžœ
žœ˜Ršžœ
žœ
ž˜Jšœžœ˜/Jšžœžœ
žœ˜—J˜——š
 ™šกœžœ
žœ$žœžœžœ˜Tšก
œžœ˜'š	žœžœ
žœ
žœž˜.J˜VJ˜<J˜:J˜8Jšžœžœ
˜—J˜—J˜J˜J˜J˜J˜J˜J˜——š
 ™šกœžœ
žœ
žœ˜=Jšžœ˜J˜J˜—šกœžœ
žœ%žœžœฅ
œฅ
œ
ฅ
œ
˜[šžœžœ
žœ&žœžœ
ž˜DJšžœ'žœžœ
žœ
˜EJšžœ
˜—J˜——š
 ™šกœžœ
žœ˜Jš
œ˜Jšœžœžœ
˜Jšœžœ˜Jš
œ˜Jšœ,žœ
˜1Jšžœžœ
žœžœ
žœžœ
žœ
˜CJš
žœžœžœžœžœ
˜KJšžœžœ(˜IJšœž
œ˜ Jšœž
œ(˜1Jšœž
œ$˜-J˜Jšžœžœžœ˜>Jšžœžœžœ˜>šžœžœžœ˜2Jšžœ;˜?Jšžœ<˜@—Jšžœžœžœžœ˜TJš
œ/˜/J˜——š
 
™
˜LJ˜—š
œ%™%Jš
ค˜—šœ3žœ!˜WJš
œ˜Jš
œ'˜'Jš
œ˜J˜—šœ1žœ!˜UJš
œ˜Jš
œ%˜%Jš
œ˜J˜—šœ0žœ!˜TJš
œ˜Jš
œ$˜$Jš
œ˜J˜—šœ/žœ!˜SJš
œ˜Jš
œ#˜#Jš
œ˜J˜—Jšœ7žœ˜=šœ
ฯoฌ™ญJ˜—J–s[proc: 
ViewerEvents.EventProc, event: 
ViewerEvents.ViewerEvent, filter: 
REF ANY _ NIL, before: 
BOOL _ TRUE]šœEะksœ™LJ˜—Jšžœ
˜J˜š
 ™Jšœ
žœ
žœ
™Jš	œžœ
žœ
žœ
žœ
™Jšœžœ
™šœž	œ
™$J™—šข
œžœ™2Jš
œ"™"Jš
œ™J™—šกœžœ
žœžœ
žœ	žœ
žœ
žœ
žœ™GJš
œ™Jš
œ™Jšžœ™ Jšœžœ
™Jš
œ™J™—šกœžœ
žœ
žœ™:Jšคะcsคจคœ
žœ™GJšœžœ
™Jšœ
žœ™Jšžœžœ
žœ)™Hšžœžœ
žœ™Jšœ%žœ™Aš
œ™Jšœ	žœB™Q—J™—Jš
œ™J™—šกœ™+šžœ
™Jš
œ%™%šžœžœ™"Jšžœžœ
žœ)™HJ™J™—šžœž™Jš
œ5™5Jš
œ5™5Jš
œ3™3J™4J™2J™1Jšžœžœ
™—Jšžœ
™—Jš
œ™——J˜—…—Sา‚ภ