DIRECTORY
Cursors USING [CursorType],
Imager USING [Color, MakeGray, MaskRectangle, MaskRectangleI, SetColor],
InputFocus USING [CaptureButtons, ReleaseButtons],
Process USING [Detach, Milliseconds, MsecToTicks, SetTimeout],
Sliders,
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPScreenCoordsRec],
ViewerClasses USING [GetProc, NotifyProc, PaintProc, PaintRectangle, SetProc, Viewer, ViewerRec, ViewerClass, ViewerClassRec],
ViewerOps USING [CreateViewer, DestroyViewer, GetViewer, MouseInViewer, PaintViewer, RegisterViewerClass, SetViewer, UserToScreenCoords],
WindowManager USING [RestoreCursor];

SlidersImpl: CEDAR MONITOR
IMPORTS Imager, InputFocus, Process, TIPUser, ViewerOps, WindowManager
EXPORTS Sliders
= BEGIN OPEN Sliders;

SliderState: TYPE = {inputDisabled, inputEnabled};
SliderValue: TYPE = REAL; -- in range [0.0, 1.0]
SliderData: TYPE = REF SliderDataRec; 
SliderDataRec: TYPE = RECORD [
sliderProc: SliderProc _ NIL, -- client procedure called when slider value changed
filterProc: FilterProc _ NIL, -- client procedure for filtering slider updates
orientation: SliderOrientation, -- orientation of slider image (horizontal or vertical)
foreground: Imager.Color, -- color of slider foreground
background: Imager.Color, -- color of slider background
normalizedSliderValue: NormalizedSliderValue _ 0.0, -- in range [0.0, 1.0]
mouseValue: SliderValue _ 0.0, -- mouse position in slider
sliderValue: SliderValue _ 0.0, -- slider value in viewer screen coordinates
maxSliderValue: SliderValue _ 0.0, -- maximum slider value in viewer screen coordinates
oldSliderValue: SliderValue _ 0.0, -- previous value in viewer screen coordinates
savedSliderValue: SliderValue _ 0.0, -- value to rollback to if operation aborted
reason: Reason _ move, -- reason for calling client proc
oldReason: Reason _ move, -- reason for calling client proc the last time
state: SliderState _ inputDisabled, -- indicates whether mouse input is being accepted
clientData: REF ANY
];

defaultForeground: Imager.Color ~ Imager.MakeGray[0.6]; -- gray
defaultBackground: Imager.Color ~ Imager.MakeGray[0.0]; -- white

Create: PUBLIC PROC [info: ViewerClasses.ViewerRec _ [], sliderProc: SliderProc _ NIL, filterProc: FilterProc _ NIL, orientation: SliderOrientation _ vertical, foreground: Imager.Color _ NIL, background: Imager.Color _ NIL, value: NormalizedSliderValue _ 0.0, clientData: REF ANY _ NIL, paint: BOOL _ TRUE] RETURNS [slider: Slider] = {
sliderData: SliderData _ NEW[SliderDataRec _ [
sliderProc: sliderProc, filterProc: filterProc, orientation: orientation, 
foreground: IF foreground=NIL THEN defaultForeground ELSE foreground, 
background: IF background=NIL THEN defaultBackground ELSE background, 
normalizedSliderValue: value, clientData: clientData]];
info.data _ sliderData;
info.scrollable _ FALSE;
RETURN[ViewerOps.CreateViewer[flavor: $Slider, info: info, paint: paint]];
};

GetContents: PUBLIC PROC [slider: Slider] RETURNS [contents: NormalizedSliderValue] = {
RETURN[NARROW[ViewerOps.GetViewer[viewer: slider], REF NormalizedSliderValue]^];
};

SetContents: PUBLIC PROC [slider: Slider, contents: NormalizedSliderValue] = {
value: REF NormalizedSliderValue _ NEW[NormalizedSliderValue _ contents];
ViewerOps.SetViewer[viewer: slider, data: value];
};

Destroy: PUBLIC PROC [slider: Slider] = {ViewerOps.DestroyViewer[slider]};

