<> <> <> <> <<>> DIRECTORY Imager, --USING Lots! ImagerPath USING [ArcTo, MoveTo], KnobAttach, KnobRotation USING [KnobIndex, OffsetSinceLastCall], Process USING [Detach, priorityClient3, SetPriority], RefTab USING [Create, Delete, EachPairAction, Fetch, GetSize, Pairs, Ref, Store], Sliders USING [GetContents, NormalizedSliderValue, SetContents, Slider], TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable], UserProfile USING [Boolean, CallWhenProfileChanges, Number, ProfileChangedProc], ViewerClasses, --USING Lots! ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass] ; KnobAttachImpl: CEDAR MONITOR IMPORTS Imager, ImagerPath, KnobRotation, Process, RefTab, Sliders, TIPUser, UserProfile, ViewerOps EXPORTS KnobAttach = BEGIN OPEN KnobAttach, I: Imager, KR: KnobRotation, S: Sliders, V: ViewerClasses; KnobAttachData: TYPE ~ REF KnobAttachDataRec; KnobAttachDataRec: TYPE ~ RECORD [ slider: Slider, --Slider to control turnProc: TurnProc, --Called whenever turn is noticed clientData: REF --Passed to turnProc ]; KnobIndex: TYPE ~ KR.KnobIndex; NotASlider: PUBLIC ERROR ~ CODE; <> Create: PUBLIC PROC [info: ViewerClasses.ViewerRec, slider: Slider, turnProc: TurnProc _ NIL, clientData: REF _ NIL, paint: BOOL _ TRUE] RETURNS [v: KnobAttachViewer] ~ { knobAttachData: KnobAttachData _ NEW[KnobAttachDataRec _ [ slider: slider, turnProc: turnProc, clientData: clientData ]]; IF slider.class.flavor # $Slider THEN ERROR NotASlider[]; info.data _ knobAttachData; info.scrollable _ FALSE; RETURN[ViewerOps.CreateViewer[flavor: $KnobAttach, info: info, paint: paint]]; }; Attach: PUBLIC ENTRY PROC [viewer: KnobAttachViewer, whichKnob: Attachment, paint: BOOL _ TRUE] ~ { ENABLE UNWIND => NULL; slider: S.Slider _ NARROW[viewer.data, KnobAttachData].slider; IF whichKnob=GetAttachmentUnderLock[viewer] THEN RETURN; --If already in desired condition, then exit <> DetachKnobAttachViewerFromKnob[viewer]; SELECT whichKnob FROM left => AttachKnobAttachViewerToKnob[viewer, left]; right => AttachKnobAttachViewerToKnob[viewer, right]; none => NULL; ENDCASE => ERROR; ViewerOps.PaintViewer[viewer, all, paint]; }; GetAttachment: PUBLIC ENTRY PROC [viewer: KnobAttachViewer] RETURNS [Attachment] ~ { ENABLE UNWIND => NULL; RETURN [GetAttachmentUnderLock[viewer]]; }; <> <> attached: ARRAY KnobIndex OF KnobAttachViewer _ ALL[NIL]; threshold, sensitivity: INT; --Used for accelerating knobs fork: BOOLEAN _ FALSE; -- " ProfileChanged: ENTRY UserProfile.ProfileChangedProc ~ { ENABLE UNWIND => NULL; threshold _ UserProfile.Number["Knob.Threshold", 5]+2; sensitivity _ UserProfile.Number["Knob.Sensitivity", 20]; fork _ UserProfile.Boolean["Knob.Fork", FALSE]; }; UpdateSliderProcess: PROC [knob: KnobIndex] ~ { <> UpdateSliderInternal: ENTRY PROC ~ { ENABLE UNWIND => NULL; IF attached[knob] # NIL AND 0#offset THEN { data: KnobAttachData _ NARROW[attached[knob].data]; slider: S.Slider _ data.slider; m: INT _ MAX[1, threshold-waitCycles]; sliderOffset: REAL _ m*sensitivity/10000.0*offset; <> <> <> newValue: REAL _ MIN[1.0, MAX[0.0, sliderOffset+GetContents[slider]]]; SetContents[slider, newValue]; IF data.turnProc#NIL THEN data.turnProc[slider, move, newValue, data.clientData]; }; }; offset: INTEGER; waitCycles: INT; Process.SetPriority[Process.priorityClient3]; --Set to higher priority DO --FOREVER [offset, waitCycles] _ KR.OffsetSinceLastCall[knob]; UpdateSliderInternal[]; ENDLOOP; }; sliderTable: RefTab.Ref ~ RefTab.Create[]; SliderWaiting: CONDITION; SetContents: INTERNAL PROC [slider: ViewerClasses.Viewer, newValue: REAL] ~ { <> [] _ RefTab.Store[x: sliderTable, key: slider, val: NEW[REAL _ newValue]]; BROADCAST SliderWaiting; }; GetContents: INTERNAL PROC [slider: ViewerClasses.Viewer] RETURNS [value: REAL] ~ { <> ref: REF; found: BOOL; [found, ref] _ RefTab.Fetch[x: sliderTable, key: slider]; IF found THEN RETURN [NARROW[ref, REF REAL]^] ELSE RETURN [Sliders.GetContents[slider]]; }; PaintSlidersProcess: PROC ~ { <> WaitForSlider: ENTRY PROC ~ { ENABLE UNWIND => NULL; UNTIL RefTab.GetSize[x: sliderTable]>0 DO WAIT SliderWaiting; ENDLOOP; }; GetSliderUpdateInfo: ENTRY PROC RETURNS [slider: ViewerClasses.Viewer _ NIL, newValue: REAL] ~ { <> ENABLE UNWIND => NULL; ReturnFirstPair: RefTab.EachPairAction = { <<[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]>> slider _ NARROW[key]; newValue _ NARROW[val, REF REAL]^; RETURN [TRUE]; --Always quit after first call }; IF RefTab.Pairs[x: sliderTable, action: ReturnFirstPair] THEN [] _ RefTab.Delete[x: sliderTable, key: slider]; }; slider: ViewerClasses.Viewer; value: REAL; DO --forever UNTIL ([slider, value] _ GetSliderUpdateInfo[]).slider = NIL DO Sliders.SetContents[slider: slider, contents: value]; ENDLOOP; WaitForSlider[]; ENDLOOP; }; AttachKnobAttachViewerToKnob: INTERNAL PROC [v: KnobAttachViewer, knob: KnobIndex] ~ { detachedViewer: KnobAttachViewer _ attached[knob]; data: KnobAttachData _ NARROW[v.data]; attached[knob] _ v; IF detachedViewer # NIL THEN ViewerOps.PaintViewer[detachedViewer, all]; }; DetachKnobAttachViewerFromKnob: PROC [v: KnobAttachViewer] ~ { SELECT GetAttachmentUnderLock[v] FROM left => attached[left] _ NIL; right => attached[right] _ NIL; none => NULL; ENDCASE => ERROR; }; GetAttachmentUnderLock: PROC [viewer: KnobAttachViewer] RETURNS [Attachment] ~ { RETURN [ <> <> SELECT viewer FROM attached[left] => left, attached[right] => right, ENDCASE => none ] }; <> KAInit: V.InitProc ~ {}; KANotify: ENTRY V.NotifyProc ~ { ENABLE UNWIND => NULL; mouseX, mouseY: REAL; FOR actions: LIST OF REF ANY _ input, actions.rest UNTIL actions=NIL DO WITH actions.first SELECT FROM x: TIPUser.TIPScreenCoords => { mouseX _ x.mouseX; mouseY _ x.mouseY; }; x: ATOM => { SELECT x FROM $AttachToLeft => AttachKnobAttachViewerToKnob[self, left]; $AttachToRight => AttachKnobAttachViewerToKnob[self, right]; $Detach => DetachKnobAttachViewerFromKnob[self]; ENDCASE => NULL; }; ENDCASE => ERROR; ENDLOOP; ViewerOps.PaintViewer[self, all]; }; black: I.ConstantColor ~ I.MakeGray[1]; white: I.ConstantColor ~ I.MakeGray[0]; leftDial: I.Trajectory _ ImagerPath.MoveTo[[3,4]].ArcTo[[5,6], [3,8]].ArcTo[[1,6], [3,4]]; rightDial: I.Trajectory _ ImagerPath.MoveTo[[8,4]].ArcTo[[10,6], [8,8]].ArcTo[[6,6], [8,4]]; strokeWidth: REAL _ 0.7; KAPaint: V.PaintProc ~ { data: KnobAttachData _ NARROW[self.data]; I.Scale2T[context, [self.cw/11.0, self.ch/11.0]]; <> IF ~clear THEN { I.SetColor[context, white]; I.MaskRectangleI[context, 0,0, 11,11]; }; I.SetStrokeWidth[context, strokeWidth]; I.MaskStrokeTrajectory[context, leftDial]; I.MaskStrokeTrajectory[context, rightDial]; SELECT GetAttachmentUnderLock[self] FROM left => I.MaskFillTrajectory[context, leftDial]; right => I.MaskFillTrajectory[context, rightDial]; ENDCASE => NULL; }; KADestroy: V.DestroyProc ~ { DetachKnobAttachViewerFromKnob[self]; }; kaTipTable: TIPUser.TIPTable ~ TIPUser.InstantiateNewTIPTable["KnobAttach.TIP"]; kaClass: V.ViewerClass ~ NEW[V.ViewerClassRec _ [ flavor: $KnobAttach, notify: KANotify, paint: KAPaint, destroy: KADestroy, init: KAInit, tipTable: kaTipTable, cursor: crossHairsCircle ]]; <> Init: PROC ~ TRUSTED { ViewerOps.RegisterViewerClass[$KnobAttach, kaClass]; FOR knob: KnobIndex IN KnobIndex DO Process.Detach[FORK UpdateSliderProcess[knob]]; ENDLOOP; Process.Detach[FORK PaintSlidersProcess]; UserProfile.CallWhenProfileChanges[ProfileChanged]; }; Init[]; END. <> <> <> <<>>