DIRECTORY Cursors USING [CursorType], GraphicsBasic USING [Color, white], Imager USING [Box, Color, Context, MaskBox, SetColor], ImagerOps USING [Color, ColorFromGraphicsColor, ImagerFromGraphics], InputFocus USING [CaptureButtons, ReleaseButtons], Process USING [Detach, Milliseconds, MsecToTicks, SetTimeout], Sliders USING [FilterProc, NormalizedSliderValue, Reason, Slider, sliderGray, SliderOrientation, SliderProc], TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPScreenCoordsRec], ViewerClasses USING [GetProc, NotifyProc, PaintProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec], ViewerOps USING [CreateViewer, GetViewer, MouseInViewer, PaintViewer, RegisterViewerClass, SetViewer, UserToScreenCoords], WindowManager USING [RestoreCursor]; SlidersImpl: CEDAR MONITOR IMPORTS Imager, ImagerOps, 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 ]; Create: PUBLIC PROCEDURE [info: ViewerClasses.ViewerRec _ [], sliderProc: SliderProc _ NIL, filterProc: FilterProc _ NIL, orientation: SliderOrientation _ vertical, foreground: GraphicsBasic.Color _ sliderGray, background: GraphicsBasic.Color _ GraphicsBasic.white, 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: ImagerOps.ColorFromGraphicsColor[foreground], background: ImagerOps.ColorFromGraphicsColor[background], normalizedSliderValue: value, clientData: clientData]]; info.data _ sliderData; info.scrollable _ FALSE; RETURN[ViewerOps.CreateViewer[flavor: $Slider, info: info, paint: paint]]; }; GetContents: PUBLIC PROCEDURE [slider: Slider] RETURNS [contents: NormalizedSliderValue] = { RETURN[NARROW[ViewerOps.GetViewer[viewer: slider], REF NormalizedSliderValue]^]; }; SetContents: PUBLIC PROCEDURE [slider: Slider, contents: NormalizedSliderValue] = { value: REF NormalizedSliderValue _ NEW[NormalizedSliderValue _ contents]; ViewerOps.SetViewer[viewer: slider, data: value]; }; SlidersPaint: PRIVATE ViewerClasses.PaintProc = { min, max: REAL; imager: Imager.Context ~ ImagerOps.ImagerFromGraphics[context]; sliderData: SliderData _ NARROW[self.data]; box: Imager.Box _ [0, 0, self.cw, self.ch]; SELECT whatChanged FROM NIL => { Imager.SetColor[imager, sliderData.background]; Imager.MaskBox[imager, box]; SetMaxSliderValue[self]; SetSliderValue[sliderData, sliderData.normalizedSliderValue]; min _ 0.0; max _ sliderData.sliderValue; Imager.SetColor[imager, sliderData.foreground]; }; $sliderValue => { IF sliderData.oldSliderValue <= sliderData.sliderValue THEN { min _ sliderData.oldSliderValue; max _ sliderData.sliderValue; Imager.SetColor[imager, sliderData.foreground]; } ELSE { min _ sliderData.sliderValue; max _ sliderData.oldSliderValue; Imager.SetColor[imager, sliderData.background]; }; }; ENDCASE => ERROR; IF sliderData.orientation = horizontal THEN { box.xmin _ min; box.xmax _ max; } ELSE { box.ymin _ min; box.ymax _ max; }; Imager.MaskBox[imager, box]; sliderData.oldSliderValue _ sliderData.sliderValue; }; SetMaxSliderValue: PROCEDURE [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: PRIVATE ViewerClasses.GetProc = { sliderData: SliderData _ NARROW[self.data]; RETURN[NEW[NormalizedSliderValue _ sliderData.normalizedSliderValue]]; }; SlidersSet: PRIVATE 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 PROCEDURE [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: PRIVATE ViewerClasses.NotifyProc = TRUSTED { ENABLE UNWIND => { InputFocus.ReleaseButtons[]; WindowManager.RestoreCursor[] }; v: ViewerClasses.Viewer; c: BOOLEAN; 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 PROCEDURE [sliderData: SliderData, value: SliderValue, reason: Reason] = { sliderData.mouseValue _ value; sliderData.reason _ reason; }; MouseAboveSlider: PRIVATE PROCEDURE [self: Slider, coords: TIPUser.TIPScreenCoords] RETURNS [above: BOOLEAN] = { 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 PROCEDURE [self: Slider, coords: TIPUser.TIPScreenCoords] RETURNS [below: BOOLEAN] = { 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 PROCEDURE [slider: Slider] = { sliderProcessData _ NEW[SliderProcessDataRec]; sliderProcessData.slider _ slider; TRUSTED {Process.Detach[FORK SliderProcess[sliderProcessData]]}; }; SliderProcess: PRIVATE PROCEDURE [myData: SliderProcessData] = { UpdateSliderValue: PROCEDURE [self: Slider] = { sliderData: SliderData _ NARROW[self.data]; notifyClient: BOOLEAN; 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 PROCEDURE [self: Slider] RETURNS [notifyClient: BOOLEAN, 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 PROCEDURE [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 1983, 1984 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, September 5, 1984 3:13:38 pm PDT 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˜– "Cedar" stylešœ™Jšœ Οmœ4™?J– "Cedar" stylešœ2™2J™,J™,—J˜šΟk ˜ Jšœžœ˜Jšœžœ˜#Jšœžœ*˜6Jšœ žœ5˜DJšœ žœ"˜2Jšœžœ1˜>Jšœžœ`˜mJšœžœ?˜LJšœžœ[˜nJšœ žœk˜zJšœžœ˜$J˜—J˜Jšœ žœž˜JšžœJ˜QJšžœ˜Jšœžœžœ ˜J˜Jšœ žœ!˜2Jšœ žœžœΟc˜4Jšœ žœžœ˜&šœžœžœ˜JšœžœŸ4˜TJšœžœŸ-˜PJšœ"Ÿ7˜YJšœŸ˜:JšœŸ˜:Jšœ4Ÿ˜JJšœ Ÿ˜;Jšœ!Ÿ,˜MJšœžœŸ4˜WJšœ$Ÿ.˜RJšœ$Ÿ-˜QJšœŸ!˜