[Cyan]<CedarChest6.1>Controls>ControlsImpl.mesa!37

ControlsImpl.mesa

Bloomenthal, February 25, 1987 5:15:48 pm PST

DIRECTORY CedarProcess, Controls, ControlsPrivate, Labels, TIPUser, Vector2, VFonts, ViewerClasses, ViewerOps, ViewerTools;

ControlsImpl: CEDAR MONITOR

IMPORTS CedarProcess, Controls, ControlsPrivate, Labels, TIPUser, VFonts, ViewerOps, ViewerTools

EXPORTS Controls, ControlsPrivate

~ BEGIN

OPEN Controls;

Control Creation

NewControl: PUBLIC PROC [

type: ControlType ← vSlider,

data: REF ANY ← NIL,

min, max, init: REAL ← 0.0,

proc: ControlProc ← NIL,

report: BOOL ← TRUE,

truncate: BOOL ← FALSE,

row: INTEGER ← 0,

x, y, w, h: INTEGER ← 0,

textLocation: TextLocation ← above,

dummy: BOOL ← FALSE,

flavor: ATOM ← $Nil,

detents: LIST OF Detents ← NIL,

taper: SliderTaper ← lin,

values: RealSequence ← NIL]

RETURNS [Control]

~ {

control: Control ← NEW[ControlRep];

IF type = dial THEN w ← h ← MIN[w, h];

control^ ← [

type: type,

proc: proc,

report: report,

truncate: truncate,

row: row,

x: x, y: y, w: w, h: h,

textLocation: textLocation,

dummy: dummy,

flavor: flavor,

data: data,

min: min, max: max, init: init,

value: init,

values: values,

detents: detents,

taper: taper];

IF type = function AND w # 0 THEN ControlsPrivate.NewFunction[control];

RETURN[control];

};

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, graphics: Viewer ← NIL,

control: Control,

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 => $Function,

contour => $Contour,

sketch => $Sketch

ENDCASE => $SliderDial,

paint: TRUE,

info: [

data: control,

wx: control.x,

wy: control.y,

ww: control.w,

wh: control.h,

border: control.type # dial,

scrollable: FALSE,

parent: parent]];

control.viewer ← viewer;

IF control.name # NIL THEN TitleControl[control];

IF control.report 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;

};

Clearing

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 Positioning

statusWidth: INTEGER ~ 32;

lineHeight: INTEGER ~ 8;

lineMargin: INTEGER ~ 3;

edgeMargin: INTEGER ~ 15;

wordMargin: INTEGER ~ 10;

controlMargin: INTEGER ~ 15;

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;

IF c = NIL THEN LOOP;

c.font ← VFonts.DefaultFont[];

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 FROM

above, below => 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 FROM

below => {

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+MAX[titleWidth, statusWidth]+wordMargin; 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 = below

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 [INTEGER] ~ {

SELECT control.type FROM

contour, function, sketch =>

IF control.name = NIL THEN RETURN[controlMargin+control.h];

ENDCASE => NULL;

RETURN[controlMargin+(SELECT control.textLocation FROM

above => SELECT control.type FROM

vSlider, hSlider, dial => control.h+2*(lineMargin+lineHeight),

ENDCASE => control.h+lineMargin+lineHeight,

below => SELECT control.type FROM

vSlider, hSlider, dial => control.h+3*lineMargin+2*lineHeight,

ENDCASE => control.h+lineMargin+lineHeight,

ENDCASE => control.h)];

};

TitleControl: PROC [control: Control] ~ {

titleWidth: INTEGER ← VFonts.StringWidth[control.name, control.font]+10;

control.title ← LabelViewer[

parent: control.parent,

x: SELECT control.textLocation FROM

above, below => control.x,

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

ENDCASE => control.x+control.w+wordMargin,

y: SELECT control.textLocation FROM

above => SELECT control.type FROM

vSlider, hSlider, dial => control.y+control.h+2*lineMargin+lineHeight,

ENDCASE => control.y+control.h+lineMargin,

below => control.y-2*lineMargin-lineHeight,

ENDCASE => control.y+lineHeight+lineMargin,

w: titleWidth

];

ViewerTools.SetContents[control.title, control.name];

};

StatusControl: PROC [control: Control] ~ {

titleWidth: INTEGER ← VFonts.StringWidth[control.name, control.font]+10;

control.status ← LabelViewer[

parent: control.parent,

x: SELECT control.textLocation FROM

above, below => SELECT control.type FROM

vSlider, hSlider, dial => control.x,

ENDCASE => control.x+titleWidth+wordMargin,

left => control.x-MAX[titleWidth, statusWidth]-wordMargin,

ENDCASE => SELECT control.type FROM

vSlider, hSlider, dial => control.x+control.w+wordMargin,

ENDCASE => control.x+control.w+2*wordMargin+titleWidth,

y: SELECT control.textLocation FROM

above => control.y+control.h+lineMargin,

below => SELECT control.type FROM

vSlider, hSlider, dial => control.y-3*lineMargin-2*lineHeight,

ENDCASE => control.y-2*lineMargin,

ENDCASE => control.y,

w: statusWidth

];

};

LabelViewer: PROC [parent: Viewer, x, y, w: INTEGER] RETURNS [v: Viewer] ~ {

IF parent # NIL THEN v ← Labels.Create[

[parent: parent, wx: x, wy: y, ww: w, wh: 13, scrollable: FALSE, border: FALSE]];

};

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 Notification

