DIRECTORY Cursors USING [CursorType], Graphics USING [Box, DrawBox, GetBounds, SetColor], GraphicsBasic USING [Color, white], InputFocus USING [CaptureButtons, ReleaseButtons], Process USING [Detach, Milliseconds, MsecToTicks, SetTimeout], Sliders, TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPScreenCoordsRec], ViewerClasses USING [GetProc, NotifyProc, PaintProc, SetProc, Viewer, ViewerRec, ViewerClass, ViewerClassRec], ViewerOps USING [CreateViewer, GetViewer, MouseInViewer, PaintViewer, RegisterViewerClass, SetViewer, UserToScreenCoords], WindowManager USING [RestoreCursor]; SlidersImpl: CEDAR MONITOR IMPORTS Graphics, 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: GraphicsBasic.Color, -- color of slider foreground background: GraphicsBasic.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: foreground, background: 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; sliderData: SliderData _ NARROW[self.data]; box: Graphics.Box _ Graphics.GetBounds[context]; SELECT whatChanged FROM NIL => { Graphics.SetColor[context, sliderData.background]; Graphics.DrawBox[context, box]; SetMaxSliderValue[self]; SetSliderValue[sliderData, sliderData.normalizedSliderValue]; min _ 0.0; max _ sliderData.sliderValue; Graphics.SetColor[context, sliderData.foreground]; }; $sliderValue => { IF sliderData.oldSliderValue <= sliderData.sliderValue THEN { min _ sliderData.oldSliderValue; max _ sliderData.sliderValue; Graphics.SetColor[context, sliderData.foreground]; } ELSE { min _ sliderData.sliderValue; max _ sliderData.oldSliderValue; Graphics.SetColor[context, sliderData.background]; }; }; ENDCASE => ERROR; IF sliderData.orientation = horizontal THEN { box.xmin _ min; box.xmax _ max; } ELSE { box.ymin _ min; box.ymax _ max; }; Graphics.DrawBox[context, 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. 0SlidersImpl.mesa Written by Darlene Plebon on June 22, 1983 1:16 pm Last Edited by: Beach, June 22, 1983 6:15 pm 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 Κ T– "Cedar" style˜Iproc– "Cedar" stylešœ™K– "Cedar" stylešœ2™2J™,unitšΟk ˜ Jšœœ˜Jšœ œ%˜3Jšœœ˜#Jšœ œ"˜2Jšœœ1˜>Jšœ˜Jšœœ?˜LJšœœ[˜nJšœ œk˜zJšœœ˜$—šœ œ˜JšœA˜HJšœ ˜—Lšœœ ˜J˜Jšœ œ!˜2Jšœ œœΟc˜4Jšœ œœ˜&šœœœ˜Jšœœž4˜TJšœœž-˜PJšœ"ž7˜YJšœ"ž˜?Jšœ"ž˜?Jšœ4ž˜JJšœ ž˜;Jšœ!ž,˜MJšœœž4˜WJšœ$ž.˜RJšœ$ž-˜QJšœž!˜