KnobAttachImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Created Tuesday, August 7, 1984 3:24 pm PDT
Eric Nickell, September 17, 1986 2:16:51 am PDT
DIRECTORY
Imager, --USING Lots!
ImagerPath USING [ArcTo, MoveTo],
KnobAttach,
KnobRotation USING [KnobIndex, OffsetSinceLastCall],
Process USING [Detach, priorityClient3, SetPriority],
RefTab USING [Create, Delete, EachPairAction, Fetch, GetSize, Pairs, Ref, Store],
Sliders USING [GetContents, NormalizedSliderValue, SetContents, Slider],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
UserProfile USING [Boolean, CallWhenProfileChanges, Number, ProfileChangedProc],
ViewerClasses, --USING Lots!
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass]
;
KnobAttachImpl:
CEDAR
MONITOR
IMPORTS Imager, ImagerPath, KnobRotation, Process, RefTab, Sliders, TIPUser, UserProfile, ViewerOps
EXPORTS KnobAttach
= BEGIN
OPEN KnobAttach, I: Imager, KR: KnobRotation, S: Sliders, V: ViewerClasses;
KnobAttachData: TYPE ~ REF KnobAttachDataRec;
KnobAttachDataRec:
TYPE ~
RECORD [
slider: Slider, --Slider to control
turnProc: TurnProc, --Called whenever turn is noticed
clientData: REF --Passed to turnProc
];
KnobIndex: TYPE ~ KR.KnobIndex;
NotASlider: PUBLIC ERROR ~ CODE;
Public Procedures
Create:
PUBLIC
PROC [info: ViewerClasses.ViewerRec, slider: Slider, turnProc: TurnProc ←
NIL, clientData:
REF ←
NIL, paint:
BOOL ←
TRUE]
RETURNS [v: KnobAttachViewer] ~ {
knobAttachData: KnobAttachData ←
NEW[KnobAttachDataRec ← [
slider: slider,
turnProc: turnProc,
clientData: clientData
]];
IF slider.class.flavor # $Slider THEN ERROR NotASlider[];
info.data ← knobAttachData;
info.scrollable ← FALSE;
RETURN[ViewerOps.CreateViewer[flavor: $KnobAttach, info: info, paint: paint]];
};
Attach:
PUBLIC
ENTRY
PROC [viewer: KnobAttachViewer, whichKnob: Attachment, paint:
BOOL ←
TRUE] ~ {
ENABLE UNWIND => NULL;
slider: S.Slider ← NARROW[viewer.data, KnobAttachData].slider;
IF whichKnob=GetAttachmentUnderLock[viewer] THEN RETURN; --If already in desired condition, then exit
First, disconnect from old knob (if there is one), and then reconnect to new knob (if there is one).
DetachKnobAttachViewerFromKnob[viewer];
SELECT whichKnob
FROM
left => AttachKnobAttachViewerToKnob[viewer, left];
right => AttachKnobAttachViewerToKnob[viewer, right];
none => NULL;
ENDCASE => ERROR;
ViewerOps.PaintViewer[viewer, all, paint];
};
GetAttachment:
PUBLIC
ENTRY
PROC [viewer: KnobAttachViewer]
RETURNS [Attachment] ~ {
ENABLE UNWIND => NULL;
RETURN [GetAttachmentUnderLock[viewer]];
};
Private Knob Access Procedures
Global data
attached: ARRAY KnobIndex OF KnobAttachViewer ← ALL[NIL];
threshold, sensitivity: INT; --Used for accelerating knobs
fork: BOOLEAN ← FALSE; -- "
ProfileChanged:
ENTRY UserProfile.ProfileChangedProc ~ {
ENABLE UNWIND => NULL;
threshold ← UserProfile.Number["Knob.Threshold", 5]+2;
sensitivity ← UserProfile.Number["Knob.Sensitivity", 20];
fork ← UserProfile.Boolean["Knob.Fork", FALSE];
};
UpdateSliderProcess:
PROC [knob: KnobIndex] ~ {
This procedure is run as an independent process which periodically checks to see if the knobs have moved. If they have, the corresponding slider is updated.
UpdateSliderInternal:
ENTRY PROC ~ {
ENABLE UNWIND => NULL;
IF attached[knob] #
NIL
AND 0#offset
THEN {
data: KnobAttachData ← NARROW[attached[knob].data];
slider: S.Slider ← data.slider;
m: INT ← MAX[1, threshold-waitCycles];
sliderOffset: REAL ← m*sensitivity/10000.0*offset;
sliderOffset: REAL ← (IF waitCycles < threshold
THEN multiplier*sensitivity/10000.0
ELSE sensitivity/10000.0)*offset;
newValue: REAL ← MIN[1.0, MAX[0.0, sliderOffset+GetContents[slider]]];
SetContents[slider, newValue];
IF data.turnProc#NIL THEN data.turnProc[slider, move, newValue, data.clientData];
};
};
offset: INTEGER;
waitCycles: INT;
Process.SetPriority[Process.priorityClient3]; --Set to higher priority
DO
--FOREVER
[offset, waitCycles] ← KR.OffsetSinceLastCall[knob];
UpdateSliderInternal[];
ENDLOOP;
};
sliderTable: RefTab.Ref ~ RefTab.Create[];
SliderWaiting: CONDITION;
SetContents:
INTERNAL
PROC [slider: ViewerClasses.Viewer, newValue:
REAL] ~ {
Ensure an entry in the sliderTable telling the most recent version
[] ← RefTab.Store[x: sliderTable, key: slider, val: NEW[REAL ← newValue]];
BROADCAST SliderWaiting;
};
GetContents:
INTERNAL
PROC [slider: ViewerClasses.Viewer]
RETURNS [value:
REAL] ~ {
If slider is in sliderTable, return the value from there. Otherwise, return it from Sliders.GetContents;
ref: REF;
found: BOOL;
[found, ref] ← RefTab.Fetch[x: sliderTable, key: slider];
IF found THEN RETURN [NARROW[ref, REF REAL]^] ELSE RETURN [Sliders.GetContents[slider]];
};
PaintSlidersProcess:
PROC ~ {
This procedure updates the painting of the sliders.
WaitForSlider:
ENTRY
PROC ~ {
ENABLE UNWIND => NULL;
UNTIL RefTab.GetSize[x: sliderTable]>0
DO
WAIT SliderWaiting;
ENDLOOP;
};
GetSliderUpdateInfo:
ENTRY
PROC
RETURNS [slider: ViewerClasses.Viewer ←
NIL, newValue:
REAL] ~ {
This is an entry proc to make the enumeration and deletion atomic.
ENABLE UNWIND => NULL;
ReturnFirstPair: RefTab.EachPairAction = {
[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
slider ← NARROW[key];
newValue ← NARROW[val, REF REAL]^;
RETURN [TRUE]; --Always quit after first call
};
IF RefTab.Pairs[x: sliderTable, action: ReturnFirstPair] THEN [] ← RefTab.Delete[x: sliderTable, key: slider];
};
slider: ViewerClasses.Viewer;
value: REAL;
DO
--forever
UNTIL ([slider, value] ← GetSliderUpdateInfo[]).slider =
NIL
DO
Sliders.SetContents[slider: slider, contents: value];
ENDLOOP;
WaitForSlider[];
ENDLOOP;
};
AttachKnobAttachViewerToKnob:
INTERNAL
PROC [v: KnobAttachViewer, knob: KnobIndex] ~ {
detachedViewer: KnobAttachViewer ← attached[knob];
data: KnobAttachData ← NARROW[v.data];
attached[knob] ← v;
IF detachedViewer # NIL THEN ViewerOps.PaintViewer[detachedViewer, all];
};
DetachKnobAttachViewerFromKnob:
PROC [v: KnobAttachViewer] ~ {
SELECT GetAttachmentUnderLock[v]
FROM
left => attached[left] ← NIL;
right => attached[right] ← NIL;
none => NULL;
ENDCASE => ERROR;
};
GetAttachmentUnderLock:
PROC [viewer: KnobAttachViewer]
RETURNS [Attachment] ~ {
RETURN [
See if viewer is the same as the one hooked onto the left knob, or the right knob.
THIS PROCEDURE SHOULD ONLY BE CALLED FROM AN ENTRY PROC!!!
SELECT viewer
FROM
attached[left] => left,
attached[right] => right,
ENDCASE => none
]
};
KnobAdjustViewer Class Information
KANotify:
ENTRY
V.NotifyProc ~ {
ENABLE UNWIND => NULL;
mouseX, mouseY: REAL;
FOR actions:
LIST
OF
REF
ANY ← input, actions.rest
UNTIL actions=
NIL
DO
WITH actions.first
SELECT
FROM
x: TIPUser.TIPScreenCoords => {
mouseX ← x.mouseX; mouseY ← x.mouseY;
};
x:
ATOM => {
SELECT x
FROM
$AttachToLeft => AttachKnobAttachViewerToKnob[self, left];
$AttachToRight => AttachKnobAttachViewerToKnob[self, right];
$Detach => DetachKnobAttachViewerFromKnob[self];
ENDCASE => NULL;
};
ENDCASE => ERROR;
ENDLOOP;
ViewerOps.PaintViewer[self, all];
};
black: I.ConstantColor ~ I.MakeGray[1];
white: I.ConstantColor ~ I.MakeGray[0];
leftDial: I.Trajectory ← ImagerPath.MoveTo[[3,4]].ArcTo[[5,6], [3,8]].ArcTo[[1,6], [3,4]];
rightDial: I.Trajectory ← ImagerPath.MoveTo[[8,4]].ArcTo[[10,6], [8,8]].ArcTo[[6,6], [8,4]];
strokeWidth: REAL ← 0.7;
KAPaint:
V.PaintProc ~ {
data: KnobAttachData ← NARROW[self.data];
I.Scale2T[context, [self.cw/11.0, self.ch/11.0]];
Clean the slate
IF ~clear
THEN {
I.SetColor[context, white];
I.MaskRectangleI[context, 0,0, 11,11];
};
I.SetStrokeWidth[context, strokeWidth];
I.MaskStrokeTrajectory[context, leftDial]; I.MaskStrokeTrajectory[context, rightDial];
SELECT GetAttachmentUnderLock[self]
FROM
left => I.MaskFillTrajectory[context, leftDial];
right => I.MaskFillTrajectory[context, rightDial];
ENDCASE => NULL;
};
KADestroy:
V.DestroyProc ~ {
DetachKnobAttachViewerFromKnob[self];
};
kaTipTable: TIPUser.TIPTable ~ TIPUser.InstantiateNewTIPTable["KnobAttach.TIP"];
kaClass:
V.ViewerClass ~
NEW[
V.ViewerClassRec ← [
flavor: $KnobAttach,
notify: KANotify,
paint: KAPaint,
destroy: KADestroy,
init: KAInit,
tipTable: kaTipTable,
cursor: crossHairsCircle
]];
Initialization
Init:
PROC ~
TRUSTED {
ViewerOps.RegisterViewerClass[$KnobAttach, kaClass];
FOR knob: KnobIndex
IN KnobIndex
DO
Process.Detach[FORK UpdateSliderProcess[knob]];
ENDLOOP;
Process.Detach[FORK PaintSlidersProcess];
UserProfile.CallWhenProfileChanges[ProfileChanged];
};
Init[];
END.
Eric Nickell February 21, 1986 3:34:42 pm PST
Changed to separate calling the TurnProc from the painting of the slider, so that locking the column which the slider is in does not interrupt calls to the client TurnProc.
changes to: DIRECTORY, KnobAttachImpl, ProfileChanged, UpdateSliderProcess, UpdateSliderInternal (local of UpdateSliderProcess), sliderTable, SliderWaiting, SetContents, GetContents, PaintSlidersProcess, WaitForSlider (local of PaintSlidersProcess), GetSliderUpdateInfo (local of PaintSlidersProcess), ReturnFirstPair (local of GetSliderUpdateInfo, local of PaintSlidersProcess), AttachKnobAttachViewerToKnob, Init