ControlsSliderDialImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, July 2, 1992 6:10 pm PDT
Ken Shoemake, September 3, 1989 1:39:48 am PDT
DIRECTORY CedarProcess, Controls, ControlsPrivate, Convert, Draw2d, Imager, ImagerBackdoor, --MouseTrap,-- Process, Real, RealFns, Rope, UserProfile, ViewerClasses, ViewerOps, ViewerTools;
ControlsSliderDialImpl: CEDAR MONITOR
IMPORTS CedarProcess, Controls, ControlsPrivate, Convert, Draw2d, Imager, ImagerBackdoor, --MouseTrap,-- Process, Real, RealFns, UserProfile, ViewerOps, ViewerTools
EXPORTS Controls, ControlsPrivate
~ BEGIN
Types
ROPE:    TYPE ~ Rope.ROPE;
Context:   TYPE ~ Imager.Context;
VEC:    TYPE ~ Imager.VEC;
Control:   TYPE ~ Controls.Control;
DetentList:  TYPE ~ Controls.DetentList;
Mouse:   TYPE ~ Controls.Mouse;
SliderTaper:  TYPE ~ Controls.SliderTaper;
Event:   TYPE ~ ControlsPrivate.Event;
Viewer:   TYPE ~ ViewerClasses.Viewer;
SliderDial:  TYPE ~ REF SliderDialRec;
SliderDialRec: TYPE ~ RECORD [
t:       REAL ¬ 0.0,      -- parametric pos'n (0~min, 1~max)
tPrev:      REAL ¬ 0.0,      -- (private) previous t
detents:     DetentList ¬ NIL,    -- list of detents
detented:     BOOL ¬ FALSE,     -- (private) true if control detented
detentedPrev:   BOOL ¬ FALSE,     -- (private) true if was detented
taper:      SliderTaper ¬ lin,    -- lin, log, or exponential slider
cx, cy, rad, radSq:  REAL ¬ 0.0,      -- center and radius of dial
queued:     BOOL ¬ FALSE,     -- true if control.proc called via queue
queuing:     BOOL ¬ FALSE,     -- true if servicing the queue
queue:     LIST OF Event ¬ NIL,   -- queue events if control.proc busy
queueTail:    LIST OF Event ¬ NIL
];
Initialization
NewSliderDial: PUBLIC PROC [control: Control] ~ {
sliderDial: SliderDial ¬ NEW[SliderDialRec ¬ [detents: control.detents, taper: control.taper]];
control.sliderDialRef ¬ sliderDial;
IF control.max # control.min THEN {
FOR d: DetentList ¬ sliderDial.detents, d.rest WHILE d # NIL DO
d.first.t ¬ (d.first.value-control.min)/(control.max-control.min);
SELECT control.taper FROM
log => d.first.t ¬ UnExpTaperT[d.first.t, 0.01];
exp => d.first.t ¬ UnExpTaperT[d.first.t, 100.0];
ENDCASE;
ENDLOOP;
sliderDial.t ¬ (control.init-control.min)/(control.max-control.min);
SELECT control.taper FROM
log => sliderDial.t ¬ UnExpTaperT[sliderDial.t, 0.01];
exp => sliderDial.t ¬ UnExpTaperT[sliderDial.t, 100.0];
ENDCASE;
};
sliderDial.detented ¬ IsDetented[control, sliderDial];
control.value ¬ control.init;
sliderDial.rad ¬ MIN[control.w, control.h]/2-1;
sliderDial.radSq ¬ sliderDial.rad*sliderDial.rad;
sliderDial.cx ¬ control.w/2;
sliderDial.cy ¬ sliderDial.cx-1;
};
Notification
NotifySliderDial: PUBLIC PROC [control: Control, mouse: Mouse] ~ {
ViewerNotLocked: PROC RETURNS [BOOL] ~ TRUSTED {
If root locked (because of sibling painting), don't paint control,
since painting would wait till the other painting done.
root: Viewer ¬ control.viewer;
WHILE root.parent # NIL DO root ¬ root.parent; ENDLOOP;
RETURN[root.lock.count = 0 OR root.lock.process = LOOPHOLE[Process.GetCurrent[]]];
};
s: SliderDial ¬ NARROW[control.sliderDialRef];
tSave: REAL ¬ s.t;
IF mtEnabled THEN SELECT mouse.state FROM -- stay inside control till up
down => StartMouseTrap[control];    -- MouseTrap clears itself on mouse up
held => IF control # mtControl THEN StartMouseTrap[control]; -- could slide into control
up => [] ¬ StopMouseTrap[];     -- presently redundant
ENDCASE;
control.whatChanged ¬ $Moused;
IF mouse.state # up THEN {
control might be used, even if not repainted, so ensure .value and .valuePrev valid:
ComputeControlTandValue[control, mouse.pos.x, mouse.pos.y]; -- but this clobbers s.t
IF ViewerNotLocked[]
THEN RequestPaint[control]
ELSE s.t ¬ tSave; -- reset s.t, or else UnTick fails when RequestPaint finally called
};
IF control.proc = NIL THEN RETURN;
IF NOT ControlsPrivate.ControlProcBusy[control]
THEN {
control.mouse ¬ mouse;
ControlsPrivate.ForkControlProc[control];
}
ELSE {   -- queue all down and up events, maybe held event:
event: Event ¬ [mouse, control.value, control.valuePrev];
IF mouse.state = held AND s.queueTail # NIL AND s.queueTail.first.mouse.state = held
THEN StompQueueTail[s, event] -- overwrite most recent event if held
ELSE QueueEvent[s, event];
IF NOT s.queuing THEN {
s.queuing ¬ TRUE;
[] ¬ CedarProcess.Fork[ServiceQueue, control];
};
};
};
CalledFromQueue: PUBLIC PROC [control: Control] RETURNS [BOOL] ~ {
s: SliderDial ¬ NARROW[control.sliderDialRef];
RETURN[s # NIL AND s.queued];
};
GetQueue: PUBLIC PROC [control: Control] RETURNS [LIST OF Event] ~ {
s: SliderDial ¬ NARROW[control.sliderDialRef];
RETURN[IF s # NIL THEN s.queue ELSE NIL];
};
StompQueueTail: ENTRY PROC [s: SliderDial, e: Event] ~ {s.queueTail.first ¬ e};
QueueEvent: ENTRY PROC [s: SliderDial, e: Event] ~ {
IF s.queue = NIL
THEN s.queueTail ¬ s.queue ¬ LIST[e]
ELSE s.queueTail ¬ s.queueTail.rest ¬ LIST[e];
};
PopQueue: ENTRY PROC [s: SliderDial] RETURNS [e: Event] ~ {
e ¬ s.queue.first;
s.queue ¬ s.queue.rest;
IF s.queue = NIL THEN s.queueTail ¬ NIL;
};
ServiceQueue: CedarProcess.ForkableProc ~ {
e: Event;
control: Control ¬ NARROW[data];
s: SliderDial ¬ NARROW[control.sliderDialRef];
IF s.queued THEN ERROR;
s.queued ¬ TRUE;    -- all control.procs called herein are via the queue
Controls.WaitControlProcDone[control];
WHILE s.queue # NIL DO
e ¬ PopQueue[s];
control.mouse ¬ e.mouse;
control.value ¬ e.value;
control.valuePrev ¬ e.valuePrev;
ControlsPrivate.ForkControlProc[control];   -- service the queued event
Controls.WaitControlProcDone[control];
ENDLOOP;
s.queuing ¬ s.queued ¬ FALSE;
};
Mouse Trapping
mtEnabled:  BOOL ¬ UserProfile.Boolean["Controls.TrapMouse", TRUE];
mtControl:  Control ¬ NIL;
mtBoxData:  MouseTrap.BoxTrapData ← NEW[MouseTrap.BoxTrapDataRep];
mtRoundData: MouseTrap.RoundTrapData ← NEW[MouseTrap.RoundTrapDataRep];
StopMouseTrap: PROC ~ {
[] ← MouseTrap.UnsetTrap[];
mtControl ¬ NIL;
};
StartMouseTrap: PROC [control: Control] ~ {
cx, cy, x0, y0, x1, y1: INTEGER;
v: Viewer ← control.viewer;
mtControl ← control;
IF control.type = dial
THEN {
s: SliderDial ← NARROW[control.sliderDialRef];
[cx, cy] ← MouseTrap.UserToMouseCoords[v, Real.Round[s.cx], Real.Round[s.cy]];
mtRoundData^ ← [no, [cx, cy], s.radSq];
[] ← MouseTrap.SetTrap[[TRUE, MouseTrap.RoundTrap, mtRoundData]];
}
ELSE {
[x0, y0] ← MouseTrap.UserToMouseCoords[v, 0, 0];
[x1, y1] ← MouseTrap.UserToMouseCoords[v, v.cw-1, v.ch-1];
IF y1 < y0 THEN {swap: INTEGER ← y0; y0 ← y1; y1 ← swap};
mtBoxData^ ← [no, [x0, y0], [x1, y1]];
[] ← MouseTrap.SetTrap[[TRUE, MouseTrap.BoxTrap, mtBoxData]];
};
};
EnableMouseTrapping: PUBLIC PROC [yes: BOOL] ~ {mtEnabled ¬ yes};
ProfileChanged: UserProfile.ProfileChangedProc ~ {
mtEnabled ¬ UserProfile.Boolean["Controls.TrapMouse", TRUE];
};
Reading/Writing
SetSliderDialValue: PUBLIC PROC [control: Control, value: REAL, repaint: BOOL ¬ TRUE] ~ {
IF control # NIL THEN {
control.valuePrev ¬ control.value;
control.value ¬ value;
IF control.sliderDialRef # NIL THEN {
sliderDial: SliderDial ¬ NARROW[control.sliderDialRef];
sliderDial.detentedPrev ¬ sliderDial.detented;
sliderDial.detented ¬ IsDetented[control, sliderDial];
sliderDial.tPrev ¬ sliderDial.t;
sliderDial.t ¬ TFromValue[control, sliderDial];
IF repaint THEN RequestPaint[control];
};
};
};
GetSliderDialValue: PUBLIC PROC [control: Control] RETURNS [REAL] ~ {
RETURN[control.value];
};
GetSliderDialDeltaValue: PUBLIC PROC [control: Control] RETURNS [REAL] ~ {
RETURN[control.value-control.valuePrev];
};
Painting
RequestPaint: PROC [control: Control] ~ {
ViewerOps.PaintViewer[control.viewer, client, FALSE, control];
IF control.report AND control.status # NIL THEN {
refAny: REF ANY ¬ ViewerOps.FetchProp[control.status, $RopeFromControlValueProc];
valueRope: ROPE;
repaint: BOOL ¬ FALSE;
WITH refAny SELECT FROM
refProc: REF ControlsPrivate.RopeFromValueProc =>
[valueRope, repaint] ¬ refProc­[control];
ENDCASE => {
mul: REAL ¬ RealFns.Power[10.0, control.precision];
repaint ¬ Real.Floor[mul*control.valuePrev] # Real.Floor[mul*control.value];
IF repaint THEN valueRope ¬ Convert.FtoRope[control.value, control.precision];
};
IF repaint THEN {
ViewerTools.SetContents[control.status, valueRope];
ViewerOps.PaintViewer[control.status, client];
};
};
};
PaintSliderDial: PUBLIC ViewerClasses.PaintProc ~ {
control: Control ¬ NARROW[self.data];
sliderDial: SliderDial ¬ NARROW[control.sliderDialRef];
IF sliderDial = NIL THEN RETURN;
IF control.w = 0 THEN control.w ¬ control.viewer.cw;
IF control.h = 0 THEN control.h ¬ control.viewer.ch;
IF whatChanged = NIL
THEN {
Imager.SetColor[context, control.color];
SELECT control.type FROM
dial => Draw2d.Circle[context, [sliderDial.cx, sliderDial.cy], sliderDial.rad, FALSE];
vSlider, hSlider => {
w: NAT ¬ self.ww-1;
h: NAT ¬ self.wh-1;
Imager.MaskVectorI[context, 0, 2, 0, h];
Imager.MaskVectorI[context, 0, h, w, h];
Imager.MaskVectorI[context, w, h, w, 2];
Imager.MaskVectorI[context, w, 2, 0, 2];
};
ENDCASE;
}
ELSE UnTick[context, control];
IF control.textLocation.place = inside
THEN Imager.SetColor[context, ImagerBackdoor.invert]
ELSE Imager.SetColor[context, control.color];
FOR detents: DetentList ¬ sliderDial.detents, detents.rest WHILE detents # NIL DO
Tick[context, control, detents.first.t, FALSE, 1];
ENDLOOP;
Tick[context, control, sliderDial.t, sliderDial.detented, 2];
sliderDial.detentedPrev ¬ sliderDial.detented;
};
UnTick: PUBLIC PROC [context: Context, control: Control] ~ {
sliderDial: SliderDial ¬ NARROW[control.sliderDialRef];
Imager.SetColor[context, Imager.white];
Tick[context, control, sliderDial.tPrev, sliderDial.detentedPrev, 2];
};
Tick: PUBLIC PROC [
context: Context,
control: Control,
t: REAL,
detent: BOOL ¬ FALSE,
width: NAT ¬ 1]
~ {
SELECT control.type FROM
vSlider => {
y: REAL ¬ MIN[control.h-3, MAX[3, control.h*t]];
Imager.MaskRectangle[context, [1, y-width/2, control.w-2, width]];
IF detent THEN Draw2d.Square[context, [1+control.w/2, y], 3.0];
};
hSlider => {
x: REAL ¬ MIN[control.w-2, MAX[2, control.w*t]];
Imager.MaskRectangle[context, [x-width/2, 2, width, control.h-4]];
IF detent THEN Draw2d.Square[context, [x+1, control.h/2-1], 3.0];
};
dial => {
sliderDial: SliderDial ¬ NARROW[control.sliderDialRef]; 
rad: REAL ¬ sliderDial.rad-3;
deg: REAL ¬ 360.0*t;
Imager.SetStrokeWidth[context, width];
Imager.MaskVector[context, [sliderDial.cx+rad*RealFns.CosDeg[deg], sliderDial.cy+rad*RealFns.SinDeg[deg]], [sliderDial.cx, sliderDial.cy]];
IF detent THEN Draw2d.Circle[context, [sliderDial.cx, sliderDial.cy], 3.0, TRUE];
};
ENDCASE => NULL;
};
SetDetentGrainSize: PUBLIC PROC [control: Control, grainSize: REAL] ~ {
control.grainSize ¬ grainSize;
};
GetDetentGrainSize: PUBLIC PROC [control: Control] RETURNS [REAL] ~ {
RETURN[control.grainSize];
};
TFromValue: PROC [control: Control, sliderDial: SliderDial] RETURNS [t: REAL ¬ 0.0] ~ {
IF control.max = control.min THEN RETURN;
t ¬ (control.value-control.min)/(control.max-control.min);
SELECT sliderDial.taper FROM
log => t ¬ UnExpTaperT[t, 0.01];
exp => t ¬ UnExpTaperT[t, 100.0];
ENDCASE;
};
ComputeControlTandValue: PROC [control: Control, x, y: INTEGER] ~ {
sliderDial: SliderDial ¬ NARROW[control.sliderDialRef];
ComputeControlT[control, sliderDial, x, y];
ComputeControlValue[control, sliderDial];
IF control.precision = 0 THEN {
control.value ¬ Real.Round[control.value];
sliderDial.t ¬ TFromValue[control, sliderDial];
};
};
ComputeControlT: PROC [control: Control, sliderDial: SliderDial, x, y: INTEGER] ~ {
fine: REAL ~ 0.1;
fineTune: ATOM ¬ IF NOT control.mouse.controlKey THEN NIL
ELSE IF control.mouse.state = up THEN $Up ELSE $Down;
sliderDial.tPrev ¬ sliderDial.t;
SELECT control.type FROM
vSlider => SELECT y FROM
< 3 => sliderDial.t ¬ 0.0;
> control.h-3 => sliderDial.t ¬ 1.0;
ENDCASE => sliderDial.t ¬ REAL[y-2]/REAL[control.h-4];
hSlider => SELECT x FROM
< 3 => sliderDial.t ¬ 0.0;
> control.w-3 => sliderDial.t ¬ 1.0;
ENDCASE => sliderDial.t ¬ REAL[x-3]/REAL[control.w-6];
dial => {
sliderDial.t ¬ RealFns.ArcTan[y-sliderDial.cy, x-sliderDial.cx]/(2.0*3.1415926535);
IF y-sliderDial.cy < 0.0 THEN sliderDial.t ¬ sliderDial.t+1.0;
IF fineTune = $Down THEN { -- fine-tune dial
IF ABS[sliderDial.tPrev-sliderDial.t] > 0.8 THEN { -- crossing zero, special cases:
IF sliderDial.t > sliderDial.tPrev
THEN sliderDial.t ¬ sliderDial.t-1.0 -- t near 1, tPrev near 0, make t negative
ELSE sliderDial.tPrev ¬ sliderDial.tPrev-1.0; -- t ~ 0, tPrev ~ 1, make tPrev neg         
};
sliderDial.t ¬ sliderDial.tPrev+fine*(sliderDial.t-sliderDial.tPrev); -- interpolate
IF sliderDial.t < 0.0 THEN sliderDial.t ¬ 1.0+sliderDial.t;
};
};
ENDCASE;
IF (control.type = vSlider OR control.type = hSlider) AND fineTune = $Down THEN
sliderDial.t ¬ sliderDial.tPrev+fine*(sliderDial.t-sliderDial.tPrev); -- fine-tune slider
IF fineTune = $Up THEN sliderDial.t ¬ sliderDial.tPrev; -- prevent snapping to mouse pos'n
sliderDial.t ¬ MIN[1.0, MAX[0.0, sliderDial.t]];
};
ln100: REAL ¬ RealFns.Ln[100.0];
ln001: REAL ¬ RealFns.Ln[0.01];
UnExpTaperT: PROC [t, base: REAL] RETURNS [REAL] ~ {
RETURN[RealFns.Log[base, (base-1.0)*t+1.0]];
};
ExpTaperT: PROC [t: REAL, lnBase, base: REAL] RETURNS [REAL] ~ {
RETURN[(RealFns.Exp[lnBase*t]-1.0)/(base-1.0)];
};
IsDetented: PROC [control: Control, sliderDial: SliderDial] RETURNS [BOOL ¬ FALSE] ~ {
FOR d: DetentList ¬ sliderDial.detents, d.rest WHILE d # NIL DO
t: REAL ¬ d.first.t;
IF ABS[sliderDial.t-t] < control.grainSize THEN RETURN[TRUE];
IF t > sliderDial.t THEN RETURN;
ENDLOOP;
};
ComputeControlValue: PROC [control: Control, sliderDial: SliderDial] ~ {
NoDetents: PROC ~ {
tt: REAL ¬ SELECT sliderDial.taper FROM
log => ExpTaperT[sliderDial.t, ln001, 0.01],
exp => ExpTaperT[sliderDial.t, ln100, 100.0],
ENDCASE => sliderDial.t;
control.value ¬ (1.0-tt)*control.min+tt*control.max;
};
control.valuePrev ¬ control.value;
sliderDial.detented ¬ FALSE;
IF sliderDial.detents = NIL
THEN NoDetents[]
ELSE {
t0, t1, value0, value1: REAL ¬ 0.0;
FOR d: DetentList ¬ sliderDial.detents, d.rest WHILE d # NIL DO
t: REAL ¬ d.first.t;
IF ABS[sliderDial.t-t] < control.grainSize THEN {
sliderDial.t ¬ t; control.value ¬ d.first.value; sliderDial.detented ¬ TRUE;
EXIT;
};
IF t > sliderDial.t THEN EXIT;
ENDLOOP;
IF NOT sliderDial.detented THEN NoDetents[];
};
};
Start Code
UserProfile.CallWhenProfileChanges[ProfileChanged];
END.
..
Notification
NotifySliderDial: PUBLIC PROC [control: Control] ~ {
busy: BOOL ¬ ControlsPrivate.ControlProcBusy[control];
IF mtEnabled THEN SELECT control.mouse.state FROM -- stay inside control till up
up => [] ¬ UnTrapMouse[];
ENDCASE => TrapMouse[control];  -- check down and held (could slide into control)
control.whatChanged ¬ $Moused;
SELECT TRUE FROM
NOT busy => {
IF control.mouse.state # up THEN { -- don't repaint on up
ComputeControlTandValue[control, control.mouse.pos.x, control.mouse.pos.y];
RequestPaint[control];
};
ControlsPrivate.ForkControlProc[control];
};
control.mouse.state = up =>
Queue mouseUp even if control.proc busy; fork to reduce notify delay:
[] ¬ CedarProcess.Fork[WaitThenServiceUp, control];
control.mouse.state = held =>
IF NOT heldWaiting THEN [] ¬ CedarProcess.Fork[WaitThenServiceHeld, control];
ENDCASE;
};
heldWaiting: BOOL ¬ FALSE;
WaitThenServiceUp: CedarProcess.ForkableProc ~ {
control: Control ¬ NARROW[data];
WHILE heldWaiting DO ControlsPrivate.WaitControlProcDone[control]; ENDLOOP;
ControlsPrivate.ForkControlProc[control];   -- service the up event
};
WaitThenServiceHeld: CedarProcess.ForkableProc ~ {
control: Control ¬ NARROW[data];
heldWaiting ¬ TRUE;
ControlsPrivate.WaitControlProcDone[control]; -- when control.proc is finished
ControlsPrivate.ForkControlProc[control];   -- service the last held event
ControlsPrivate.WaitControlProcDone[control];
heldWaiting ¬ FALSE;
};
mtEnabled:  BOOL ¬ UserProfile.Boolean["Controls.TrapMouse", TRUE];
mtControl:  Control ¬ NIL;
mtBoxData:  MouseTrap.BoxTrapData ¬ NEW[MouseTrap.BoxTrapDataRep];
mtRoundData: MouseTrap.RoundTrapData ¬ NEW[MouseTrap.RoundTrapDataRep];
UnTrapMouse: PROC ~ {
[] ¬ MouseTrap.UnsetTrap[];
mtControl ¬ NIL;
};
TrapMouse: PROC [control: Control] ~ {
cx, cy, x0, y0, x1, y1: INTEGER;
sliderDial: SliderDial ¬ NARROW[control.sliderDialRef];
v: Viewer ¬ control.viewer;
IF control # mtControl THEN {
mtControl ¬ control;
IF control.type = dial
THEN {
[cx, cy] ¬ MouseTrap.UserToMouseCoords[
v, Real.InlineRoundI[sliderDial.cx], Real.InlineRoundI[sliderDial.cy]];
mtRoundData­ ¬ [no, [cx, cy], sliderDial.radSq];
[] ¬ MouseTrap.SetTrap[[TRUE, MouseTrap.RoundTrap, mtRoundData]];
}
ELSE {
[x0, y0] ¬ MouseTrap.UserToMouseCoords[v, 0, 0];
[x1, y1] ¬ MouseTrap.UserToMouseCoords[v, v.cw-1, v.ch-1];
IF y1 < y0 THEN {swap: INTEGER ¬ y0; y0 ¬ y1; y1 ¬ swap};
mtBoxData­ ¬ [no, [x0, y0], [x1, y1]];
[] ¬ MouseTrap.SetTrap[[TRUE, MouseTrap.BoxTrap, mtBoxData]];
};
};
};
EnableMouseTrapping: PUBLIC PROC [yes: BOOL] ~ {mtEnabled ¬ yes};
ProfileChanged: UserProfile.ProfileChangedProc ~ {
mtEnabled ¬ UserProfile.Boolean["Controls.TrapMouse", TRUE];
};