gMouse: Mouse;

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

control.mouse ← SetMouse[NARROW[gControlInput.rest.first], NARROW[gControlInput.first]];

};

SetMouse: PUBLIC PROC [atom: ATOM, tipCoords: TIPUser.TIPScreenCoords]

RETURNS [mouse: Mouse] ~ {

InnerSet: PROC [state: MouseState, button: MouseButton, shiftKey, controlKey: BOOL]

~ INLINE {

gMouse.state ← state;

gMouse.button ← button;

gMouse.shiftKey ← shiftKey;

gMouse.controlKey ← controlKey;

};

SELECT atom FROM

$up => InnerSet[up, gMouse.button, FALSE, FALSE];

$downLeftShiftCtrl => InnerSet[down, left, TRUE, TRUE];

$downLeftShift => InnerSet[down, left, TRUE, FALSE];

$downLeftCtrl => InnerSet[down, left, FALSE, TRUE];

$downLeft => InnerSet[down, left, FALSE, FALSE];

$downMiddleShiftCtrl => InnerSet[down, middle, TRUE, TRUE];

$downMiddleShift => InnerSet[down, middle, TRUE, FALSE];

$downMiddleCtrl => InnerSet[down, middle, FALSE, TRUE];

$downMiddle => InnerSet[down, middle, FALSE, FALSE];

$downRightShiftCtrl => InnerSet[down, right, TRUE, TRUE];

$downRightShift => InnerSet[down, right, TRUE, FALSE];

$downRightCtrl => InnerSet[down, right, FALSE, TRUE];

$downRight => InnerSet[down, right, FALSE, FALSE];

ENDCASE => gMouse.state ← held;

RETURN[[

tipCoords.mouseX,

tipCoords.mouseY,

gMouse.state,

gMouse.button,

gMouse.controlKey,

gMouse.shiftKey]];

};

lastControlMoused: Control ← NIL;

LastControlMoused: PUBLIC PROC RETURNS [Control] ~ {

RETURN[lastControlMoused];

};

ControlProcForker: CedarProcess.ForkableProc ~ {

control: Control ~ NARROW[data];

control.proc[control];

};

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

};

WatchControl: CedarProcess.ForkableProc ~ {

control: Control ← lastControlMoused ← GetControlInput[];

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;

IF control.outerData # NIL THEN control.outerData.lastControl ← control;

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;

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

[] ← CedarProcess.Fork[WatchControl];

ViewerOps.RegisterViewerClass[$SliderDial, NEW[ViewerClasses.ViewerClassRec ← [

notify: NotifyControl,

paint: ControlsPrivate.PaintSliderDial,

tipTable: TIPUser.InstantiateNewTIPTable["Controls.TIP"]]]];

ViewerOps.RegisterViewerClass[$Function, NEW[ViewerClasses.ViewerClassRec ← [

notify: NotifyControl,

paint: ControlsPrivate.PaintFunction,

tipTable: TIPUser.InstantiateNewTIPTable["Controls.TIP"]]]];

ViewerOps.RegisterViewerClass[$Contour, NEW[ViewerClasses.ViewerClassRec ← [

notify: NotifyControl,

paint: ControlsPrivate.PaintContour,

tipTable: TIPUser.InstantiateNewTIPTable["Controls.TIP"]]]];

ViewerOps.RegisterViewerClass[$Sketch, NEW[ViewerClasses.ViewerClassRec ← [

notify: NotifyControl,

paint: ControlsPrivate.PaintSketch,

tipTable: TIPUser.InstantiateNewTIPTable["Controls.TIP"]]]];

END.