[_CDCSL_93-16_]<1>Cedar>release>Controls>ControlsImpl.mesa

ControlsImpl.mesa

Bloomenthal, July 2, 1992 6:34 pm PDT

Ken Shoemake, September 7, 1989 1:04:22 am PDT

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

Types

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;

Control Creation

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.graphics ← graphics;

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;

};

Control Positioning

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;

};

Control Title, Status, and Clear

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;

};

Control Activate

controlsActivateLinked: BOOL Ź FALSE;

controlsActivateTip: TIPUser.TIPTable Ź TIPUser.InstantiateNewTIPTable["ControlsActivate.tip"];

ActivateViewer: PUBLIC PROC [viewer: Viewer] = {

IF NOT controlsActivateLinked THEN {

controlsActivateTip.opaque Ź FALSE;

controlsActivateTip.link Ź viewer.tipTable;

controlsActivateTip Ź controlsActivateTip;

[] Ź 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];

Procs are forked to minimize wedging:

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 ~ {

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;

};

ForkTextButtonProc: CedarProcess.ForkableProc ~ {

b: Button Ź NARROW[data];

IF b.textProc # NIL THEN b.textProc[b.textViewer, b.clientData, blue];

};

KillInputFocus: ViewerEvents.EventProc ~ {

IF controlsActivateTip # NIL AND viewer # NIL AND viewer.tipTable = controlsActivateTip

THEN [] ← ActivateControl[viewer, $InputKilled];

};

Activator: TiogaOps.CommandProc ~ {

RETURN[ActivateControl[viewer, $TypedIn], TRUE];

};

Control Notification

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: TYPE ~ RECORD [pos, state, button, doubleClick, controlKey, shiftKey]

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],

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],

$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];

};

Control Reading

GetClientDataFromControlViewer: PUBLIC PROC [viewer: Viewer] RETURNS [REF ANY] ~ {

WITH viewer.data SELECT FROM

control: Control => RETURN[control.clientData];

ENDCASE => RETURN[NIL];

};

Control Setting

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];

};

Control Miscellany

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 Procedures

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];

};

Start Code

tipTable: TIPUser.TIPTable Ź TIPUser.InstantiateNewTIPTable["Controls.tip"];

[] ← CedarProcess.Fork[WatchControl];

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];

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];

END.

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 ~ {

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;

};