<<>> <> <> <> <> 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 <> 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 ]; <> 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; }; <> NotifySliderDial: PUBLIC PROC [control: Control, mouse: Mouse] ~ { ViewerNotLocked: PROC RETURNS [BOOL] ~ TRUSTED { <> <> 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 { <> 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; }; <> mtEnabled: BOOL ¬ UserProfile.Boolean["Controls.TrapMouse", TRUE]; mtControl: Control ¬ NIL; <> <> StopMouseTrap: PROC ~ { <<[] _ MouseTrap.UnsetTrap[];>> mtControl ¬ NIL; }; StartMouseTrap: PROC [control: Control] ~ { <> <> <> <> <> <> <<[cx, cy] _ MouseTrap.UserToMouseCoords[v, Real.Round[s.cx], Real.Round[s.cy]];>> <> <<[] _ MouseTrap.SetTrap[[TRUE, MouseTrap.RoundTrap, mtRoundData]];>> <<}>> <> <<[x0, y0] _ MouseTrap.UserToMouseCoords[v, 0, 0];>> <<[x1, y1] _ MouseTrap.UserToMouseCoords[v, v.cw-1, v.ch-1];>> <> <> <<[] _ MouseTrap.SetTrap[[TRUE, MouseTrap.BoxTrap, mtBoxData]];>> <<};>> }; EnableMouseTrapping: PUBLIC PROC [yes: BOOL] ~ {mtEnabled ¬ yes}; ProfileChanged: UserProfile.ProfileChangedProc ~ { mtEnabled ¬ UserProfile.Boolean["Controls.TrapMouse", TRUE]; }; <> 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]; }; <> 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[]; }; }; <> UserProfile.CallWhenProfileChanges[ProfileChanged]; END. .. <> 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 => <> [] ¬ 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]; };