SlidersPaint: ViewerClasses.PaintProc = {
sliderData: SliderData ~ NARROW[self.data];
min, max: REAL;
xmin: REAL _ 0;
ymin: REAL _ 0;
xmax: REAL _ self.cw;
ymax: REAL _ self.ch;
WITH whatChanged SELECT FROM
rect: ViewerClasses.PaintRectangle => whatChanged _ NIL;
ENDCASE;
SELECT whatChanged FROM
NIL => {
Imager.SetColor[context, sliderData.background];
Imager.MaskRectangleI[context, 0, 0, self.cw, self.ch]; 
SetMaxSliderValue[self];
SetSliderValue[sliderData, sliderData.normalizedSliderValue];
min _ 0.0;
max _ sliderData.sliderValue;
Imager.SetColor[context, sliderData.foreground];
};
$sliderValue => {
IF sliderData.oldSliderValue <= sliderData.sliderValue THEN {
min _ sliderData.oldSliderValue;
max _ sliderData.sliderValue;
Imager.SetColor[context, sliderData.foreground];
}
ELSE {
min _ sliderData.sliderValue;
max _ sliderData.oldSliderValue;
Imager.SetColor[context, sliderData.background];
};
};
ENDCASE => NULL;
IF sliderData.orientation = horizontal THEN { xmin _ min; xmax _ max }
ELSE { ymin _ min; ymax _ max };
Imager.MaskRectangle[context, [x: xmin, y: ymin, w: xmax-xmin, h: ymax-ymin]];
sliderData.oldSliderValue _ sliderData.sliderValue;
};

SetMaxSliderValue: PROC [slider: Slider] = {
sliderData: SliderData _ NARROW[slider.data];
sliderData.maxSliderValue _ IF sliderData.orientation = horizontal THEN slider.cw ELSE slider.ch;
IF sliderData.maxSliderValue < 1.0 THEN sliderData.maxSliderValue _ 1.0;
};

SlidersGet: ViewerClasses.GetProc = {
sliderData: SliderData _ NARROW[self.data];
RETURN[NEW[NormalizedSliderValue _ sliderData.normalizedSliderValue]];
};

SlidersSet: ENTRY ViewerClasses.SetProc = {
dataValue: REF NormalizedSliderValue _ NARROW[data];
sliderData: SliderData _ NARROW[self.data];
SetSliderValue[sliderData, dataValue^];
ViewerOps.PaintViewer[viewer: self, hint: client, clearClient: FALSE, whatChanged: $sliderValue];
};

SetSliderValue: PRIVATE PROC [sliderData: SliderData, normalizedValue: NormalizedSliderValue] = {
SELECT normalizedValue FROM
< 0.0 => normalizedValue _ 0.0;
> 1.0 => normalizedValue _ 1.0;
ENDCASE;
sliderData.normalizedSliderValue _ normalizedValue;
sliderData.sliderValue _ sliderData.normalizedSliderValue * sliderData.maxSliderValue;
};

SlidersNotify: ViewerClasses.NotifyProc = TRUSTED {
ENABLE UNWIND => { InputFocus.ReleaseButtons[]; WindowManager.RestoreCursor[] };
v: ViewerClasses.Viewer;
c: BOOL;
mouse: TIPUser.TIPScreenCoords;
mouseValue: SliderValue;
mouseScreenCoords: TIPUser.TIPScreenCoords _ NEW[TIPUser.TIPScreenCoordsRec];
sliderData: SliderData _ NARROW[self.data];
FOR list: LIST OF REF ANY _ input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
x: ATOM => SELECT x FROM
$Enable => {
InputFocus.CaptureButtons[proc: SlidersNotify, tip: slidersClass.tipTable, viewer: self];
sliderData.state _ inputEnabled;
sliderData.savedSliderValue _ sliderData.sliderValue;
mouseValue _ IF sliderData.orientation = horizontal THEN mouse.mouseX ELSE mouse.mouseY;
SetNewSliderValue[sliderData: sliderData, value: mouseValue, reason: move];
CreateSliderProcess[self];
};
$Abort => {
InputFocus.ReleaseButtons[];
sliderData.state _ inputDisabled;
SetNewSliderValue[sliderData: sliderData, value: sliderData.savedSliderValue, reason: abort];
sliderProcessData.state _ dying;
};
$Move => IF sliderData.state = inputEnabled THEN {
mouseScreenCoords^ _ mouse^;
[v, c] _ ViewerOps.MouseInViewer[mouse];
IF v = self AND c THEN
 mouseValue _ 
 IF sliderData.orientation = horizontal THEN mouse.mouseX ELSE mouse.mouseY
ELSE IF MouseAboveSlider[self: self, coords: mouseScreenCoords] THEN
 mouseValue _ sliderData.maxSliderValue
ELSE IF MouseBelowSlider[self: self, coords: mouseScreenCoords] THEN
 mouseValue _ 0.0
ELSE mouseValue _ sliderData.mouseValue;
SetNewSliderValue[sliderData: sliderData, value: mouseValue, reason: move];
};
$Set => IF sliderData.state = inputEnabled THEN {
reason: Reason _ set;
InputFocus.ReleaseButtons[];
sliderData.state _ inputDisabled;
mouseScreenCoords^ _ mouse^;
[v, c] _ ViewerOps.MouseInViewer[mouse];
IF v = self AND c THEN
 mouseValue _ 
 IF sliderData.orientation = horizontal THEN mouse.mouseX ELSE mouse.mouseY
ELSE IF MouseAboveSlider[self: self, coords: mouseScreenCoords] THEN
 mouseValue _ sliderData.maxSliderValue
ELSE IF MouseBelowSlider[self: self, coords: mouseScreenCoords] THEN
 mouseValue _ 0.0
ELSE {
mouseValue _ sliderData.savedSliderValue;
reason _ abort;
};
SetNewSliderValue[sliderData: sliderData, value: mouseValue, reason: reason];
sliderProcessData.state _ dying;
};
ENDCASE => NULL;
z: TIPUser.TIPScreenCoords => mouse _ z;
ENDCASE => ERROR;
ENDLOOP;
};
SetNewSliderValue: PRIVATE ENTRY PROC [sliderData: SliderData, value: SliderValue, reason: Reason] = {
sliderData.mouseValue _ value;
sliderData.reason _ reason;
};

