
<<ControlsImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<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 [
name: ROPE _ NIL,
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^ _ [
name: name,
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,
name: control.name,
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 ~ {
DO 
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.