MouseAboveSlider: PRIVATE PROC [self: Slider, coords: TIPUser.TIPScreenCoords] RETURNS [above: BOOL] = {
cornerX, cornerY: INTEGER;
sliderData: SliderData _ NARROW[self.data];
IF sliderData.orientation = horizontal THEN {
[cornerX, cornerY] _ ViewerOps.UserToScreenCoords[self: self, vx: self.ww-2, vy: 0];
IF coords.mouseX > cornerX AND coords.mouseY >= cornerY AND coords.mouseY < cornerY + self.wh THEN RETURN[TRUE];
}
ELSE {
[cornerX, cornerY] _ ViewerOps.UserToScreenCoords[self: self, vx: 0, vy: self.wh-2];
IF coords.mouseY > cornerY AND coords.mouseX >= cornerX AND coords.mouseX < cornerX + self.ww THEN RETURN[TRUE];
};
RETURN[FALSE];
};

MouseBelowSlider: PRIVATE PROC [self: Slider, coords: TIPUser.TIPScreenCoords] RETURNS [below: BOOL] = {
cornerX, cornerY: INTEGER;
sliderData: SliderData _ NARROW[self.data];
[cornerX, cornerY] _ ViewerOps.UserToScreenCoords[self: self, vx: 0, vy: 0];
IF sliderData.orientation = horizontal THEN {
IF coords.mouseX < cornerX AND coords.mouseY >= cornerY AND coords.mouseY < cornerY + self.wh THEN RETURN[TRUE];
}
ELSE {
IF coords.mouseY < cornerY AND coords.mouseX >= cornerX AND coords.mouseX < cornerX + self.ww THEN RETURN[TRUE];
};
RETURN[FALSE];
};

SliderProcessData: TYPE = REF SliderProcessDataRec;
SliderProcessDataRec: TYPE = RECORD [
slider: Slider _ NIL,
timerCondition: CONDITION,
state: SliderProcessState _ alive
];
SliderProcessState: TYPE = {alive, dying};

sliderProcessData: SliderProcessData _ NIL;

CreateSliderProcess: PRIVATE PROC [slider: Slider] = {
sliderProcessData _ NEW[SliderProcessDataRec];
sliderProcessData.slider _ slider;
TRUSTED {Process.Detach[FORK SliderProcess[sliderProcessData]]};
};

SliderProcess: PRIVATE PROC [myData: SliderProcessData] = {
UpdateSliderValue: PROC [self: Slider] = {
sliderData: SliderData _ NARROW[self.data];
notifyClient: BOOL;
reason: Reason;
normalizedValue: NormalizedSliderValue;
[notifyClient, reason, normalizedValue] _ UpdateSlider[self];
IF sliderData.sliderProc # NIL AND notifyClient THEN sliderData.sliderProc[slider: self, reason: reason, value: normalizedValue, clientData: sliderData.clientData];
};
timerPeriod: Process.Milliseconds = 40;
WHILE myData.state = alive DO
UpdateSliderValue[myData.slider];
Wait[myData, timerPeriod];
ENDLOOP;
UpdateSliderValue[myData.slider];
};

UpdateSlider: PRIVATE ENTRY PROC [self: Slider] RETURNS [notifyClient: BOOL, reason: Reason, normalizedValue: NormalizedSliderValue] = {
sliderData: SliderData _ NARROW[self.data];
value: NormalizedSliderValue;
notifyClient _ FALSE;
IF sliderData.mouseValue # sliderData.oldSliderValue THEN {
notifyClient _ TRUE;
value _ sliderData.mouseValue / sliderData.maxSliderValue;
IF sliderData.filterProc # NIL THEN value _ sliderData.filterProc[value, sliderData.clientData];
SetSliderValue[sliderData, value];
IF sliderData.sliderValue # sliderData.oldSliderValue THEN {
notifyClient _ TRUE;
ViewerOps.PaintViewer[viewer: self, hint: client, clearClient: FALSE, whatChanged: $sliderValue];
};
};
IF sliderData.reason # sliderData.oldReason THEN notifyClient _ TRUE;
sliderData.oldReason _ sliderData.reason;
RETURN[notifyClient, sliderData.reason, sliderData.normalizedSliderValue];
};

Wait: PRIVATE ENTRY PROC [data: SliderProcessData, milliseconds: Process.Milliseconds] = {
TRUSTED {Process.SetTimeout[@data.timerCondition, Process.MsecToTicks[milliseconds]]};
WAIT data.timerCondition;
};
slidersClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
paint: SlidersPaint,
get: SlidersGet,
set: SlidersSet,
notify: SlidersNotify,
tipTable: TIPUser.InstantiateNewTIPTable["Slider.tip"],
cursor: crossHairsCircle
]];

ViewerOps.RegisterViewerClass[$Slider, slidersClass];

END.

–SlidersImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Written by Darlene Plebon on June 22, 1983 1:16 pm
Last Edited by: Beach, June 22, 1983 6:15 pm
Doug Wyatt, April 15, 1985 5:42:44 pm PST


slidersClass is a record containing the procedures and data common to all slidersClass viewer instances (class record).
Register the Sliders class of viewer with the Window Manager

Κέ–

"Cedar" style˜
code–

"Cedar" styleš
œ™K–

"Cedar" stylešœ
Οm
œ1™<K–

"Cedar" styleš
œ2™2K™,K™)—K˜š
Οk	˜	Kšœžœ˜Kšœžœ<˜HKšœžœ"˜2Kšœžœ1˜>Kš
œ˜Kšœžœ?˜LKšœžœk˜~Kšœ
žœz˜‰
Kšœžœ˜$—K˜KšΠblœžœ
ž˜Kšžœ?˜FKšžœ˜Kšœžœ
žœ	˜K˜Kšœ
žœ!˜2Kšœ
žœžœΟc˜0Kšœžœžœ˜&šœžœžœ˜Kšœžœ 4˜RKšœžœ 0˜NKšœ  7˜WKšœ ˜7Kšœ ˜7Kšœ4 ˜JKšœ ˜:Kšœ  ,˜LKšœ# 4˜WKšœ# .˜QKšœ% ,˜QKšœ !˜8Kšœ /˜IKšœ$ 2˜VKšœžœ
ž˜Kš
œ˜—K˜Kšœ8 ˜?Kšœ8 ˜@K˜šΟnœžœ
žœ?žœžœHžœžœ2žœ
žœžœ	žœžœžœ˜ΟKšœžœjžœžœ
žœžœžœžœ
žœžœE˜ΏKš
œ˜Kšœžœ
˜KšžœD˜JKš
œ˜—K˜š‘œžœ
žœžœ&˜WKšžœ
žœ&žœ˜PK˜—K˜š‘œžœ
žœ6˜NKšœžœžœ#˜IKš
œ1˜1K˜—K˜Kš‘œžœ
žœ6˜JK˜š‘œ˜)Kšœžœ˜+Kšœ
žœ
˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜šžœ
žœ
ž˜Kšœ4žœ
˜8Kšžœ
˜—šžœ
ž˜šžœ˜Kš
œ0˜0Kš
œ8˜8K˜Kš
œ=˜=K˜
Kš
œ˜Kš
œ0˜0Kš
œ˜—š
œ˜šžœ5žœ˜=Kš
œ ˜ Kš
œ˜Kš
œ0˜0Kš
œ
˜
—šžœ˜Kš
œ˜Kš
œ ˜ Kš
œ0˜0Kš
œ˜—K˜—Kšžœžœ
˜—Kšžœ%žœ˜FKšžœ˜ Kš
œN˜NKš
œ3˜3Kš
œ˜—K˜š‘œžœ˜,Kšœžœ˜-Kšœžœ%žœžœ˜aKšžœ!žœ!˜HK˜—K˜š‘
œ˜%Kšœžœ˜+Kšžœ
žœ<˜FKš
œ˜K˜—š‘
œžœ˜+Kšœžœžœ˜4Kšœžœ˜+Kš
œ'˜'Kšœ?žœ˜aKš
œ˜K˜—š‘œžœ
žœE˜ašžœž˜K˜K˜Kšžœ
˜—Kš
œ3˜3Kš
œV˜VK˜—K˜š‘
œžœ˜3Kšžœ
žœC˜PK˜Kšœžœ
˜Kš
œ˜K˜Kšœ-žœ˜MKšœžœ˜+šžœžœ
žœ
žœ
žœžœžœ
ž˜@šžœžœ
ž˜šœžœžœž˜š
œ˜K•StartOfExpansionc[proc: 
ViewerClasses.NotifyProc, tip: 
TIPTables.TIPTable, viewer: 
ViewerClasses.Viewer _ NIL]š
œY˜YKš
œ ˜ Kš
œ5˜5Kšœ
žœ%žœžœ˜XKš
œK˜KKš
œ˜Kš
œ˜—š
œ˜K˜Kš
œ!˜!Kš
œ]˜]Kš
œ ˜ Kš
œ˜—šœ	žœ!žœ˜2Kš
œ˜K˜(Kšžœ
žœžœžœ%žœžœ
˜qKšžœ
žœ9žœ(˜lKšžœ
žœ9žœ˜VKšžœ$˜(Kš
œK˜KKš
œ˜—šœžœ!žœ˜1K˜Kš
œ˜Kš
œ!˜!Kš
œ˜K˜(Kšžœ
žœžœžœ%žœžœ
˜qKšžœ
žœ9žœ(˜lKšžœ
žœ9žœ˜Všžœ˜Kš
œ)˜)K˜K˜—Kš
œM˜MKš
œ ˜ Kš
œ˜—Kšžœžœ
˜—Kš
œ(˜(Kšžœžœ
˜—Kšžœ
˜—Kš
œ˜—K™š‘œžœ
žœ
žœA˜fKš
œ˜Kš
œ˜K˜—K˜š
‘œžœ
žœ1žœ	žœ˜hKšœžœ
˜Kšœžœ˜+šžœ%žœ˜-Kš
œT˜TKšžœžœžœ#žœ
žœ
žœ˜pKš
œ
˜
—šžœ˜Kš
œT˜TKšžœžœžœ#žœ
žœ
žœ˜pKš
œ˜—Kšžœ
žœ˜K˜—K˜š
‘œžœ
žœ1žœ	žœ˜hKšœžœ
˜Kšœžœ˜+Kš
œL˜Lšžœ%žœ˜-Kšžœžœžœ#žœ
žœ
žœ˜pKš
œ
˜
—šžœ˜Kšžœžœžœ#žœ
žœ
žœ˜pKš
œ˜—Kšžœ
žœ˜K˜—K˜Kšœžœžœ˜3šœžœžœ˜%Kšœžœ
˜Kšœž	œ
˜K˜!K˜—Kšœžœ˜*K˜Kšœ'žœ
˜+K˜š‘œžœ
žœ˜6Kšœžœ˜.Kš
œ"˜"Kšžœžœ$˜@K˜—K˜š‘
œžœ
žœ ˜;š‘œžœ˜*Kšœžœ˜+Kšœžœ
˜Kš
œ˜Kš
œ'˜'Kš
œ=˜=Kšžœžœ
žœžœp˜€
K˜—Kš
œ'˜'šžœž˜Kš
œ!˜!K˜—Kšžœ
˜Kš
œ!˜!K˜—K˜š‘œžœ
žœ
žœžœžœ=˜ˆ
Kšœžœ˜+Kš
œ˜Kšœžœ
˜šžœ3žœ˜;Kšœžœ
˜Kš
œ:˜:Kšžœžœ
žœ=˜`Kš
œ"˜"šžœ4žœ˜<Kšœžœ
˜Kšœ?žœ˜aK˜—K˜—Kšžœ*žœžœ
˜EKš
œ)˜)KšžœD˜JK˜—K˜š‘œžœ
žœ
žœB˜ZKšžœO˜VKšžœ˜K˜—K™Kš
œw™wšœ*žœ!˜NK˜K˜K˜K˜K˜7Kš
œ˜K˜K˜—Kš
œ<™<Kš
œ5˜5K˜Kšžœ
˜K™—…—.6;©